make back-up copy of cookie cutter code, for reference.

There was snippets of code in the code I liked. I'm going to keep it
around for a bit to see if I can work some of it in to the new
code. I'm most interested in the deployment code.

hunchentoot-example/Makefile

@@ -0,0 +1,16 @@
+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

hunchentoot-example/README.md

@@ -0,0 +1,101 @@
+# 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

hunchentoot-example/README.org

@@ -0,0 +1,9 @@
+* 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).

hunchentoot-example/config-example.lisp

@@ -0,0 +1,12 @@
+
+(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)

hunchentoot-example/ritherdon-archive-tests.asd

@@ -0,0 +1,18 @@
+(in-package :asdf-user)
+(defsystem "ritherdon-archive-tests"
+  :description "Test suite for the ritherdon-archive system"
+  :author "Craig Oates <craig@craigoates.net>"
+  :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))
+  )

hunchentoot-example/ritherdon-archive.asd

@@ -0,0 +1,89 @@
+(in-package :asdf-user)
+
+(defsystem "ritherdon-archive"
+  :author "Craig Oates <craig@craigoates.net>"
+  :version "0.0.0"
+  :license "MIT"
+  :description "Archive of Ritherdon and Nicola Ellis."
+  :homepage ""
+  :bug-tracker ""
+  :source-control (:git "")
+
+  ;; Dependencies.
+  :depends-on (
+               ;; HTTP client
+               :dexador
+
+               ;; templates
+               :djula
+
+               ;; server, routing
+               :hunchentoot
+               :easy-routes
+
+               ;; JSON
+               :cl-json
+
+               ;; DB
+               :mito
+               :mito-auth
+
+               ;; utilities
+               :access
+               :cl-ppcre
+               :cl-slug
+               :local-time
+               :local-time-duration
+               :log4cl
+               :str
+
+               ;; scripting
+               :unix-opts
+
+               ;; deployment
+               :deploy
+
+               ;; development utilities
+               )
+
+  ;; Build a binary.
+  ;; :build-operation "program-op"  ;; usual op to build a binary.
+  ;; Deploy:
+  :defsystem-depends-on (:deploy)
+  :build-operation "deploy-op"
+  :build-pathname "ritherdon-archive"
+  :entry-point "ritherdon-archive:run"
+
+  ;; Project stucture.
+  :serial t
+  :components ((:module "src"
+                        :components
+                        ;; stand-alone packages.
+                        ((:file "packages")
+                         (:file "utils")
+                         ;; they depend on the above.
+                         ;; (:file "authentication")
+                         (:file "web")
+                         (:file "ritherdon-archive")
+                         (:file "database")))
+
+               (:module "src/models"
+                        :components
+                        ((:file "models")
+			 (:file "user")))
+
+               (:static-file "README.md")))
+
+;; Deploy may not find libcrypto on your system.
+;; But anyways, we won't ship it to rely instead
+;; on its presence on the target OS.
+(require :cl+ssl)  ; sometimes necessary.
+#+linux (deploy:define-library cl+ssl::libssl :dont-deploy T)
+#+linux (deploy:define-library cl+ssl::libcrypto :dont-deploy T)
+
+;; ASDF wants to update itself and fails.
+;; Yeah, it does that even when running the binary on my VPS O_o
+;; Please, don't.
+(deploy:define-hook (:deploy asdf) (directory)
+  #+asdf (asdf:clear-source-registry)
+  #+asdf (defun asdf:upgrade-asdf () NIL))

hunchentoot-example/roswell/README.md

@@ -0,0 +1,37 @@
+
+## 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

hunchentoot-example/roswell/ritherdon-archive.ros

@@ -0,0 +1,28 @@
+#!/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)))

hunchentoot-example/run-tests.lisp

@@ -0,0 +1,9 @@
+
+(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))

hunchentoot-example/run.lisp

@@ -0,0 +1,25 @@
+"
+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)))

hunchentoot-example/scripts/create-user.sh

