Browse Source

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.
stable
Craig Oates 2 years ago
parent
commit
51d2213aae
  1. 16
      Makefile
  2. 101
      README.md
  3. 9
      README.org
  4. 12
      config-example.lisp
  5. 18
      ritherdon-archive-tests.asd
  6. 37
      roswell/README.md
  7. 28
      roswell/ritherdon-archive.ros
  8. 9
      run-tests.lisp
  9. 25
      run.lisp
  10. 30
      src/database.lisp
  11. 61
      src/models/models.lisp
  12. 41
      src/packages.lisp
  13. 105
      src/ritherdon-archive.lisp
  14. 2
      src/static/ritherdon-archive.js
  15. 144
      src/templates/base.html
  16. 177
      src/templates/dashboard.html
  17. 8
      tests/packages.lisp
  18. 16
      tests/test-ritherdon-archive.lisp

16
Makefile

@ -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

101
README.md

@ -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

9
README.org

@ -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).

12
config-example.lisp

@ -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)

18
ritherdon-archive-tests.asd

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

37
roswell/README.md

@ -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

28
roswell/ritherdon-archive.ros

@ -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)))

9
run-tests.lisp

@ -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))

25
run.lisp

@ -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)))

30
src/database.lisp

@ -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))

61
src/models/models.lisp

@ -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)))

41
src/packages.lisp

@ -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)))

105
src/ritherdon-archive.lisp

@ -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))))

2
src/static/ritherdon-archive.js

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

144
src/templates/base.html

@ -1,144 +0,0 @@
<!DOCTYPE html>
<html lang="en">
<head>
<meta charset="utf-8">
<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" href="https://cdn.jsdelivr.net/npm/bulma@0.8.0/css/bulma.min.css">
<link rel="stylesheet" type="text/css" href="../css/admin.css">
<script defer src="https://use.fontawesome.com/releases/v5.3.1/js/all.js"></script>
<script defer src="https://cdn.jsdelivr.net/npm/notiflix@2.1.3/dist/AIO/notiflix-aio-2.1.3.min.js"></script>
<!-- Vue.js -->
<script src="https://cdn.jsdelivr.net/npm/vue@2.6/dist/vue.js"></script>
<!-- Icons -->
<link rel="stylesheet" href="https://cdn.materialdesignicons.com/5.3.45/css/materialdesignicons.min.css">
<!-- lodash -->
<script src="https://cdn.jsdelivr.net/npm/lodash@4.17.15/lodash.min.js"></script>
<!-- Buefy (Vue UI components) -->
<link rel="stylesheet" href="https://unpkg.com/buefy/dist/buefy.min.css">
<script src="https://unpkg.com/buefy/dist/buefy.min.js"></script>
<script src="https://cdn.jsdelivr.net/npm/vue-resource@1.5.1"></script>
<!-- HTMX (yet another tool is the toolbet) -->
<script src="https://unpkg.com/htmx.org@1.3.3"></script>
<!-- The app -->
<script defer src="/static/ritherdon-archive.js"></script>
<title>{% block title %} ritherdon-archive {% endblock %}</title>
</head>
<body>
<!-- START NAV -->
<nav class="navbar is-white">
<div class="container">
<div class="navbar-brand">
<a class="navbar-item brand-text" href="/"> ritherdon-archive </a>
<div class="navbar-burger burger" data-target="navMenu">
<span></span>
<span></span>
<span></span>
</div>
</div>
<div id="navMenu" class="navbar-menu">
<div class="navbar-start">
<a class="navbar-item" href="/">
<div class="navbar-item has-dropdown is-hoverable">
<a class="navbar-link">
Database
</a>
</div>
</a>
<div id ="quick-search" class="navbar-item field">
<p class="control has-icons-right">
<b-autocomplete placeholder="ISBN or Keywords..."
v-model="name"
field="title"
:data ="data"
:loading="isFetching"
@typing="getAsyncData"
@select="option => itemSelected(option)"
><template slot-scope="props">{$ {{ props.option.title }} $}</template>
</b-autocomplete>
<span class="icon is-small is-right">
</span>
</p>
</div>
</div>
</div>
<div class="navbar-end" >
<div class="navbar-item" >
{% if current-user %}
<div class="dropdown is-hoverable">
<div class="dropdown-trigger" >
<button class="button" aria-haspopup="true" aria-controls="profile-dropdown" >
<span class="icon is-small" >
<i class="fas fa-user" aria-hidden="true"></i>
</span>
<span>{{ current-user | user-name }}</span>
</button>
</div>
<div class="dropdown-menu" role="menu" id="profile-dropdown">
<div class="dropdown-content" >
<div class="dropdown-item" >
<form action="/logout" method="POST" >
<button class="button is-light">Logout</button>
</form>
</div>
</div>
</div>
</div>
{% else %}
<form action="/login" >
<input name="referer-route" type="hidden" value="{{ request-uri }}"/>
<button class="button is-light" >Login</button>
</form>
{% endif %}
</div>
</div>
</nav>
<!-- END NAV -->
<!-- START MENU -->
<div class="container">
<div class="columns">
<div class="column is-3 ">
<aside class="menu is-hidden-mobile">
<p class="menu-label">
General
</p>
<ul class="menu-list">
<li><a {% if route == "/stock" %} class="is-active" {% endif %} href="/home"> Home </a></li>
</ul>
</aside>
</div>
<div class="column is-9">
{% block content %} {% endblock %}
</div>
</div>
</div>
</body>
<script>
// bulma.js: hamburger toggle for mobile.
(function() {
var burger = document.querySelector('.burger');
var menu = document.querySelector('#'+burger.dataset.target);
burger.addEventListener('click', function() {
burger.classList.toggle('is-active');
menu.classList.toggle('is-active');
});
})();
</script>
</html>

177
src/templates/dashboard.html

@ -1,177 +0,0 @@
{% 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 %}

8
tests/packages.lisp

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

16
tests/test-ritherdon-archive.lisp

@ -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")))
Loading…
Cancel
Save