changeset 563: |
8b10eabe89dd |
parent: |
42bc1432f217
|
child: |
32995daa9a07 |
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sun, 28 Jul 2024 20:49:47 -0400 |
permissions: |
-rw-r--r-- |
description: |
std/tests, clap tweaks |
3 ;; TODO 2024-05-09: add shell configurables to rules - maybe at sk-command 4 ;; level. :INPUT :WAIT :OUTPUT 7 (:use :cl :std :cli/clap 9 :dat/sxp #+tools :skel/tools/viz) 10 (:import-from :cli/shell :*shell-input*) 11 (:use :cli/tools/sbcl) 14 (in-package :bin/skel) 17 (defopt skc-help (print-help *cli*) *arg*) 18 (defopt skc-version (print-version *cli*)) 19 (defopt skc-level *log-level* 20 (setq *log-level* (if *arg* (if (stringp *arg*) 21 (sb-int:keywordicate (string-upcase *arg*)) 25 ;; TODO 2023-10-13: almost there 27 ;; (init-user-skelrc (when *arg* (parse-file-opt *arg*)))) 30 (let ((file (or (when *args* (pop *args*)) (sk-path *skel-project*)))) 31 (cli/ed:run-emacsclient (namestring file)))) 34 (let ((file (when *args* (pop *args*))) 35 (name (when (> *argc* 1) (pop *args*)))) 36 ;; TODO: test, may need to be 37 ;; sequential for side-effect 42 (std:println (format nil "file already exists: ~A" (or file *default-skelfile*))) 43 (let ((f2 (read-line))) 47 (init-skelfile file name)))) 52 (find-skelfile (pathname (car *args*)) :load t) 53 (or *skel-project* *skel-user-config* *skel-system-config*)))) 57 (sb-ext:enable-debugger) 61 (if *args* (pathname (car *args*)) 68 (let ((stuff (loop for a in *args* 69 collect (sk-slot-case a)))) 70 (sk-view (if (= 1 (length stuff)) (car stuff) stuff))) 71 (sk-view (if (boundp '*skel-project*) *skel-project* 72 (if (boundp '*skel-user-config*) *skel-user-config* 73 (if (boundp '*skel-system-config*) *skel-system-config* 74 (skel-simple-error "skel config files not installed"))))))) 77 (println (std:format-sxhash (obj/id:id (find-skelfile #P"." :load t))))) 79 (defcmd skc-compile () 80 (sk-call *skel-project* :compile)) 83 (sk-call *skel-project* :build)) 85 (sk-call *skel-project* :dist)) 86 (defcmd skc-install () 87 (sk-call *skel-project* :install)) 89 (sk-call *skel-project* :pack)) 91 (sk-call *skel-project* :unpack)) 93 (sk-call *skel-project* :bundle)) 94 (defcmd skc-unbundle () 95 (sk-call *skel-project* :unbundle)) 97 (sk-call *skel-project* :clean)) 99 (sk-call *skel-project* :test)) 101 (sk-call *skel-project* :bench)) 104 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 106 (let ((proc (run-hg-command "id" (list "-i") :stream))) 107 (println (read-line (process-output proc)))))) 109 (let ((proc (run-git-command "rev-parse" (list "HEAD") :stream))) 110 (println (read-line (process-output proc)))))) 111 (t (skel-simple-error "unknown VC type")))) 113 (defun sk-slot-case (sel) 114 (std/string:string-case (sel :default (skel-simple-error "invalid slot")) 115 (":id" (std:format-sxhash (obj/id:id *skel-project*))) 116 (":name" (sk-name *skel-project*)) 117 (":author" (sk-author *skel-project*)) 118 (":version" (sk-version *skel-project*)) 119 (":description" (sk-description *skel-project*)) 120 (":tags" (sk-tags *skel-project*)) 121 (":license" (sk-license *skel-project*)) 122 (":vc" (sk-vc *skel-project*)) 123 (":components" (sk-components *skel-project*)) 124 (":scripts" (sk-scripts *skel-project*)) 125 (":rules" (sk-rules *skel-project*)) 126 (":env" (sk-env *skel-project*)) 127 (":bind" (sk-bind *skel-project*)) 128 (":include" (sk-include *skel-project*)) 129 (":stash" (sk-stash *skel-project*)) 130 (":store" (sk-store *skel-project*)) 131 (":config" *skel-user-config*) 132 (":sys" *skel-system-config*) 133 (":cache" (sk-cache *skel-user-config*)))) 137 (mapc (lambda (x) (when-let ((ret (sk-slot-case x))) (println ret))) *args*) 138 (describe (if (boundp '*skel-project*) *skel-project* 139 (if (boundp '*skel-user-config*) *skel-user-config* 140 (if (boundp '*skel-system-config*) *skel-system-config* 141 (skel-simple-error "skel config files not installed"))))))) 144 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 145 (:git (run-git-command "push" *args* t)) 146 (:hg (run-hg-command "push" *args* t)) 147 (t (skel-simple-error "unknown VC type")))) 150 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 151 (:git (run-git-command "pull" *args* t)) 152 (:hg (run-hg-command "pull" (append '("-u") *args*) t)) 153 (t (skel-simple-error "unknown VC type")))) 156 (with-open-stream (proc (process-output (run-hg-command "status" nil :stream))) 157 (loop for x = (read-line proc nil) 162 (with-open-stream (proc (run-git-command "status" nil :stream)) 163 (loop for x = (read-line proc nil) 168 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 174 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 175 (:git (run-git-command "clone" *args* t)) 176 (:hg (run-hg-command "clone" *args* t)) 177 (t (skel-simple-error "unknown VC type")))) 180 ;; (debug! *optc* *argc*) 181 (case (sk-vc-meta-kind (sk-vc (find-skelfile #P"." :load t))) 182 (:git (run-git-command "commit" *args* t)) 183 (:hg (run-hg-command "commit" *args* t)) 184 (t (skel-simple-error "unknown VC type")))) 187 (let ((sk (find-skelfile #P"." :load t))) 188 (sb-ext:enable-debugger) 190 ;; (setq *no-exit* t) 192 (loop for a in *args* 194 (when-let ((rule (sk-find-rule a sk))) 196 (debug! (sk-make sk (aref (sk-rules sk) 0)))))) 200 (mapc (lambda (script) 204 (pathname-name script) 205 (find-skelfile #P"." :load t))))) *args*) 206 (required-argument 'name))) 210 (std/string:string-case ((car *args*) :default (skel-simple-error "invalid command")) 211 ("status" (skc-status nil nil))) 212 (skc-status nil *opts*))) 215 (sb-ext:enable-debugger) 216 (trace! "starting skel shell") 218 (cli/clap::with-cli-handlers 220 (in-package :sk-user) 221 (use-package :cl-user) 222 (use-package :sb-ext) 223 (use-package :std-user) 225 (println "Welcome to SKEL") 226 (sb-impl::toplevel-repl nil)))) 229 (trace! *args* *opts*)) 233 :version #.(format nil "0.1.1:~A" (read-line (sb-ext:process-output (vc:run-hg-command "id" '("-i") :stream)))) 234 :description "A hacker's project compiler." 237 (:name "help" :global t :description "print this message" 239 (:name "version" :global t :description "print version" 241 (:name "level" :global t :description "set log level (warn,info,debug,trace)" 243 (:name "config" :global t :description "set a custom skel user config" :kind file) 244 (:name "input" :global t :description "input source" :kind string) 245 (:name "output" :global t :description "output target" :kind string)) 248 :description "initialize a skelfile in the current directory" 249 :opts (make-opts (:name "name" :description "project name" :kind string)) 252 :description "make a new skel project" 253 :opts (make-opts (:name "name" :description "project name" :kind string)) 256 :description "describe a skelfile" 259 :description "show project slots" 261 (:name "file" :description "path to skelfile" :kind file) 262 (:name "user" :description "print user configuration") 263 (:name "system" :description "print system configuration")) 266 :description "version control" 269 (:name "root" :description "repository path" :kind directory))) 271 :description "print the project id" 274 :description "print the current vc revision id" 277 :description "inspect the project skelfile" 278 :opts (make-opts (:name "file" :description "path to skelfile" :kind file)) 282 :description "view an object in a new GUI window" 285 :description "build project targets" 286 :opts (make-opts (:name "target" :description "target to build" :kind string)) 289 :description "run a script or command" 292 :description "compile source code" 295 :description "build programs and libraries" 298 :description "distribute build artifacts" 301 :description "install stuff" 304 :description "pack stuff" 307 :description "unpack stuff" 310 :description "bundle source code" 313 :description "unbundle source code" 316 :description "clean up the project" 319 :description "run tests" 322 :description "run benchmark" 325 :description "print the vc status" 328 :description "push the current project upstream" 331 :description "pull the current project from remote" 334 :description "clone a remote project" 337 :description "commit changes to the project vc" 340 :description "edit a project file in emacs." 343 :description "open the sk-shell interpreter" 347 (in-package :sk-user) 348 (let ((*log-level* :info)) 349 (in-readtable :shell) 350 (with-cli (opts cmds) *cli* 352 (when-let ((project (find-skelfile #P"."))) 353 (setq *skel-project* (load-skelfile project))) 355 (debug-opts *cli*))))