Finish port to asdf and make webserer template files

.gitignore

@@ -1 +1,2 @@
-truth-table
+truth-table
+truth-table-webserver

Makefile

@@ -2,14 +2,19 @@ LISP ?= sbcl
 
 BASE_FILES=packages.lisp parse.lisp table.lisp typeset.lisp eval.lisp
 CLI_FILES=cli.lisp
+WEB_FILES=web.lisp
 
-all: cli
+all: cli web
 
 cli: truth-table
 truth-table: build.lisp truth-table.asd $(BASE_FILES) $(CLI_FILES)
 	$(LISP) --load build.lisp --eval '(cli)'
 
+web: truth-table-webserver
+truth-table-webserver: build.lisp truth-table.asd $(BASE_FILES) $(WEB_FILES)
+	$(LISP) --load build.lisp --eval '(web)'
+
 clean:
-	rm -f truth-table
+	rm -f truth-table truth-table-webserver
 
 .PHONY: all cli clean

arguments.lisp

@@ -0,0 +1,158 @@
+;; arguments.lisp -- Command line option parsing
+;; Copyright (C) 2024  Alexander Rosenberg
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+(in-package :truth-table/args)
+
+(define-condition command-line-error (error)
+  ((message :initarg :message
+            :accessor command-line-error-message))
+  (:report (lambda (con stream)
+             (format stream "~a"
+                     (command-line-error-message con))))
+  (:documentation "The parent condition of all command line errors."))
+
+(define-condition cli-argument-error (command-line-error)
+  ((opt :initarg :opt
+        :accessor cli-argument-error-opt))
+  (:report (lambda (con stream)
+             (with-slots (opt message) con
+               (format stream
+                       "~a: ~:[--~a~;-~c~]" message (characterp opt) opt))))
+  (:documentation "Condition representing an error that occurred during
+processing of command line arguments."))
+
+(define-condition unknown-option-error (cli-argument-error)
+  ((message :initform "unknown option"))
+  (:documentation "Condition representing an unknown command line option."))
+
+(define-condition option-no-arg-error (cli-argument-error)
+  ((message :initform "option requires an argument"))
+  (:documentation "Condition representing an error that occurred because a
+command line option did not have its required argument."))
+
+(define-condition no-input-error (command-line-error)
+  ((message :initform "no propositions given"))
+  (:documentation "Condition representing no propositions given on the command
+line."))
+
+(defparameter *cli-parse-continue-string*
+  "Continue paring arguments normally."
+  "String to use for `cerror' during argument parsing.")
+
+(defun parse-long-option (spec arg next-arg)
+  "Parse the long option ARG. Return a list of its symbol, its value (or t if
+it did not have one), and weather it consumed NEXT-ARG or not."
+  (destructuring-bind (name &optional value)
+      (uiop:split-string (subseq arg 2)
+                         :max 2
+                         :separator "=")
+    (loop for (short long symbol has-arg-p dest) in spec
+          when (equal name long) do
+            (if has-arg-p
+                (cond
+                  (value
+                   (return (list symbol value nil)))
+                  (next-arg
+                   (return (list symbol next-arg t)))
+                  (t
+                   (cerror *cli-parse-continue-string*
+                           'option-no-arg-error :opt name)
+                   (return (list symbol nil nil))))
+                (return (list symbol t nil)))
+          finally
+             (cerror *cli-parse-continue-string*
+                     'unknown-option-error :opt name)
+             (return (list symbol nil nil)))))
+
+(defun parse-short-option (spec arg next-arg)
+  "Parse the short options in ARG according to SPEC. Return a list of options
+with each entry being similar to the return value of `parse-long-option'."
+  (loop with output = '()
+        for i from 1 to (1- (length arg))
+        for char = (elt arg i)
+        for (short long symbol has-arg-p desc) = (assoc char spec) do
+          (cond
+            (has-arg-p
+             (cond
+               ((< i (1- (length arg)))
+                (push (list symbol (subseq arg (1+ i)) nil) output)
+                (return output))
+               (next-arg
+                (push (list symbol next-arg t) output)
+                (return output))
+               (t
+                (cerror *cli-parse-continue-string*
+                        'option-no-arg-error :opt char))))
+            (short
+             (push (list symbol t nil) output))
+            (t
+             (cerror *cli-parse-continue-string*
+                     'unknown-option-error :opt char)))
+        finally (return output)))
+
+(defun parse-command-line (spec argv)
+  "Parse command line arguments in ARGV according to SPEC. Return an alist with
+the car being the option's symbol (as specified in SPEC), and the cdr being
+the argument it had on the command line, or t if it had none. The rest of the
+arguments will be placed in a list at the beginning of the alist."
+  (let ((output-opts '())
+        (output-other '()))
+    (loop for (arg . rest) = argv then rest
+        while (and arg (not (equal arg "--"))) do
+          (cond
+            ((uiop:string-prefix-p "--" arg)
+             (destructuring-bind (symbol value skip-next-p)
+                 (parse-long-option spec arg (car rest))
+               (push (cons symbol value) output-opts)
+               (when skip-next-p
+                 (setq rest (cdr rest)))))
+            ((uiop:string-prefix-p "-" arg)
+             (loop for (symbol value skip-next-p) in (parse-short-option
+                                                      spec arg (car rest))
+                   do
+                      (push (cons symbol value) output-opts)
+                      (when skip-next-p
+                        (setq rest (cdr rest)))))
+            (t
+             (push arg output-other)))
+          finally (setf output-other (nconc (nreverse rest) output-other)))
+    (cons (nreverse output-other) output-opts)))
+
+(defun print-usage (stream spec exec-name &optional general-args)
+  "Print the command line usage corresponding to SPEC to STREAM."
+  (format stream "usage: ~a [options]~@[ ~a~]~%~%" exec-name general-args)
+  (loop with longest-option
+          = (apply 'max (mapcar
+                         (lambda (entry)
+                           (destructuring-bind (short long sym has-arg-p &rest other)
+                               entry
+                             (declare (ignorable other sym))
+                             (+ (if short 2 0)
+                                (if long (+ 2 (length long)) 0)
+                                (if (and short long) 2 0)
+                                (if has-arg-p 6 0))))
+                         spec))
+        for (short long symbol has-arg-p desc) in spec
+        do
+           (format stream "  ~v@<~@[-~c~]~@[, ~*~]~@[--~a~]~@[=<arg>~*~]~>  ~a~%"
+                   longest-option
+                   short (or short long) long has-arg-p desc))
+  (format stream "~%The choice surrounded by '*' is the default. Arguments to long
+options are also required for their short variant.~%"))
+
+(defun option-value (opt opts)
+  "Get the value of command line option OPT from OTPS, which is an alist as
+returned as the second output of `parse-command-line'."
+  (cdr (assoc opt opts)))

build.lisp

@@ -17,3 +17,13 @@
    :executable t
    :save-runtime-options t
    :toplevel (intern "TOPLEVEL" :truth-table/cli)))
+
+(defun web ()
+  "Build the web server executable."
+  (asdf:load-system :truth-table/web)
+  (require :truth-table/web)
+  (sb-ext:save-lisp-and-die
+   "truth-table-webserver"
+   :executable t
+   :save-runtime-options t
+   :toplevel (intern "TOPLEVEL" :truth-table/web)))

cli.lisp

@@ -15,38 +15,6 @@
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 (in-package :truth-table/cli)
 
-(define-condition command-line-error (error)
-  ((message :initarg :message
-            :accessor command-line-error-message))
-  (:report (lambda (con stream)
-             (format stream "~a"
-                     (command-line-error-message con))))
-  (:documentation "The parent condition of all command line errors."))
-
-(define-condition cli-argument-error (command-line-error)
-  ((opt :initarg :opt
-        :accessor cli-argument-error-opt))
-  (:report (lambda (con stream)
-             (with-slots (opt message) con
-               (format stream
-                       "~a: ~:[--~a~;-~c~]" message (characterp opt) opt))))
-  (:documentation "Condition representing an error that occurred during
-processing of command line arguments."))
-
-(define-condition unknown-option-error (cli-argument-error)
-  ((message :initform "unknown option"))
-  (:documentation "Condition representing an unknown command line option."))
-
-(define-condition option-no-arg-error (cli-argument-error)
-  ((message :initform "option requires an argument"))
-  (:documentation "Condition representing an error that occurred because a
-command line option did not have its required argument."))
-
-(define-condition no-input-error (command-line-error)
-  ((message :initform "no propositions given"))
-  (:documentation "Condition representing no propositions given on the command
-line."))
-
 (defun eval-and-typeset-propositions (prop-strs &key (format "unicode")
                                                   (implicit-and t)
                                                   multi-char-names
@@ -83,116 +51,6 @@ functions involved in evaluating and typesetting."
   "Specification for `parse-command-line'. This is of the format:
 (short long symbol has-arg-p desc).")
 
-(defparameter *cli-parse-continue-string*
-  "Continue paring arguments normally."
-  "String to use for `cerror' during argument parsing.")
-
-(defun parse-long-option (spec arg next-arg)
-  "Parse the long option ARG. Return a list of its symbol, its value (or t if
-it did not have one), and weather it consumed NEXT-ARG or not."
-  (destructuring-bind (name &optional value)
-      (uiop:split-string (subseq arg 2)
-                         :max 2
-                         :separator "=")
-    (loop for (short long symbol has-arg-p dest) in spec
-          when (equal name long) do
-            (if has-arg-p
-                (cond
-                  (value
-                   (return (list symbol value nil)))
-                  (next-arg
-                   (return (list symbol next-arg t)))
-                  (t
-                   (cerror *cli-parse-continue-string*
-                           'option-no-arg-error :opt name)
-                   (return (list symbol nil nil))))
-                (return (list symbol t nil)))
-          finally
-             (cerror *cli-parse-continue-string*
-                     'unknown-option-error :opt name)
-             (return (list symbol nil nil)))))
-
-(defun parse-short-option (spec arg next-arg)
-  "Parse the short options in ARG according to SPEC. Return a list of options
-with each entry being similar to the return value of `parse-long-option'."
-  (loop with output = '()
-        for i from 1 to (1- (length arg))
-        for char = (elt arg i)
-        for (short long symbol has-arg-p desc) = (assoc char spec) do
-          (cond
-            (has-arg-p
-             (cond
-               ((< i (1- (length arg)))
-                (push (list symbol (subseq arg (1+ i)) nil) output)
-                (return output))
-               (next-arg
-                (push (list symbol next-arg t) output)
-                (return output))
-               (t
-                (cerror *cli-parse-continue-string*
-                        'option-no-arg-error :opt char))))
-            (short
-             (push (list symbol t nil) output))
-            (t
-             (cerror *cli-parse-continue-string*
-                     'unknown-option-error :opt char)))
-        finally (return output)))
-
-(defun parse-command-line (spec argv)
-  "Parse command line arguments in ARGV according to SPEC. Return an alist with
-the car being the option's symbol (as specified in SPEC), and the cdr being
-the argument it had on the command line, or t if it had none. The rest of the
-arguments will be placed in a list at the beginning of the alist."
-  (let ((output-opts '())
-        (output-other '()))
-    (loop for (arg . rest) = argv then rest
-        while (and arg (not (equal arg "--"))) do
-          (cond
-            ((uiop:string-prefix-p "--" arg)
-             (destructuring-bind (symbol value skip-next-p)
-                 (parse-long-option spec arg (car rest))
-               (push (cons symbol value) output-opts)
-               (when skip-next-p
-                 (setq rest (cdr rest)))))
-            ((uiop:string-prefix-p "-" arg)
-             (loop for (symbol value skip-next-p) in (parse-short-option
-                                                      spec arg (car rest))
-                   do
-                      (push (cons symbol value) output-opts)
-                      (when skip-next-p
-                        (setq rest (cdr rest)))))
-            (t
-             (push arg output-other)))
-          finally (setf output-other (nconc (nreverse rest) output-other)))
-    (cons (nreverse output-other) output-opts)))
-
-(defun print-usage (stream spec)
-  "Print the command line usage corresponding to SPEC to STREAM."
-  (format stream "usage: truth-table [options] <propositions...>~%~%")
-  (loop with longest-option
-          = (apply 'max (mapcar
-                         (lambda (entry)
-                           (destructuring-bind (short long sym has-arg-p &rest other)
-                               entry
-                             (declare (ignorable other sym))
-                             (+ (if short 2 0)
-                                (if long (+ 2 (length long)) 0)
-                                (if (and short long) 2 0)
-                                (if has-arg-p 6 0))))
-                         spec))
-        for (short long symbol has-arg-p desc) in spec
-        do
-           (format stream "  ~v@<~@[-~c~]~@[, ~*~]~@[--~a~]~@[=<arg>~*~]~>  ~a~%"
-                   longest-option
-                   short (or short long) long has-arg-p desc))
-  (format stream "~%The choice surrounded by '*' is the default. Arguments to long
-options are also required for their short variant.~%"))
-
-(defun option-value (opt opts)
-  "Get the value of command line option OPT from OTPS, which is an alist as
-returned as the second output of `parse-command-line'."
-  (cdr (assoc opt opts)))
-
 (defun main (argv)
   "The main entry point to the program. ARGV is the list of command line
 arguments."
@@ -212,7 +70,8 @@ arguments."
           (parse-command-line *command-line-spec* argv)
         (cond
           ((option-value 'help opts)
-           (print-usage t *command-line-spec*)
+           (print-usage t *command-line-spec*
+                        "truth-table" "<propositions...>")
            (uiop:quit (if cmdline-error 1 0)))
           ((null prop-strs)
            (cerror *cli-parse-continue-string* 'no-input-error))

packages.lisp

@@ -47,6 +47,25 @@
    #:*known-formats*
    #:typeset-table-to-format))
 
+(defpackage #:truth-table/args
+  (:use #:common-lisp)
+  (:export
+   #:*cli-parse-continue-string*
+   #:command-line-error
+   #:cli-argument-error
+   #:unknown-option-error
+   #:option-no-arg-error
+   #:no-input-error
+   #:parse-command-line
+   #:print-usage
+   #:option-value))
+
 (defpackage #:truth-table/cli
-  (:use #:common-lisp #:truth-table/base)
+  (:use #:common-lisp #:truth-table/base
+        #:truth-table/args)
+  (:export #:toplevel #:main))
+
+(defpackage #:truth-table/web
+  (:use #:common-lisp #:truth-table/base
+        #:truth-table/args)
   (:export #:toplevel #:main))

truth-table.asd

@@ -1,11 +1,12 @@
 (defsystem #:truth-table
+  :version "0.0.1"
   :description "Tools for working with logical propositions and truth tables"
   :author "Alexander Rosenberg <zanderpkg@pm.me>"
   :license "AGPL3"
   :depends-on ())
 
 (defsystem #:truth-table/base
-  :version "0.0.1"
+  :depends-on ()
   :serial t
   :components
   ((:file "packages")
@@ -14,11 +15,31 @@
    (:file "table")
    (:file "typeset")))
 
+(defsystem #:truth-table/args
+  :depends-on (#:uiop)
+  :serial t
+  :components
+  ((:file "packages")
+   (:file "arguments")))
+
 (defsystem #:truth-table/cli
   :depends-on (#:uiop
                #:with-user-abort
-               #:truth-table/base)
+               #:truth-table/base
+               #:truth-table/args)
   :serial t
   :components
   ((:file "packages")
    (:file "cli")))
+
+(defsystem #:truth-table/web
+  :depends-on (#:uiop
+               #:with-user-abort
+               #:reblocks
+               #:reblocks-ui
+               #:truth-table/base
+               #:truth-table/args)
+  :serial t
+  :components
+  ((:file "packages")
+   (:file "web")))

web.lisp

@@ -0,0 +1,30 @@
+;; web.lisp -- Website to allow users to make truth tables
+;; Copyright (C) 2024  Alexander Rosenberg
+;;
+;; This program is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+(in-package :truth-table/web)
+
+(defun main (argv)
+  "The main entry point to the program. ARGV is the list of command line
+arguments."
+  (format t "Hello World~%"))
+
+(defun toplevel ()
+  "Top-level function to be passed to `save-lisp-and-die'."
+  (handler-case
+      (with-user-abort:with-user-abort
+        (main (uiop:command-line-arguments)))
+    (with-user-abort:user-abort ()
+      (format *error-output* "Keyboard interrupt~%")
+      (uiop:quit 1))))