carpentry/cli
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

add types

Browse Source
This commit is contained in:
Veit Heller
2020-01-29 16:27:24 +01:00
parent 2c1fae1b18
commit d36a768b15
3 changed files with 101 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
README.md
View File

@@ -3,22 +3,26 @@
A simple CLI library for Carp. A simple CLI library for Carp.
```clojure ```clojure
(load "git@github.com:carpentry-org/cli.carp.git@master") (load "https://veitheller.de/git/carpentry/cli@master")
(defn main [] (defn main []
(let [p (=> (CLI.new @"My super cool tool!") (let [p (=> (CLI.new @"My super cool tool!")
(CLI.add &(CLI.option "--flag" "-f" "my flag" true)))] (CLI.add &(CLI.int "flag" "f" "my flag" true))
(CLI.add &(CLI.str "thing" "t" "my thing" false @"hi" &[@"a" @"b" @"hi"])))]
(match (CLI.parse &p) (match (CLI.parse &p)
(Result.Success p) (IO.println &(str &(CLI.get &p "flag"))) (Result.Success flags)
(println* &(str &(Map.get &flags "flag")) " " &(str &(Map.get &flags "thing")))
(Result.Error msg) (do (IO.errorln &msg) (CLI.usage &p))))) (Result.Error msg) (do (IO.errorln &msg) (CLI.usage &p)))))
``` ```
## Installation ## Installation
```clojure ```clojure
(load "git@github.com:carpentry-org/cli.carp.git@master") (load "https://veitheller.de/git/carpentry/cli@master")
``` ```
## Usage
<hr/> <hr/>
Have fun! Have fun!

112
cli.carp
View File