@@ -0,0 +1,39 @@
+#!/bin/bash
+
+# Create account so user can log-in to the website. Assumes you're using
+# SQLilte3 as the database.
+
+# Moves to the location of the script (regardless of where the script
+# was called from).
+cd "$(dirname "$0")"
+DATABASE="ritherdon-archive.db"
+
+read -p "Username: " USERNAME
+read -p "Display Name: " DISPLAY_NAME
+read -sp "Password: " USER_PASSWORD
+echo
+read -sp "Confirm Password: " PASSWORD_TEST
+echo
+
+if [[ $USERNAME == "" ]]
+    || [[ $DISPLAY_NAME == "" ]]
+    || [[ $USER_PASSWORD == "" ]]; then
+    echo "[ERROR] Empty string used."
+else
+    if [[ $USER_PASSWORD == $PASSWORD_TEST ]]; then
+	echo "[SUCCESS] Password verified."
+	if [ -e "../$DATABASE" ]; then
+	    echo "[INFO] Database found. Adding user to it..."
+	    SQL="INSERT INTO user (username,display_name,password,created_at,updated_at) \
+             VALUES (\"$USERNAME\",\"$DISPLAY_NAME\",\"$USER_PASSWORD\",(datetime(\"now\")),NULL);"
+	    cd ../
+	    sqlite3 $DATABASE "$SQL"
+	    
+	else
+	    echo "[ERROR] Cannot find database. Make sure you've ran make build."
+	    exit
+	fi
+    else
+	echo "[ERROR] Passwords do not match."
+    fi
+fi

hunchentoot-example/src/database.lisp

@@ -0,0 +1,30 @@
+(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))

hunchentoot-example/src/models/models.lisp

@@ -0,0 +1,61 @@
+(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)))

hunchentoot-example/src/models/user.lisp

@@ -0,0 +1,26 @@
+(in-package :ritherdon-archive/models)
+
+(defclass user ()
+  ((username
+    :accessor username
+    :initarg :username
+    :initform nil
+    :type (or string null)
+    :col-type :text)
+  
+  (display-name
+    :accessor display-name
+    :initarg :display-name
+    :initform nil
+    :type (or string null)
+    :col-type :text)
+
+  (password
+    :accessor password
+    :initarg :password
+    :initform nil
+    :type (or string null)
+    :col-type :text))
+
+  (:metaclass mito:dao-table-class)  
+  (:documentation "Account information for users to log-in to the website.."))

hunchentoot-example/src/packages.lisp

@@ -0,0 +1,41 @@
+;;;
+;;; 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)))

hunchentoot-example/src/ritherdon-archive.lisp

@@ -0,0 +1,105 @@
+(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))))

hunchentoot-example/src/static/css/main.css

@@ -0,0 +1 @@
+ 

hunchentoot-example/src/static/js/ritherdon-archive.js

@@ -0,0 +1,2 @@
+
+console.log("Hello ritherdon-archive!");

hunchentoot-example/src/templates/404.html

@@ -0,0 +1 @@
+<h1>404: Web Page Not Found</h1>

hunchentoot-example/src/templates/about.html

@@ -0,0 +1,5 @@
+{% extends "base.html" %}
+
+{% block content %}
+<h1>About</h1>
+{% end block %}

hunchentoot-example/src/templates/archive.html

@@ -0,0 +1,6 @@
+{% extends "base.html" %}
+
+{% block content %}
+<h1>Archive</h1>
+
+{% end block %}

hunchentoot-example/src/templates/base.html

@@ -0,0 +1,15 @@
+<!DOCTYPE html>
+<html lang="en">
+    <head>
+	<meta charset="utf-8">
+	<title>{% block title %}{% endblock %}</title>
+	<meta name="viewport" content="width=device-width, initial-scale=1">
+	<meta http-equiv="X-UA-Compatible" content="IE=edge">
+	<meta name="viewport" content="width=device-width, initial-scale=1">
+	<link rel="stylesheet" type="text/css" href="/static/css/main.css">
+	<script defer src="/static/js/ritherdon-archive.js"></script>
+    </head>
+    <body>
+	{% block content %} {% endblock %}
+    </body>
+</html>

hunchentoot-example/src/templates/dashboard.html

