aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-08-05 09:50:42 -0500
committerColin Okay <colin@cicadas.surf>2022-08-05 09:50:42 -0500
commit9a9f629068b4ffe7173bc92f12080685743dc6ab (patch)
treed62379dc9eabadfc6c7c0f907e16894511376c00
parentf116178dcf8b450c76400e2a0fbd2991f2c227b4 (diff)
[add] defhandler macro for app package.
-rw-r--r--app/app.lisp4
-rw-r--r--app/clip.lisp8
-rw-r--r--app/draft.lisp33
-rw-r--r--app/modify.lisp89
-rw-r--r--app/run.lisp13
-rw-r--r--app/show.lisp8
-rw-r--r--app/util.lisp27
7 files changed, 140 insertions, 42 deletions
diff --git a/app/app.lisp b/app/app.lisp
index 5af7006..46ef74b 100644
--- a/app/app.lisp
+++ b/app/app.lisp
@@ -33,11 +33,9 @@
(clip/command)
(show/command)
(draft/command)
- ))
+ (modify/command)))
-;; ol delete <ID>
-
;; ol account login <USER> <PW>
;; ol account logout
;; ol account signature <new sig>
diff --git a/app/clip.lisp b/app/clip.lisp
index 922cacc..ad79589 100644
--- a/app/clip.lisp
+++ b/app/clip.lisp
@@ -2,12 +2,8 @@
(in-package :oneliners.cli.app)
-(defun clip/handler (cmd)
- (a:if-let (args (cli:command-arguments cmd))
- (ol::run-item
- (parse-identifier (first args)) (rest args)
- :force-clip t)
- (cli:print-usage-and-exit cmd t)))
+(defhandler clip/handler (id . args)
+ (ol:run-item (parse-identifier id) args :force-clip t))
(defun clip/command ()
(cli:make-command
diff --git a/app/draft.lisp b/app/draft.lisp
index ea71e49..32698ca 100644
--- a/app/draft.lisp
+++ b/app/draft.lisp
@@ -3,6 +3,7 @@
(in-package :oneliners.cli.app)
(defun draft/new/handler (cmd)
+ (declare (ignore cmd))
(ol:add-new-oneliner))
(defun draft/new/command ()
@@ -12,10 +13,8 @@
:handler #'draft/new/handler))
-(defun draft/publish/handler (cmd)
- (a:if-let (name (first (cli:command-arguments cmd)))
- (ol::publish-draft name)
- (cli:print-usage-and-exit cmd t)))
+(defhandler draft/publish/handler (name)
+ (ol::publish-draft name))
(defun draft/publish/command ()
(cli:make-command
@@ -24,14 +23,12 @@
:description "publish draft to the server"
:handler #'draft/publish/handler))
-(defun draft/test/handler (cmd)
- (a:if-let (args (cli:command-arguments cmd))
- (ol:run-item (first args) (rest args)
- :verbose (cli:getopt cmd :verbose)
- :confirm (cli:getopt cmd :confirm)
- :timeout (cli:getopt cmd :timeout)
- :draftp t)
- (cli:print-usage-and-exit cmd t)))
+(defhandler draft/test/handler (name . args)
+ (ol:run-item name args
+ :verbose (cli:getopt *cmd* :verbose)
+ :confirm (cli:getopt *cmd* :confirm)
+ :timeout (cli:getopt *cmd* :timeout)
+ :draftp t))
(defun draft/test/command ()
(cli:make-command
@@ -41,10 +38,8 @@
:options (run/options)
:handler #'draft/new/handler))
-(defun draft/edit/handler (cmd)
- (a:if-let (name (first (cli:command-arguments cmd)))
- (ol:edit-item name t)
- (cli:print-usage-and-exit cmd t)))
+(defhandler draft/edit/handler (name)
+ (ol:edit-item name t))
(defun draft/edit/command ()
(cli:make-command
@@ -53,10 +48,8 @@
:description "interactively edits a draft"
:handler #'draft/edit/handler))
-(defun draft/trash/handler (cmd)
- (a:if-let (name (first (cli:command-arguments cmd)))
- (ol::drop-draft name)
- (cli:print-usage-and-exit cmd t)))
+(defhandler draft/trash/handler (name)
+ (ol::drop-draft name))
(defun draft/trash/command ()
(cli:make-command
diff --git a/app/modify.lisp b/app/modify.lisp
new file mode 100644
index 0000000..0b5e53d
--- /dev/null
+++ b/app/modify.lisp
@@ -0,0 +1,89 @@
+;;;; modify.lisp
+
+(in-package :oneliners.cli.app)
+
+;; ol modify flag <ID>
+;; ol modify unflag <ID>
+;; ol modify description <ID> new description ...
+;; ol modify redraft <ID>
+;; ol modify name <ID> New-name
+;; ol modify lock <ID>
+;; ol modify unlock <ID>
+
+(defhandler modify/redraft/handler (id)
+ (ol:edit-item (parse-identifier id)))
+
+(defun modify/redraft/command ()
+ (cli:make-command
+ :name "redraft"
+ :usage "<IDENTIFIER>"
+ :description "edit an existing oneliner"
+ :handler #'modify/redraft/handler))
+
+(defhandler modify/flag/handler (id)
+ (ol::flag-item (parse-identifier id)))
+
+(defun modify/flag/command ()
+ (cli:make-command
+ :name "flag"
+ :usage "<IDENTIFIER>"
+ :description "flag a oneliner as potentially wrong or hazardous"
+ :handler #'modify/flag/handler))
+
+(defhandler modify/unflag/handler (id)
+ (ol::unflag-item (parse-identifier id)))
+
+(defun modify/unflag/comnand ()
+ (cli:make-command
+ :name "unflag"
+ :usage "<IDENTIFIER>"
+ :description "remove flagged status from a oneliner"
+ :handler #'modify/unflag/handler))
+
+(defhandler modify/lock/handler (id)
+ (ol::lock-item (parse-identifier id)))
+
+(defun modify/lock/command ()
+ (cli:make-command
+ :name "lock"
+ :usage "<IDENTIFIER>"
+ :description "lock a oneliner from being changed (admin only)"
+ :handler #'modify/lock/handler))
+
+(defun modify/unlock/handler (id)
+ (ol::unlock-item (parse-identifier id)))
+
+(defun modify/unlock/command ()
+ (cli:make-command
+ :name "unlock"
+ :usage "<IDENTIFIER>"
+ :description "unlock a locked oneliner, allowing it to be modified again"
+ :handler #'modify/unlock/handler))
+
+(defun modify/delete/handler (id)
+ (ol::delete-item (parse-identifier id)))
+
+(defun modify/delete/command ()
+ (cli:make-command
+ :name "delete"
+ :usage "<IDENTIFIER>"
+ :description "delete a oneliner from the server."))
+
+(defun modify/subcommands ()
+ (list
+ (modify/redraft/command)
+ (modify/flag/command)
+ (modify/unflag/command)
+ (modify/lock/command)
+ (modify/unlock/command)
+ (modify/delete/command)))
+
+(defun modify/handler (cmd)
+ (cli:print-usage-and-exit cmd t))
+
+(defun modify/command ()
+ (cli:make-command
+ :name "modify"
+ :description "alter an existing oneliner"
+ :handler #'modify/handler
+ :sub-commands (modify/subcommands)))
diff --git a/app/run.lisp b/app/run.lisp
index 987ecad..556b719 100644
--- a/app/run.lisp
+++ b/app/run.lisp
@@ -24,14 +24,11 @@
:key :confirm
:description "prompts the user for confirmation before running the command")))
-(defun run/handler (cmd)
- (a:if-let (args (cli:command-arguments cmd))
- (ol::run-item
- (first args) (rest args)
- :verbose (cli:getopt cmd :verbose)
- :confirm (cli:getopt cmd :confirm)
- :timeout (cli:getopt cmd :timeout))
- (cli:print-usage-and-exit cmd t)))
+(defhandler run/handler (id . args)
+ (ol:run-item (parse-identifier id) args
+ :verbose (cli:getopt *cmd* :verbose)
+ :confirm (cli:getopt *cmd* :confirm)
+ :timeout (cli:getopt *cmd* :timeout)))
(defparameter +run/examples+
'(("Run a hypothetical command called echo-stuff with positional arguments" .
diff --git a/app/show.lisp b/app/show.lisp
index 1ed3493..2270e67 100644
--- a/app/show.lisp
+++ b/app/show.lisp
@@ -2,11 +2,9 @@
(in-package :oneliners.cli.app)
-(defun show/handler (cmd)
- (a:if-let (ident
- (parse-identifier (first (cli:command-arguments cmd))))
- (ol:print-item-explanation ident)
- (cli:print-usage-and-exit cmd t)))
+(defhandler show/handler (id)
+ (ol:print-item-explanation (parse-identifier id)))
+
(defun show/command ()
(cli:make-command
diff --git a/app/util.lisp b/app/util.lisp
index d9d5ea2..70dee49 100644
--- a/app/util.lisp
+++ b/app/util.lisp
@@ -9,3 +9,30 @@
(when str
(or (parse-integer str :junk-allowed t)
str)))
+
+(defvar *cmd* nil)
+
+(defmacro defhandler (name args-pattern &body body)
+ "Convenience macro for defining command handlers that take
+arguments. The args pattern list of forms sutable for passint to
+destructuring-bind.
+
+Also binds *cmd* to the current command, so that you can pass it to
+getopt forms as needed.
+
+E.g. (defhandler moo (a b . more) ...)
+
+would become (destructuring-bind. (a b . more) (command-argumets *cmd*) ...)
+
+If an error occurs at any time during the execution of BODY, then it
+is caught and handled by printing the usage statemnnt for the current
+command.
+"
+ (let ((cmd-var (gensym "cmd")))
+ `(defun ,name (,cmd-var)
+ (let ((*cmd* ,cmd-var))
+ (handler-case
+ (destructuring-bind ,args-pattern (clingon:command-arguments *cmd*)
+ ,@body)
+ (error ()
+ (clingon:print-usage-and-exit *cmd* t)))))))