@@ -3,13 +3,57 @@
) )
(defmodule CLI (defmodule CLI
(deftype Type
(Integer [Long])
(Floating [Double])
(Str [String])
)
(defmodule Type
(defn = [a b]
(match @a
(Integer i)
(match @b
(Integer j) (= i j)
_ false)
(Floating f)
(match @b
(Floating g) (= f g)
_ false)
(Str s)
(match @b
(Str t) (= s t)
_ false)))
(defn format [s t]
(match @t
(Integer i) (Long.format s i)
(Floating f) (Double.format s f)
(Str s2) (String.format s &s2)))
)
(deftype Tag
(Integer [])
(Floating [])
(Str [])
)
(defmodule Tag
(defn to-type [t s]
(match t
(Integer) (CLI.Type.Integer (Long.from-string s))
(Floating) (CLI.Type.Floating (Double.from-string s))
(Str) (CLI.Type.Str @s)))
)
(deftype Option [ (deftype Option [
type- Tag
long String long String
short String short String
description String description String
required? Bool required? Bool
default (Maybe String) default (Maybe Type)
options (Maybe (Array String)) options (Maybe (Array Type))
]) ])
(deftype Parser [ (deftype Parser [
@@ -18,7 +62,7 @@
]) ])
(deftype CmdMap [ (deftype CmdMap [
values (Array (Pair (Pair String String) (Maybe String))) values (Array (Pair (Pair String String) (Pair Tag (Maybe Type))))
]) ])
(defmodule CmdMap (defmodule CmdMap
@@ -32,7 +76,8 @@
(Pair.init @(CLI.Option.long o) @(CLI.Option.short o)) (Pair.init @(CLI.Option.long o) @(CLI.Option.short o))
@v))))) @v)))))
(defn put-empty [m o] (put m o (CLI.Option.default o))) (defn put-empty [m o]
(put m o &(Pair.init-from-refs (CLI.Option.type- o) (CLI.Option.default o))))
(defn contains? [m s] (defn contains? [m s]
(let-do [found false] (let-do [found false]
@@ -48,7 +93,7 @@
(let-do [found false] (let-do [found false]
(foreach [e (values m)] (foreach [e (values m)]
(let [k (Pair.a e) (let [k (Pair.a e)
v (Pair.b e)] v (Pair.b (Pair.b e))]
(when (or (= (Pair.a k) s) (= (Pair.b k) s)) (when (or (= (Pair.a k) s) (= (Pair.b k) s))
(do (do
(set! found (Maybe.just? v)) (set! found (Maybe.just? v))
@@ -56,10 +101,10 @@
found)) found))
(defn get [m s] (defn get [m s]
(let-do [res @""] (let-do [res (CLI.Type.Str @"")]
(foreach [e (values m)] (foreach [e (values m)]
(let [k (Pair.a e) (let [k (Pair.a e)
v (Pair.b e)] v (Pair.b (Pair.b e))]
(when (or (= (Pair.a k) s) (= (Pair.b k) s)) (when (or (= (Pair.a k) s) (= (Pair.b k) s))
(do (do
(set! res (Maybe.unsafe-from @v)) (set! res (Maybe.unsafe-from @v))
@@ -70,7 +115,7 @@
(let-do [found true] (let-do [found true]
(foreach [e (values m)] (foreach [e (values m)]
(let [k (Pair.a e) (let [k (Pair.a e)
v (Pair.b e)] v (Pair.b (Pair.b e))]
(when (or (= (Pair.a k) s) (= (Pair.b k) s)) (when (or (= (Pair.a k) s) (= (Pair.b k) s))
(match @v (match @v
(Maybe.Just value) (Maybe.Just value)
@@ -84,15 +129,16 @@
(let [vs (values m)] (let [vs (values m)]
(for [i 0 (Array.length vs)] (for [i 0 (Array.length vs)]
(let [p (Array.unsafe-nth vs i) (let [p (Array.unsafe-nth vs i)
k (Pair.a p)] k (Pair.a p)
vp (Pair.b p)]
(when (or (= (Pair.a k) s) (= (Pair.b k) s)) (when (or (= (Pair.a k) s) (= (Pair.b k) s))
(do (do
(Pair.set-b! p (Maybe.Just @v)) (Pair.set-b! vp (Maybe.Just (CLI.Tag.to-type @(Pair.a vp) v)))
(break))))))) (break)))))))
(defn to-map [m] (defn to-map [m]
(Array.reduce (Array.reduce
&(fn [a v] (Map.put a (Pair.a (Pair.a v)) (Pair.b v))) &(fn [a v] (Map.put a (Pair.a (Pair.a v)) (Pair.b (Pair.b v))))
{} {}
(values m))) (values m)))
) )
@@ -107,22 +153,32 @@
(defn add [p opt] (defn add [p opt]
(Parser.update-options p &(fn [options] (Array.push-back options @opt)))) (Parser.update-options p &(fn [options] (Array.push-back options @opt))))
(defndynamic option- [long short description required default-options] (defndynamic option- [t long short description required default-options]
(if (= (length default-options) 0) (if (= (length default-options) 0)
(list 'CLI.Option.init (list 'CLI.Option.init (list t)
(list 'copy long) (list 'copy short) (list 'copy description) (list 'copy long) (list 'copy short) (list 'copy description)
required '(Maybe.Nothing) '(Maybe.Nothing)) required '(Maybe.Nothing) '(Maybe.Nothing))
(if (= (length default-options) 1) (if (= (length default-options) 1)
(list 'CLI.Option.init (list 'CLI.Option.init (list t)
(list 'copy long) (list 'copy short) (list 'copy description) (list 'copy long) (list 'copy short) (list 'copy description)
required (list 'Maybe.Just (car default-options)) '(Maybe.Nothing)) required (list 'Maybe.Just (list 'to-cli-type (car default-options))) '(Maybe.Nothing))
(list 'CLI.Option.init (list 'CLI.Option.init (list t)
(list 'copy long) (list 'copy short) (list 'copy description) (list 'copy long) (list 'copy short) (list 'copy description)
required (list 'Maybe.Just (car default-options)) required (list 'Maybe.Just (list 'to-cli-type (car default-options)))
(list 'Maybe.Just (cadr default-options)))))) (list 'Maybe.Just
(list 'Array.copy-map '(ref (fn [e] (to-cli-type @e))) (cadr default-options)))))))
(defmacro option [long short description required :rest default-options] (defmacro option [long short description required :rest default-options]
(CLI.option- long short description required default-options)) (CLI.option- t long short description required default-options))
(defmacro str [long short description required :rest default-options]
(CLI.option- 'CLI.Tag.Str long short description required default-options))
(defmacro int [long short description required :rest default-options]
(CLI.option- 'CLI.Tag.Integer long short description required default-options))
(defmacro float [long short description required :rest default-options]
(CLI.option- 'CLI.Tag.Floating long short description required default-options))
(defn options-str [p] (defn options-str [p]
(join (join
@@ -146,7 +202,7 @@
(IO.print &(fmt " (default: %s)" &(Maybe.unsafe-from @(Option.default arg))))) (IO.print &(fmt " (default: %s)" &(Maybe.unsafe-from @(Option.default arg)))))
(match @(Option.options arg) (match @(Option.options arg)
(Maybe.Just o) (Maybe.Just o)
(IO.print &(fmt " (options: %s)" &(join ", " &o))) (IO.print &(fmt " (options: %s)" &(join ", " &(Array.copy-map &str &o))))
(Maybe.Nothing) ()) (Maybe.Nothing) ())
(IO.println ""))) (IO.println "")))
(IO.println " --help|-h: print this help message and exit."))) (IO.println " --help|-h: print this help message and exit.")))
@@ -195,10 +251,24 @@
"Option %s received an invalid option %s (Options are %s)" "Option %s received an invalid option %s (Options are %s)"
(Option.long o) (Option.long o)
&(CmdMap.get &values (Option.long o)) &(CmdMap.get &values (Option.long o))
&(join ", " &opts)))) &(join ", " &(Array.copy-map &str &opts)))))
(break)))) (break))))
())) ()))
(match res (match res
(Result.Success _) (Result.Success (CmdMap.to-map &values)) (Result.Success _) (Result.Success (CmdMap.to-map &values))
(Result.Error x) (Result.Error x)))) (Result.Error x) (Result.Error x))))
) )
(definterface to-cli-type (Fn [a] CLI.Type))
(defmodule String
(defn to-cli-type [s] (CLI.Type.Str s))
)
(defmodule Double
(defn to-cli-type [f] (CLI.Type.Floating f))
)
(defmodule Long
(defn to-cli-type [l] (CLI.Type.Integer l))
)

4
examples/simple.carp
View File

@@ -2,8 +2,8 @@
(defn main [] (defn main []
(let [p (=> (CLI.new @"My super cool tool!") (let [p (=> (CLI.new @"My super cool tool!")
(CLI.add &(CLI.option "flag" "f" "my flag" true)) (CLI.add &(CLI.int "flag" "f" "my flag" true))
(CLI.add &(CLI.option "thing" "t" "my thing" false @"hi" [@"a" @"b" @"hi"])))] (CLI.add &(CLI.str "thing" "t" "my thing" false @"hi" &[@"a" @"b" @"hi"])))]
(match (CLI.parse &p) (match (CLI.parse &p)
(Result.Success flags) (Result.Success flags)
(println* &(str &(Map.get &flags "flag")) " " &(str &(Map.get &flags "thing"))) (println* &(str &(Map.get &flags "flag")) " " &(str &(Map.get &flags "thing")))