@@ -0,0 +1,175 @@
+{% extends "base.html" %}
+
+{% block content %}
+
+<!-- this comes straight from a Bulma demo. -->
+
+
+<section class="hero is-info welcome is-small">
+  <div class="hero-body">
+    <div class="container">
+      <h1 class="title">
+        Hello, Admin.
+      </h1>
+      <h2 class="subtitle">
+        I hope you are having a great day!
+      </h2>
+    </div>
+  </div>
+</section>
+<section class="info-tiles">
+  <div class="tile is-ancestor has-text-centered">
+    <div class="tile is-parent">
+      <article class="tile is-child box">
+        <p class="title"> {{ data.nb-titles }} </p>
+        <p class="subtitle"> Nombre de titres </p>
+      </article>
+    </div>
+    <div class="tile is-parent">
+      <article class="tile is-child box">
+        <p class="title"> {{ data.nb-books }} </p>
+        <p class="subtitle"> Nombre de livres </p>
+      </article>
+    </div>
+    <div class="tile is-parent">
+      <article class="tile is-child box">
+        <p class="title"> {{ data.nb-titles-negative }} </p>
+        <p class="subtitle"> Titres en stock négatif </p>
+      </article>
+    </div>
+    <div class="tile is-parent">
+      <article class="tile is-child box">
+        <p class="title">19</p>
+        <p class="subtitle">Exceptions</p>
+      </article>
+    </div>
+  </div>
+</section>
+<div class="columns">
+  <div class="column is-6">
+    <div class="card events-card">
+      <header class="card-header">
+        <p class="card-header-title">
+          Events
+        </p>
+        <a href="#" class="card-header-icon" aria-label="more options">
+          <span class="icon">
+            <i class="fa fa-angle-down" aria-hidden="true"></i>
+          </span>
+        </a>
+      </header>
+      <div class="card-table">
+        <div class="content">
+          <table class="table is-fullwidth is-striped">
+            <tbody>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+              <tr>
+                <td width="5%"><i class="fa fa-bell-o"></i></td>
+                <td>Lorum ipsum dolem aire</td>
+                <td class="level-right"><a class="button is-small is-primary" href="#">Action</a></td>
+              </tr>
+            </tbody>
+          </table>
+        </div>
+      </div>
+      <footer class="card-footer">
+        <a href="#" class="card-footer-item">View All</a>
+      </footer>
+    </div>
+  </div>
+  <div class="column is-6">
+    <div class="card">
+      <header class="card-header">
+        <p class="card-header-title">
+          Inventory Search
+        </p>
+        <a href="#" class="card-header-icon" aria-label="more options">
+          <span class="icon">
+            <i class="fa fa-angle-down" aria-hidden="true"></i>
+          </span>
+        </a>
+      </header>
+      <div class="card-content">
+        <div class="content">
+          <div class="control has-icons-left has-icons-right">
+            <input class="input is-large" type="text" placeholder="">
+            <span class="icon is-medium is-left">
+              <i class="fa fa-search"></i>
+            </span>
+            <span class="icon is-medium is-right">
+              <i class="fa fa-check"></i>
+            </span>
+          </div>
+        </div>
+      </div>
+    </div>
+    <div class="card">
+      <header class="card-header">
+        <p class="card-header-title">
+          User Search
+        </p>
+        <a href="#" class="card-header-icon" aria-label="more options">
+          <span class="icon">
+            <i class="fa fa-angle-down" aria-hidden="true"></i>
+          </span>
+        </a>
+      </header>
+      <div class="card-content">
+        <div class="content">
+          <div class="control has-icons-left has-icons-right">
+            <input class="input is-large" type="text" placeholder="">
+            <span class="icon is-medium is-left">
+              <i class="fa fa-search"></i>
+            </span>
+            <span class="icon is-medium is-right">
+              <i class="fa fa-check"></i>
+            </span>
+          </div>
+        </div>
+      </div>
+    </div>
+  </div>
+</div>
+
+{% endblock %}
+
+

hunchentoot-example/src/templates/home.html

@@ -0,0 +1,6 @@
+{% extends "base.html" %}
+
+{% block content %}
+<h1>Index</h1>
+
+{% end block %}

hunchentoot-example/src/templates/login.html

@@ -0,0 +1,16 @@
+{% extends "base.html" %}
+{% block title %}Nicola Ellis & Ritherdon Archive: Log-In{% endblock %}
+{% block content %}
+<h2>Login</h2>
+<div>
+<formaction="/login" method="post">
+  <input type="hidden" name="AUTHENTICITY-TOKEN" value="{{token}}">
+  <input type="hidden" name="METHOD" value="login">
+    <label>Username</label>
+    <input required type="text" name="USERNAME">
+    <label>password</label>
+    <input required type="password" name="PASSWORD">
+    <input type="submit" value="Log-in">
+</form>
+</div>
+{% endblock %}

hunchentoot-example/src/utils.lisp

@@ -0,0 +1,9 @@
+(in-package :ritherdon-archive/utils)
+
+
+(defun format-date (date)
+  "Format the given date with the default date format (yyyy-mm-dd). Return a string."
+  (local-time:format-timestring nil date :format +date-y-m-d+))
+
+(defun asciify (string)
+  (str:downcase (slug:asciify string)))

hunchentoot-example/src/web.lisp

