From 51d2213aae8159484b10680cd9f627259afa0212 Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Sun, 11 Sep 2022 07:23:58 +0100 Subject: [PATCH] delete site stubbed out with the cookie cutter app. I tried it and I find it easier to work with Caveman2. I didn't realise this templating program is built around Hunchentoot -- whereas Caveman2 builds on top of. So, I'm moving the code to back to Caveman2 -- where I originally started. It looks like a waste of time but the knowledge of having a look at the other stuff has been helpful. --- Makefile | 16 --- README.md | 101 ----------------- README.org | 9 -- config-example.lisp | 12 -- ritherdon-archive-tests.asd | 18 --- roswell/README.md | 37 ------- roswell/ritherdon-archive.ros | 28 ----- run-tests.lisp | 9 -- run.lisp | 25 ----- src/database.lisp | 30 ----- src/models/models.lisp | 61 ---------- src/packages.lisp | 41 ------- src/ritherdon-archive.lisp | 105 ------------------ src/static/ritherdon-archive.js | 2 - src/templates/base.html | 144 ------------------------ src/templates/dashboard.html | 177 ------------------------------ tests/packages.lisp | 8 -- tests/test-ritherdon-archive.lisp | 16 --- 18 files changed, 839 deletions(-) delete mode 100644 Makefile delete mode 100644 README.md delete mode 100644 README.org delete mode 100644 config-example.lisp delete mode 100644 ritherdon-archive-tests.asd delete mode 100644 roswell/README.md delete mode 100644 roswell/ritherdon-archive.ros delete mode 100644 run-tests.lisp delete mode 100644 run.lisp delete mode 100644 src/database.lisp delete mode 100644 src/models/models.lisp delete mode 100644 src/packages.lisp delete mode 100644 src/ritherdon-archive.lisp delete mode 100644 src/static/ritherdon-archive.js delete mode 100644 src/templates/base.html delete mode 100644 src/templates/dashboard.html delete mode 100644 tests/packages.lisp delete mode 100644 tests/test-ritherdon-archive.lisp diff --git a/Makefile b/Makefile deleted file mode 100644 index 74a2597..0000000 --- a/Makefile +++ /dev/null @@ -1,16 +0,0 @@ -LISP ?= sbcl - -all: test - -run: - rlwrap $(LISP) --load run.lisp - -build: - $(LISP) --non-interactive \ - --load ritherdon-archive.asd \ - --eval '(ql:quickload :ritherdon-archive)' \ - --eval '(asdf:make :ritherdon-archive)' - -test: - $(LISP) --non-interactive \ - --load run-tests.lisp diff --git a/README.md b/README.md deleted file mode 100644 index 50ca3c8..0000000 --- a/README.md +++ /dev/null @@ -1,101 +0,0 @@ -# ritherdon-archive - -Archive of Ritherdon and Nicola Ellis. - -# Usage - -Run from sources: - - make run - # aka sbcl --load run.lisp - -choose your lisp: - - LISP=ccl make run - -or build and run the binary: - -``` -$ make build -$ ./ritherdon-archive [name] -Hello [name] from ritherdon-archive -``` - -## Init config file - -Create a config file: - - cp config-example.lisp config.lisp - -You can override global variables (for example, the port, which can be -handy if you run the app from sources, without building a binary and -using the `--port` flag. - -The config file is `load`ed before the web server starts (see the `(main)`). - - -## Roswell integration - -Roswell is an implementation manager and [script launcher](https://github.com/roswell/roswell/wiki/Roswell-as-a-Scripting-Environment). - -A POC script is in the roswell/ directory. - -Your users can install the script with `craig/ritherdon-archive`. - -# Dev - -Load the .asd, quickload it then - -``` -CL-USER> (ritherdon-archive/web:start-app) -``` - -See also: - -- `web::load-config &key port load-init-p` - - -## Tests - -Tests are defined with [Fiveam](https://common-lisp.net/project/fiveam/docs/). - -Run them from the terminal with `make test`. You should see a failing test. - -```bash -$ make test -Running test suite TESTMAIN - Running test TEST1 f - Did 1 check. - Pass: 0 ( 0%) - Skip: 0 ( 0%) - Fail: 1 (100%) - - Failure Details: - -------------------------------- - TEST1 in TESTMAIN []: - -3 - - evaluated to - -3 - - which is not - -= - - to - -2 - -Makefile:15: recipe for target 'test' failed - -$ echo $? -2 -``` - -On Slime, load the test package and run `run!`. - ---- - -Licence: BSD diff --git a/README.org b/README.org deleted file mode 100644 index 72a823f..0000000 --- a/README.org +++ /dev/null @@ -1,9 +0,0 @@ -* Ritherdon Archive - - An archive of Ritherdon. I need to speak to Nic more about what this - means. - -* Project Summary - - This is a website written in Common Lisp and the Caveman2 framework. The - databased it uses in SQLite3 and Steel Bank Common Lisp (SBCL). diff --git a/config-example.lisp b/config-example.lisp deleted file mode 100644 index f64f408..0000000 --- a/config-example.lisp +++ /dev/null @@ -1,12 +0,0 @@ - -(in-package :ritherdon-archive) - -(in-package :ritherdon-archive/web) - -;; -;; To use an init configuration file: -;; cp config-example.lisp config.lisp -;; - -;; Override the port: -;; (setf *port* 4545) diff --git a/ritherdon-archive-tests.asd b/ritherdon-archive-tests.asd deleted file mode 100644 index 5c89eb5..0000000 --- a/ritherdon-archive-tests.asd +++ /dev/null @@ -1,18 +0,0 @@ -(in-package :asdf-user) -(defsystem "ritherdon-archive-tests" - :description "Test suite for the ritherdon-archive system" - :author "Craig Oates " - :version "0.0.0" - :depends-on (:ritherdon-archive - :parachute) - :license "MIT" - :serial t - :components ((:module "tests" - :serial t - :components ((:file "packages") - (:file "test-ritherdon-archive")))) - :perform (test-op (op s) (symbol-call :parachute :test :tests)) - - ;; The following would not return the right exit code on error, but still 0. - ;; :perform (test-op (op _) (symbol-call :fiveam :run-all-tests)) - ) diff --git a/roswell/README.md b/roswell/README.md deleted file mode 100644 index 768d434..0000000 --- a/roswell/README.md +++ /dev/null @@ -1,37 +0,0 @@ - -## How to use Roswell to build and share binaries - -From the project root: - -Run as a script: - - chmod +x roswell/ritherdon-archive.ros - ./roswell/ritherdon-archive.ros - -Build a binary: - - ros build roswell/ritherdon-archive.ros - -and run it: - - ./roswell/ritherdon-archive - -Or install it in ~/.roswell/bin: - - ros install roswell/ritherdon-archive.ros - -It creates the binary in ~/.roswell/bin/ -Run it: - - ~/.roswell/bin/ritherdon-archive [name]~& - -Your users can install the script with ros install craig/ritherdon-archive - -Use `+Q` if you don't have Quicklisp dependencies to save startup time. -Use `ros build --disable-compression` to save on startup time and loose on application size. - - -## See - -- https://github.com/roswell/roswell/wiki/ -- https://github.com/roswell/roswell/wiki/Reducing-Startup-Time \ No newline at end of file diff --git a/roswell/ritherdon-archive.ros b/roswell/ritherdon-archive.ros deleted file mode 100644 index 62c8e1e..0000000 --- a/roswell/ritherdon-archive.ros +++ /dev/null @@ -1,28 +0,0 @@ -#!/bin/sh -#|-*- mode:lisp -*-|# -#| -exec ros -Q -- $0 "$@" -|# - -;; use +Q if you don't have Quicklisp dependencies to save startup time. - -(defun help () - (format t "~&Usage: - - ritherdon-archive [name] - -")) - -;; XXX: this load does not load from everywhere -;; it doesn't work for to run as a script. -(load (truename "ritherdon-archive.asd")) -(ql:quickload "ritherdon-archive") - -(defun main (&rest argv) - "Optional name parameter." - (when (member "-h" argv :test #'equal) - ;; To parse command line arguments, use a third-party library such as - ;; unix-opts, defmain, adopt… - (help) - (uiop:quit)) - (ritherdon-archive::greet (first argv))) diff --git a/run-tests.lisp b/run-tests.lisp deleted file mode 100644 index 03d455c..0000000 --- a/run-tests.lisp +++ /dev/null @@ -1,9 +0,0 @@ - -(load "ritherdon-archive.asd") -(load "ritherdon-archive-tests.asd") - -(ql:quickload "ritherdon-archive-tests") - -(in-package :ritherdon-archive-tests) - -(uiop:quit (if (run-all-tests) 0 1)) diff --git a/run.lisp b/run.lisp deleted file mode 100644 index dbfb21d..0000000 --- a/run.lisp +++ /dev/null @@ -1,25 +0,0 @@ -" -Usage: - -rlwrap sbcl --load run.lisp - -This loads the project's asd, loads the quicklisp dependencies, and -calls the main function. - -Then, we are given the lisp prompt. - -If you don't want to land in the REPL, you can (quit) below or call lisp with the --non-interactive flag. - -Another solution to run the app is to build and run a binary (see README). -" - -(load "ritherdon-archive.asd") - -(ql:quickload "ritherdon-archive") - -(in-package :ritherdon-archive) -(handler-case - (main) - (error (c) - (format *error-output* "~&An error occured: ~a~&" c) - (uiop:quit 1))) diff --git a/src/database.lisp b/src/database.lisp deleted file mode 100644 index a90962e..0000000 --- a/src/database.lisp +++ /dev/null @@ -1,30 +0,0 @@ -(in-package :ritherdon-archive/models) -;;; -;;; DB connection, migrations. -;;; - -(defparameter *tables* '(product user) - "List of the DB tables that need to be checked for migrations.") - -(defun connect (&optional (db-name *db-name*)) - "Connect to the DB." - ;; *db* could be mito:*connection* - (log:debug "connecting to ~a~&" *db-name*) - (setf *db* (mito:connect-toplevel :sqlite3 :database-name db-name))) - -(defun ensure-tables-exist () - "Run SQL to create the missing tables." - (unless mito::*connection* - (connect)) - (mapcar #'mito:ensure-table-exists *tables*)) - -(defun migrate-all () - "Migrate the tables after we changed the class definition." - (mapcar #'mito:migrate-table *tables*)) - -;; -;; Entry points -;; -(defun init-db () - "Connect to the DB, run the required migrations and define a couple base user roles." - (ensure-tables-exist)) diff --git a/src/models/models.lisp b/src/models/models.lisp deleted file mode 100644 index e7f720b..0000000 --- a/src/models/models.lisp +++ /dev/null @@ -1,61 +0,0 @@ -(in-package :ritherdon-archive/models) - -(defparameter *db-name* (asdf:system-relative-pathname :ritherdon-archive "ritherdon-archive.db")) - -(defparameter *db* nil - "DB connection object, returned by (connect).") - -;; After modification, run (migrate-all) -;; -;; - to create a date: (local-time:now) -;; " -(defclass product () - ((title - :accessor title - :initarg :title - :initform nil - :type string - :col-type (:varchar 128)) - - (reference - :accessor reference - :initarg :reference - :initform nil - :type (or string null) - :col-type (or (:varchar 128) :null)) - - (price - :accessor price - :initarg :price - ;; we don't the price to 0 (nil denotes a missing field) - :initform nil - :type (or integer null) - :col-type (or :float :null) - :documentation "Store prices as integers. $9.80 => 980") - - (quantity - :accessor quantity - :initform 1 - :type (or integer null) - :col-type (or (:integer) :null) - :documentation "Quantity in stock.")) - - (:metaclass mito:dao-table-class) - (:documentation "A product.")) - -(defun make-product (&key title reference price) - "Create a product instance. - It is not saved in the DB yet." - (make-instance 'product - :title title - :reference reference - :price price)) - -(defun select-products (&key (order :asc)) - (mito:select-dao 'product - (sxql:order-by `(,order :created-at)))) - -(defun find-by (key val) - "Find a product by slot. Example: (find-by :id xxx). Return only the first matching result." - (when val - (mito:find-dao 'product key val))) diff --git a/src/packages.lisp b/src/packages.lisp deleted file mode 100644 index 0c1859d..0000000 --- a/src/packages.lisp +++ /dev/null @@ -1,41 +0,0 @@ -;;; -;;; define helper packages, -;;; the models, -;;; the web, -;;; and the base package that relies on all of them. -;;; - -(defpackage ritherdon-archive/utils - (:use :cl - :log4cl) - (:export #:format-date - #:i18n-load - #:_ - #:parse-iso-date) - (:documentation "Utilities that do not depend on models.")) - -(defpackage ritherdon-archive/models - (:use :cl) - (:export :connect - :make-product - :select-products - :find-by)) - -(defpackage ritherdon-archive/web - (:use :cl) - (:import-from :easy-routes - :defroute) - (:export :start-app - :stop-app) - (:local-nicknames (#:a #:alexandria) - (#:models #:ritherdon-archive/models) - (#:utils #:ritherdon-archive/utils))) - -(defpackage ritherdon-archive - (:use :cl - :log4cl) - (:export :main :run) - (:local-nicknames (#:a #:alexandria) - (#:models #:ritherdon-archive/models) - (#:web #:ritherdon-archive/web) - (#:utils #:ritherdon-archive/utils))) diff --git a/src/ritherdon-archive.lisp b/src/ritherdon-archive.lisp deleted file mode 100644 index cff8488..0000000 --- a/src/ritherdon-archive.lisp +++ /dev/null @@ -1,105 +0,0 @@ -(in-package :ritherdon-archive) - -;; Define your project functionality here... - -(defparameter +version+ "0.0.1") ;; xxx: read from .asd - -(defun print-system-info (&optional (stream t)) - ;; see also https://github.com/40ants/cl-info - (format stream "~&OS: ~a ~a~&" (software-type) (software-version)) - (format stream "~&Lisp: ~a ~a~&" (lisp-implementation-type) (lisp-implementation-version)) - #+asdf - (format stream "~&ASDF: ~a~&" (asdf:asdf-version)) - #-asdf - (format stream "NO ASDF!") - #+quicklisp - (format stream "~&Quicklisp: ~a~&" (ql-dist:all-dists)) - #-quicklisp - (format stream "!! Quicklisp is not installed !!")) - -(defun handle-parser-error (c) - "unix-opts error handler." - (format t "Argument error: ~a~&" (opts:option c))) - -(defun main () - "Parse basic CLI args, start our web app." - - (unless (uiop:file-exists-p models::*db-name*) - (uiop:format! t "Creating the database into ~a...~&" models::*db-name*) - (models::init-db)) - - (opts:define-opts - (:name :help - :description "print this help and exit." - :short #\h - :long "help") - - (:name :version - :description "print the version number and exit." - :short #\v - :long "version") - - (:name :verbose - :description "print debug info." - :short #\V - :long "verbose") - - (:name :port - :arg-parser #'parse-integer - :description "set the port for the web server. You can also use the XYZ_PORT environment variable." - :short #\p - :long "port")) - - (multiple-value-bind (options free-args) - (handler-bind ((error #'handle-parser-error)) - (opts:get-opts)) - - (format t "ritherdon-archive version ~a~&" +version+) - - (when (getf options :version) - (print-system-info) - (uiop:quit)) - - (when (getf options :help) - (opts:describe) - (uiop:quit)) - - (when (getf options :verbose) - (print-system-info)) - - (web::load-config) - - (web:start-app :port (or (getf options :port) - (ignore-errors (parse-integer (uiop:getenv "XYZ_PORT"))) - web::*port*)))) - -(defun run () - "Start our web app calling the MAIN function, and: - - - put the server thread on the foreground, so that Lisp doesn't quit - instantly, and our binary keeps running - - catch a couple errors: port in use, a user's C-c." - (handler-case - (progn - - (main) - - ;; That's only needed for the binary, not when running from sources - ;; (except if you run for Systemd…). - ;; Put the server thread on the foreground. - ;; Without this, the binary exits immediately. - (bt:join-thread - (find-if (lambda (th) - (search "hunchentoot" (bt:thread-name th))) - (bt:all-threads)))) - - ;; Catch some errors. - (usocket:address-in-use-error () - (format *error-output* "This port is already taken.~&")) - #+sbcl - (sb-sys:interactive-interrupt () - (format *error-output* "~&Bye!~&") - (uiop:quit)) - (error (c) - (format *error-output* "~&An error occured: ~a~&" c) - (uiop:quit 1)))) diff --git a/src/static/ritherdon-archive.js b/src/static/ritherdon-archive.js deleted file mode 100644 index 897d2f8..0000000 --- a/src/static/ritherdon-archive.js +++ /dev/null @@ -1,2 +0,0 @@ - -console.log("Hello ritherdon-archive!"); diff --git a/src/templates/base.html b/src/templates/base.html deleted file mode 100644 index fabd146..0000000 --- a/src/templates/base.html +++ /dev/null @@ -1,144 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - {% block title %} ritherdon-archive {% endblock %} - - - - - - - - -
-
-
- -
- -
- {% block content %} {% endblock %} -
- -
-
- - - - - - - diff --git a/src/templates/dashboard.html b/src/templates/dashboard.html deleted file mode 100644 index 7752394..0000000 --- a/src/templates/dashboard.html +++ /dev/null @@ -1,177 +0,0 @@ - - -{% extends "base.html" %} - -{% block content %} - - - - -
-
-
-

