Darned if the thing doesn't actually generate a working Lisp program.

src/main.lisp

@@ -6,49 +6,181 @@
  (let ((sep-fmt (format nil "~~{~~a~~^~a~~}" sep)))
  (format nil sep-fmt args)))
 
-(defun join (&rest args)
+(defun join/ (&rest args)
  (join-w-sep "/" args))
 
 (defun project-path (projname)
- (join (lisp-home) projname))
+ (join/ (lisp-home) projname))
 
 (defun find-project (projname)
  (uiop:probe-file* (project-path projname)))
 
 (project-path "steelcut")
 (find-project "steelcut")
-(find-project "steelcutter")
+(find-project "steelcutter") ;;=> nil
 
-(project-path "steelcut")
+(defun add-project-file (projname filename contents)
+ (let ((path (join/ (project-path projname) filename)))
+ (ensure-directories-exist path)
+ (spit path contents)))
 
-(defun make-project (projname)
- (ensure-directories-exist (str (project-path projname) "/")))
+(defun replace-project (projname s)
+ (replace-all "PROJNAME" projname s))
+
+(defun render-project-file (projname filename contents)
+ (add-project-file projname
+ filename
+ (replace-project projname contents)))
+
+(defun add-gitignore (projname)
+ (render-project-file projname
+ ".gitignore"
+ "**/*.fasl
+PROJNAME
+"))
+
+(defun add-package-lisp (projname)
+ (render-project-file projname
+ "src/package.lisp"
+ "(defpackage PROJNAME
+ (:use :cl :arrows)
+ (:export :main))
+"))
+
+(defun add-main-lisp (projname)
+ (render-project-file projname
+ "src/main.lisp"
+ "(in-package #:PROJNAME)
+
+(defun main ()
+ (format t \"Thanks for using PROJNAME!~%\"))
+"))
+
+(defun add-makefile (projname)
+ (render-project-file projname
+ "Makefile"
+ ".PHONY: clean install test
+
+PROJNAME: src/*.lisp
+ ./build.sh
+
+test:
+ ./test.sh
+
+clean:
+ rm -rf PROJNAME
+
+install: PROJNAME
+ test -n \"$(BINDIR)\" # $$BINDIR
+ cp PROJNAME ${BINDIR}
+"))
+
+(defun chmod (mode path)
+ (uiop:run-program (list "chmod" mode (str path))))
+
+(defun add-build-sh (projname)
+ (render-project-file projname
+ "build.sh"
+ "#!/bin/sh
+
+# Adapted from
+# https://github.com/cicakhq/potato/blob/master/tools/build_binary.sh;
+# Quicklisp path hack from
+# https://www.darkchestnut.com/2016/quicklisp-load-personal-projects-from-arbitrary-locations/
+
+sbcl --non-interactive \\
+ --disable-debugger \\
+ --eval '(pushnew (truename \".\") ql:*local-project-directories*)' \\
+ --eval '(ql:register-local-projects)' \\
+ --eval '(ql:quickload :PROJNAME)' \\
+ --eval '(progn (sb-ext:disable-debugger) (sb-ext:save-lisp-and-die \"PROJNAME\" :toplevel #'\"'\"'PROJNAME:main :executable t))'
+")
+ (chmod "+x" (join/ (project-path projname) "build.sh")))
+
+(defun add-asd (projname)
+ (render-project-file projname
+ (str projname ".asd")
+ "(defsystem :PROJNAME
+ :description \"FIXME\"
+ :author \"FIXME\"
+ :license \"FIXME\"
+ :build-operation \"program-op\"
+ :build-pathname \"PROJNAME\"
+ :entry-point \"PROJNAME:main\"
+ :depends-on (:arrows)
+ :components ((:module \"src\"
+ :components ((:file \"package\")
+ (:file \"main\" :depends-on (\"package\"))))))
+
+(defsystem :PROJNAME/test
+ :description \"FIXME\"
+ :author \"FIXME\"
+ :license \"FIXME\"
+ :depends-on (:PROJNAME :1am)
+ :serial t
+ :components ((:module \"test\"
+ :serial t
+ :components ((:file \"package\")
+ (:file \"test\"))))
+ :perform (asdf:test-op (op system)
+ (funcall (read-from-string \"PROJNAME.test:run-tests\"))))
+"))
 
-(make-project "foo")
-(project-path "foo")
-(find-project "foo")
-(find-project "food")
+(defun make-project (projname)
+ (ensure-directories-exist (str (project-path projname) "/"))
+ (add-gitignore projname)
+ (add-package-lisp projname)
+ (add-main-lisp projname)
+ (add-makefile projname)
+ (add-build-sh projname)
+ (add-asd projname)
+ t)
+
+(defun file-seq (path)
+ (let ((ret))
+ (cl-fad:walk-directory path
+ (lambda (name)
+ (push name ret))
+ :directories t)
+ ret))
+
+(defun project-files (projname)
+ (file-seq (project-path projname)))
+
+(defun project-contents (projname)
+ (loop for f in (project-files projname)
+ collect (list f (when-not (directory-exists-p f)
+ (slurp f)))))
 
 (defun destroy-project!!! (projname)
  (fad:delete-directory-and-files (project-path projname)))
 
 (comment
+ (find-project "food")
+ (make-project "foo")
+ (find-project "foo")
+
+ (project-path "foo")
  (destroy-project!!! "foo")
- (find-project "foo"))
+ (find-project "foo")
+ (project-contents "foo"))
 
-(defun add-project-file (projname filename contents)
- (spit (join (project-path projname) filename) contents))
+(defun usage ()
+ "Usage: PROJNAME <appname>")
 
-(defun add-gitignore (projname)
- (add-project-file projname ".gitignore"
-  (format nil "**/*.fasl
-~a
-"
-  projname)))
+(defun main ()
+ (let* ((args sb-ext::*posix-argv*)
+ (appname (second args)))
+ (cond
+ ((not appname)
+ (format t "~a~%"(usage)))
 
-(add-gitignore "foo")
+ ((find-project appname)
+ (format t "Project ~a already exists!~%" appname))
 
-(slurp (join (project-path "foo") ".gitignore"))
+ (t (progn
+ (make-project appname)
+ (format t
+ "Project ~a created. Thanks for using steelcut!~%"
+ appname))))))
 
-(defun main ()
- (format t "Thanks for using steelcut!~%"))

src/package.lisp

@@ -1,3 +1,3 @@
 (defpackage steelcut
- (:use :cl :arrows :cl-fad :cl-oju)
+ (:use :cl :arrows :cl-fad :cl-oju :str)
  (:export :main))

steelcut.asd

@@ -7,7 +7,8 @@
  :entry-point "steelcut:main"
  :depends-on (:arrows
  :cl-fad
- :cl-oju)
+ :cl-oju
+ :str)
  :components ((:module "src"
  :components ((:file "package")
  (:file "main" :depends-on ("package"))))))