@@ -0,0 +1,135 @@
+(in-package :ritherdon-archive/web)
+
+(defvar *server* nil
+  "Current instance of easy-acceptor.")
+
+(defparameter *port* 4242)
+
+;;;
+;;; Djula filters.
+;;;
+
+(djula:def-filter :price (val)
+  (format nil "~,2F" val))
+
+;;;
+;;; Load templates.
+;;;
+(djula:add-template-directory
+ (asdf:system-relative-pathname "ritherdon-archive" "src/templates/"))
+
+(defparameter +base.html+ (djula:compile-template* "base.html"))
+(defparameter +404.html+ (djula:compile-template* "404.html"))
+
+;; Front-End Templates
+(defparameter +index.html+ (djula:compile-template* "home.html"))
+(defparameter +archive.html+ (djula:compile-template* "archive.html"))
+(defparameter +about.html+ (djula:compile-template* "about.html"))
+(defparameter +login.html+ (djula:compile-template* "login.html"))
+
+;; Back-End Templates
+(defparameter +dashboard.html+ (djula:compile-template* "dashboard.html"))
+
+;;;
+;;; Serve static assets
+;;;
+(defparameter *default-static-directory* "src/static/"
+  "The directory where to serve static assets from (STRING). If it starts with a slash, it is an absolute directory. Otherwise, it will be a subdirectory of where the system :abstock is installed.
+  Static assets are reachable under the /static/ prefix.")
+
+(defun serve-static-assets ()
+  (push (hunchentoot:create-folder-dispatcher-and-handler
+         "/static/" (merge-pathnames *default-static-directory*
+                                     (asdf:system-source-directory :ritherdon-archive)))
+        hunchentoot:*dispatch-table*))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Routes.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Root route.
+(defroute home-route ("/") ()
+  (djula:render-template* +dashboard.html+ nil
+                          :route "/"))
+
+(defroute login ("/login") ()
+    (djula:render-template* +login.html+ nil))
+
+(defroute card-page ("/product/:slug")
+    (&get raw)
+  "Show a product.
+
+  Dev helper: if the URL parameter RAW is \"t\" (the string), then display the card object literally (with describe)."
+  ;; The product URL is of the form: /xyz-product-title where xyz is its pk.
+  (let* ((product-id (ignore-errors
+                       (parse-integer (first (str:split "-" slug)))))
+         (product (when product-id
+                 (models:find-by :id product-id))))
+    (cond
+      ((null product-id)
+       (render-template* +404.html+ nil))
+      (product
+       (render-template* +product-stock.html+ nil
+                         :messages nil
+                         :route "/product"
+                         :product product
+                         :raw raw))
+      (t
+       (render-template* +404.html+ nil)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Start-up functions.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun find-config ()
+  (cond
+    ((uiop:file-exists-p "config.lisp")
+     "config.lisp")
+    (t
+     nil)))
+
+(defun load-config ()
+  "Load `config.lisp', situated at the project's root."
+  (let ((file (find-config)))
+    (if file
+        ;; One case of failure: a symbolic link exists, but
+        ;; the target file doesn't.
+        (progn
+          (uiop:format! t "Loading config file ~a…~&" file)
+          (load (uiop:native-namestring file)))
+        (format t "... no config file found.~&"))))
+
+(defun start-app (&key (port *port*) (load-config-p nil))
+  "Start the Hunchentoot web server on port PORT (defaults to `*PORT*'), serve static assets.
+
+  If LOAD-CONFIG-P is non nil, load the config file (this is normally done in the main function of run.lisp before)."
+  ;; You can use the find-port library to find an available port.
+
+  ;; Load the config.lisp init file.
+  (if load-config-p
+      (load-config)
+      (uiop:format! t "Skipping config file.~&"))
+
+  ;; Set up the DB.
+  (models:connect)
+
+  ;; Start the server.
+  (uiop:format! t "Starting Hunchentoot on port ~a…~&" port)
+  (setf *server* (make-instance 'easy-routes:easy-routes-acceptor :port port))
+  (hunchentoot:start *server*)
+  (serve-static-assets)
+  (uiop:format! t "~&Application started on port ~a.~&" port))
+
+(defun stop-app ()
+  ;; disconnect db ?
+  (hunchentoot:stop *server*))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Authentication functions.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun current-user ()
+  (hunchentoot:session-value :user))
+
+(defun logout ()
+  (setf (hunchentoot:session-value :user) nil))

hunchentoot-example/tests/packages.lisp

@@ -0,0 +1,8 @@
+(in-package :asdf-user)
+(defpackage :ritherdon-archive-tests
+  (:use :common-lisp
+        :parachute
+        :ritherdon-archive))
+
+
+(in-package :ritherdon-archive-tests)

hunchentoot-example/tests/test-ritherdon-archive.lisp

@@ -0,0 +1,16 @@
+(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")))