- Hello, Admin. -

-

- I hope you are having a great day! -

-
-
-
-
-
-
-
-

{{ data.nb-titles }}

-

Nombre de titres

-
-
-
-
-

{{ data.nb-books }}

-

Nombre de livres

-
-
-
-
-

{{ data.nb-titles-negative }}

-

Titres en stock négatif

-
-
-
-
-

19

-

Exceptions

-
-
-
-
-
-
-
-
-

- Events -

- - - - - -
-
-
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
Lorum ipsum dolem aireAction
-
-
- -
-
-
-
-
-

- Inventory Search -

- - - - - -
-
-
-
- - - - - - - -
-
-
-
-
-
-

- User Search -

- - - - - -
-
-
-
- - - - - - - -
-
-
-
-
-
- -{% endblock %} - - diff --git a/tests/packages.lisp b/tests/packages.lisp deleted file mode 100644 index 67a679e..0000000 --- a/tests/packages.lisp +++ /dev/null @@ -1,8 +0,0 @@ -(in-package :asdf-user) -(defpackage :ritherdon-archive-tests - (:use :common-lisp - :parachute - :ritherdon-archive)) - - -(in-package :ritherdon-archive-tests) diff --git a/tests/test-ritherdon-archive.lisp b/tests/test-ritherdon-archive.lisp deleted file mode 100644 index e249fe7..0000000 --- a/tests/test-ritherdon-archive.lisp +++ /dev/null @@ -1,16 +0,0 @@ -(in-package :ritherdon-archive-tests) - -#| parachute: https://shinmera.github.io/parachute/ -================================================================================ -Use the URL to access the documentation for parachute. -|# - -;; This was an example taken from the doc's for parachute. I'm going to keep it -;; here as a reference until I get comfortable with parachute. -(define-test reference-tests - (of-type integer 5) - (true (numberp 2/3)) - (false (numberp :keyword)) - (is-values (values 0 "1") - (= 0) - (equal "1")))