changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/bin/skel.lisp

changeset 340: 5ac5e6516f6f
parent: 8f1c1d79a96c
child: ce1c1743c85f
author: Richard Westhaver <ellis@rwest.io>
date: Mon, 13 May 2024 18:37:13 -0400
permissions: -rw-r--r--
description: special vars for skel bin
1 ;;; Code:
2 
3 ;; TODO 2024-05-09: add shell configurables to rules - maybe at sk-command
4 ;; level. :INPUT :WAIT :OUTPUT
5 
6 (uiop:define-package :bin/skel
7  (:use :cl :std :cli/clap :vc :sb-ext)
8  (:import-from :cli/shell :*shell-input*)
9  (:use-reexport :skel :log)
10  (:export :main))
11 
12 (in-package :bin/skel)
13 (in-readtable :shell)
14 
15 (defopt skc-help (print-help $cli) $val)
16 (defopt skc-version (print-version $cli))
17 (defopt skc-level *log-level* (setq *log-level* (if $val (if (stringp $val)
18  (sb-int:keywordicate (string-upcase $val))
19  $val)
20  :info)))
21 
22 ;; TODO 2023-10-13: almost there
23 ;; (defopt skc-config
24 ;; (init-user-skelrc (when $val (parse-file-opt $val))))
25 
26 (defcmd skc-edit
27  (let ((file (or (when $args (pop $args)) (sk-path *skel-project*))))
28  (cli/ed:run-emacsclient (namestring file))))
29 
30 (defcmd skc-init
31  (let ((file (when $args (pop $args)))
32  (name (if (> $argc 1) (pop $args))))
33  (handler-bind
34  ((sb-ext:file-exists
35  #'(lambda (s)
36  (uiop:println (format nil "file already exists: ~A" (or file *default-skelfile*)))
37  (let ((f2 (read-line)))
38  (if (string= f2 "")
39  (error s)
40  (use-value f2 s))))))
41  (init-skelfile file name))))
42 
43 (defcmd skc-describe
44  (describe
45  (find-skelfile
46  (if $args (pathname (car $args))
47  #P".")
48  :load t)))
49 
50 (defcmd skc-inspect
51  (sb-ext:enable-debugger)
52  (setq *no-exit* t)
53  (inspect
54  (find-skelfile
55  (if $args (pathname (car $args))
56  #P".")
57  :load t)))
58 
59 (defcmd skc-id
60  (println (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t)))))
61 
62 (defcmd skc-rev
63  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
64  (:hg (progn
65  (let ((proc (run-hg-command "id" (list "-i") :stream)))
66  (copy-stream (process-output proc) *standard-output*)
67  (finish-output))))
68  (:git (progn
69  (let ((proc (run-git-command "rev-parse" (list "HEAD") :stream)))
70  (copy-stream (process-output proc) *standard-output*)
71  (finish-output))))
72  (t (skel-error "unknown VC type"))))
73 
74 (defun skc-show-case (sel)
75  (std/string:string-case (sel :default (skel-error))
76  (":id" (std:format-sxhash (obj/id:id *skel-project*)))
77  (":name" (sk-name *skel-project*))
78  (":author" (sk-author *skel-project*))
79  (":version" (sk-version *skel-project*))
80  (":description" (sk-description *skel-project*))
81  (":tags" (sk-tags *skel-project*))
82  (":license" (sk-license *skel-project*))
83  (":vc" (sk-vc *skel-project*))
84  (":docs" (sk-docs *skel-project*))
85  (":scripts" (sk-scripts *skel-project*))
86  (":snippets" (sk-snippets *skel-project*))
87  (":rules" (sk-rules *skel-project*))
88  (":imports" (sk-imports *skel-project*))
89  (":stash" (sk-stash *skel-project*))
90  (":store" (sk-store *skel-project*))
91  (":config" (describe *skel-user-config*))
92  (":sys" (describe *skel-system-config*))
93  (":cache" (sk-cache *skel-user-config*))))
94 
95 (defcmd skc-show
96  (if $args
97  (mapc (lambda (x) (when-let ((ret (skc-show-case x))) (println ret))) $args)
98  (describe (if (boundp '*skel-project*) *skel-project*
99  (if (boundp '*skel-user-config*) *skel-user-config*
100  (if (boundp '*skel-system-config*) *skel-system-config*
101  (skel-error "skel config files not installed")))))))
102 
103 (defcmd skc-push
104  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
105  (:git (run-git-command "push" $args t))
106  (:hg (run-hg-command "push" $args t))
107  (t (skel-error "unknown VC type"))))
108 
109 (defcmd skc-pull
110  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
111  (:git (run-git-command "pull" $args t))
112  (:hg (run-hg-command "pull" (push "-u" $args) t))
113  (t (skel-error "unknown VC type"))))
114 
115 (defun hg-status ()
116  (let ((proc (run-hg-command "status" nil :stream)))
117  (copy-stream (process-output proc) *standard-output*)
118  (finish-output)))
119 
120 (defun git-status ()
121  (let ((proc (run-git-command "status" nil :stream)))
122  (copy-stream (process-output proc) *standard-output*)
123  (finish-output)))
124 
125 (defcmd skc-status
126  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
127  (:git (git-status))
128  (:hg (hg-status))
129  (t (hg-status))))
130 
131 (defcmd skc-clone
132  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
133  (:git (run-git-command "clone" $args t))
134  (:hg (run-hg-command "clone" $args t))
135  (t (skel-error "unknown VC type"))))
136 
137 (defcmd skc-commit
138  ;; (debug! $optc $argc)
139  (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t)))
140  (:git (run-git-command "commit" $args t))
141  (:hg (run-hg-command "commit" $args t))
142  (t (skel-error "unknown VC type"))))
143 
144 (defcmd skc-make
145  (let ((sk (find-skelfile #P"." :load t)))
146  (sb-ext:enable-debugger)
147  (if $args
148  (loop for a in $args
149  do (debug!
150  (when-let ((rule (sk-find-rule a sk)))
151  (sk-make sk rule))))
152  (debug! (sk-make sk (aref (sk-rules sk) 0))))))
153 
154 (defcmd skc-run
155  (if $args
156  (mapc (lambda (script)
157  (debug!
158  (sk-run
159  (sk-find-script
160  (pathname-name script)
161  (find-skelfile #P"." :load t))))) $args)
162  (required-argument :script)))
163 
164 (defcmd skc-shell
165  (sb-ext:enable-debugger)
166  (trace! "starting skel shell")
167  (setq *no-exit* t)
168  (cli/clap::with-cli-handlers
169  (progn
170  (in-package :sk-user)
171  (use-package :cl-user)
172  (use-package :sb-ext)
173  (use-package :std-user)
174  (init-skel-vars)
175  (println "Welcome to SKEL")
176  (sb-impl::toplevel-repl nil))))
177 
178 (define-cli $cli
179  :name "skel"
180  :version "0.1.1"
181  :description "A hacker's project compiler and build tool."
182  :thunk skc-describe
183  :opts (make-opts
184  (:name "help" :global t :description "print this message"
185  :thunk skc-help)
186  (:name "version" :global t :description "print version"
187  :thunk skc-version)
188  (:name "level" :global t :description "set log level (warn,info,debug,trace)"
189  :thunk skc-level)
190  (:name "config" :global t :description "set a custom skel user config" :kind file)
191  (:name "input" :global t :description "input source" :kind string)
192  (:name "output" :global t :description "output target" :kind string))
193  :cmds (make-cmds
194  (:name init
195  :description "initialize a skelfile in the current directory"
196  :opts (make-opts (:name "name" :description "project name" :kind string))
197  :thunk skc-init)
198  (:name describe
199  :description "describe a skelfile"
200  :thunk skc-describe)
201  (:name show
202  :description "show project slots"
203  :opts (make-opts
204  (:name "file" :description "path to skelfile" :kind file)
205  (:name "user" :description "print user configuration")
206  (:name "system" :description "print system configuration"))
207  :thunk skc-show)
208  (:name id
209  :description "print the project id"
210  :thunk skc-id)
211  (:name rev
212  :description "print the current vc revision id"
213  :thunk skc-rev)
214  (:name inspect
215  :description "inspect the project skelfile"
216  :opts (make-opts (:name "file" :description "path to skelfile" :kind file))
217  :thunk skc-inspect)
218  (:name make
219  :description "build project targets"
220  :opts (make-opts (:name "target" :description "target to build" :kind string))
221  :thunk skc-make)
222  (:name run
223  :description "run a script or command"
224  :thunk skc-run)
225  (:name status
226  :description "print the vc status"
227  :thunk skc-status)
228  (:name push
229  :description "push the current project upstream"
230  :thunk skc-push)
231  (:name pull
232  :description "pull the current project from remote"
233  :thunk skc-pull)
234  (:name clone
235  :description "clone a remote project"
236  :thunk skc-clone)
237  (:name commit
238  :description "commit changes to the project vc"
239  :thunk skc-commit)
240  (:name edit
241  :description "edit a project file in emacs."
242  :thunk skc-edit)
243  (:name shell
244  :description "open the sk-shell interpreter"
245  :thunk skc-shell)))
246 
247 (defpackage :sk-user
248  (:use :cl :std :skel))
249 
250 (defmain ()
251  (in-package :sk-user)
252  (let ((*log-level* :info))
253  (in-readtable :shell)
254  (with-cli (opts cmds) $cli
255  (load-skelrc)
256  (when-let ((project (find-skelfile #P".")))
257  (setq *skel-project* (load-skelfile project)))
258  (do-cmd $cli)
259  (debug-opts $cli))))