parse cli arguments and call create project in main

lspack.asd

@@ -2,7 +2,7 @@
   :author "Emre Akan"
   :description "Quickstart Common Lisp projects"
   :license "GPL-3.0"
-  :version "0.0.2"
+  :version "0.0.3"
   :depends-on ("uiop")
   :pathname "src/"
   :serial t

src/main.lisp

@@ -4,5 +4,83 @@
 
 (in-package :lspack/exe)
 
+(defun string-starts-with (str substr)
+  (when (>= (length str) (length substr))
+    (string= str substr :end1 (length substr))))
+
+(defclass <arguments> ()
+  ((name :initform nil
+         :accessor name)
+   (root :initform nil
+         :accessor root)
+   (author :initform nil
+           :accessor author)
+   (license :initform nil
+            :accessor license)
+   (description :initform ""
+                :accessor description)))
+
+(defun argument-key-p (arg)
+  (or (string-starts-with arg "-")
+      (string-starts-with arg "--")))
+
+(defun parse-keyword (args acc)
+  (destructuring-bind (key val . rest) args
+    (if (or (null val) (null key))
+        acc
+        (progn
+          (cond ((or (string= key "-r")
+                     (string= key "--root"))
+                 (setf (slot-value acc 'root) val))
+                ((or (string= key "-a")
+                     (string= key "--author"))
+                 (setf (slot-value acc 'author) val))
+                ((or (string= key "-l")
+                     (string= key "--license"))
+                 (setf (slot-value acc 'license) val))
+                ((or (string= key "-d")
+                     (string= key "--description"))
+                 (setf (slot-value acc 'description) val)))
+          (parse-keyword-arguments rest acc)))))
+
+(defun parse-keyword-arguments (args acc)
+  (let ((arg (car args)))
+    (cond ((null arg) acc)
+          ((argument-key-p arg) (parse-keyword args acc))
+          (t ))))
+
+(defun parse-arguments-header (args acc)
+  (let ((arg (car args)))
+    (unless (or (null arg) (argument-key-p arg))
+      (setf (slot-value acc 'name) arg)
+      (parse-keyword-arguments (cdr args) acc))))
+
+(defun parse-arguments (args)
+  (let ((acc (make-instance '<arguments>)))
+    (parse-arguments-header args acc)))
+
+(defmethod create-project ((argument <arguments>))
+  (lspack:start (name argument) (root argument)
+                :license (license argument)
+                :description (description argument)
+                :author (author argument)))
+
+(defmethod normalize-arguments ((argument <arguments>))
+  (setf (root argument)
+        (if (null (root argument))
+            (uiop:ensure-directory-pathname (name argument))
+            (uiop:ensure-directory-pathname (root argument))))
+  (when (null (author argument))
+    (setf (author argument) lspack:*default-author*))
+  (let ((license (license argument)))
+    (setf (license argument)
+          (cond ((null license) lspack:*default-license*)
+                ((stringp license) (intern (string-upcase license) :keyword))
+                (t lspack:*default-license*))))
+  argument)
+
 (defun main ()
-  (format t "Hello World!"))
+  (format t "cwd: ~S~%" (uiop:getcwd))
+  (let ((args (parse-arguments (uiop:command-line-arguments))))
+    (normalize-arguments args)
+    (create-project args)))

src/package.lisp

@@ -1,3 +1,5 @@
 (defpackage :lspack
   (:use :cl)
-  (:export :start))
+  (:export #:start
+           #:*default-author*
+           #:*default-license*))

src/starter.lisp

@@ -61,12 +61,12 @@
                               :if-exists :supersede
                               :if-does-not-exist :create)
       (project-defsystem-write project out))
-    (format *error-output* "~&Created ~S" path)))
+    (format *error-output* "~&Created ~S~%" path)))
 
 (defmethod project-ensure-root ((project <project>))
   (with-slots (root) project
     (ensure-directories-exist (uiop:physicalize-pathname root))
-    (format *error-output* "~&Starting project at ~S" root)))
+    (format *error-output* "~&Starting project at ~S~%" root)))
 
 (defmethod project-source-pathname ((project <project>))
   (uiop:merge-pathnames* (uiop:ensure-directory-pathname (project-pathname project))
@@ -78,7 +78,7 @@
       (format *error-output* "~&Source directory: ~S" src)
       (unless (string= pathname "")
         (ensure-directories-exist (uiop:physicalize-pathname src))
-        (format *error-output* " created.")))))
+        (format *error-output* " created.~%")))))
 
 (defmethod project-write-notice ((project <project>) stream)
   (uiop:if-let ((notice (get-notice (project-license project))))
@@ -95,7 +95,7 @@
                                 :if-does-not-exist :create)
         (project-write-notice project out)
         (format out "~&(defpackage :~a~%  (:use :cl))~%" name))
-      (format *error-output* "~&Created ~S" path))))
+      (format *error-output* "~&Created ~S~%" path))))
 
 (defmethod project-license-create ((project <project>))
   (let ((license (get-license (project-license project))))
@@ -108,7 +108,7 @@
                                             :if-exists :supersede
                                             :if-does-not-exist :create)
             (funcall writer project out))
-          (format *error-output* "~&Created ~S" license-file))))))
+          (format *error-output* "~&Created ~S~%" license-file))))))
 
 (defmethod project-start ((project <project>))
   (project-ensure-root project)