From 97c4939dcb65cfa56c20c89f747898d8e4c047db Mon Sep 17 00:00:00 2001 From: Craig Oates Date: Mon, 5 Sep 2022 02:22:56 +0100 Subject: [PATCH] create Caveman2 project. --- .gitignore | 23 ++++----------- README.md | 3 -- README.org | 9 ++++++ app.lisp | 39 ++++++++++++++++++++++++++ db/schema.sql | 0 ritherdon-archive-test.asd | 11 ++++++++ ritherdon-archive.asd | 29 +++++++++++++++++++ src/config.lisp | 44 +++++++++++++++++++++++++++++ src/db.lisp | 23 +++++++++++++++ src/main.lisp | 30 ++++++++++++++++++++ src/view.lisp | 51 ++++++++++++++++++++++++++++++++++ src/web.lisp | 35 +++++++++++++++++++++++ static/css/main.css | 21 ++++++++++++++ templates/_errors/404.html | 47 +++++++++++++++++++++++++++++++ templates/index.html | 7 +++++ templates/layouts/default.html | 11 ++++++++ tests/ritherdon-archive.lisp | 12 ++++++++ 17 files changed, 375 insertions(+), 20 deletions(-) delete mode 100644 README.md create mode 100644 README.org create mode 100644 app.lisp create mode 100644 db/schema.sql create mode 100644 ritherdon-archive-test.asd create mode 100644 ritherdon-archive.asd create mode 100644 src/config.lisp create mode 100644 src/db.lisp create mode 100644 src/main.lisp create mode 100644 src/view.lisp create mode 100644 src/web.lisp create mode 100644 static/css/main.css create mode 100644 templates/_errors/404.html create mode 100644 templates/index.html create mode 100644 templates/layouts/default.html create mode 100644 tests/ritherdon-archive.lisp diff --git a/.gitignore b/.gitignore index bf4db1e..7d8d59e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,19 +1,8 @@ -# ---> CommonLisp -*.FASL *.fasl -*.lisp-temp -*.dfsl -*.pfsl -*.d64fsl -*.p64fsl -*.lx64fsl -*.lx32fsl -*.dx64fsl *.dx32fsl -*.fx64fsl -*.fx32fsl -*.sx64fsl -*.sx32fsl -*.wx64fsl -*.wx32fsl - +*.dx64fsl +*.lx32fsl +*.lx64fsl +*.x86f +*~ +.#* \ No newline at end of file diff --git a/README.md b/README.md deleted file mode 100644 index 7f9df42..0000000 --- a/README.md +++ /dev/null @@ -1,3 +0,0 @@ -# ritherdon-archive - -Archive of Ritherdon. \ No newline at end of file diff --git a/README.org b/README.org new file mode 100644 index 0000000..72a823f --- /dev/null +++ b/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). diff --git a/app.lisp b/app.lisp new file mode 100644 index 0000000..52983ed --- /dev/null +++ b/app.lisp @@ -0,0 +1,39 @@ +(ql:quickload :ritherdon-archive) + +(defpackage ritherdon-archive.app + (:use :cl) + (:import-from :lack.builder + :builder) + (:import-from :ppcre + :scan + :regex-replace) + (:import-from :ritherdon-archive.web + :*web*) + (:import-from :ritherdon-archive.config + :config + :productionp + :*static-directory*)) +(in-package :ritherdon-archive.app) + +(builder + (:static + :path (lambda (path) + (if (ppcre:scan "^(?:/images/|/css/|/js/|/robot\\.txt$|/favicon\\.ico$)" path) + path + nil)) + :root *static-directory*) + (if (productionp) + nil + :accesslog) + (if (getf (config) :error-log) + `(:backtrace + :output ,(getf (config) :error-log)) + nil) + :session + (if (productionp) + nil + (lambda (app) + (lambda (env) + (let ((datafly:*trace-sql* t)) + (funcall app env))))) + *web*) diff --git a/db/schema.sql b/db/schema.sql new file mode 100644 index 0000000..e69de29 diff --git a/ritherdon-archive-test.asd b/ritherdon-archive-test.asd new file mode 100644 index 0000000..0d9a068 --- /dev/null +++ b/ritherdon-archive-test.asd @@ -0,0 +1,11 @@ +(defsystem "ritherdon-archive-test" + :defsystem-depends-on ("prove-asdf") + :author "Craig Oates" + :license "MIT" + :depends-on ("ritherdon-archive" + "prove") + :components ((:module "tests" + :components + ((:test-file "ritherdon-archive")))) + :description "Test system for ritherdon-archive" + :perform (test-op (op c) (symbol-call :prove-asdf :run-test-system c))) diff --git a/ritherdon-archive.asd b/ritherdon-archive.asd new file mode 100644 index 0000000..a874489 --- /dev/null +++ b/ritherdon-archive.asd @@ -0,0 +1,29 @@ +(defsystem "ritherdon-archive" + :version "0.1.0" + :author "Craig Oates" + :license "MIT" + :depends-on ("clack" + "lack" + "caveman2" + "envy" + "cl-ppcre" + "uiop" + + ;; for @route annotation + "cl-syntax-annot" + + ;; HTML Template + "djula" + + ;; for DB + "datafly" + "sxql") + :components ((:module "src" + :components + ((:file "main" :depends-on ("config" "view" "db")) + (:file "web" :depends-on ("view")) + (:file "view" :depends-on ("config")) + (:file "db" :depends-on ("config")) + (:file "config")))) + :description "A website to host Ritherdon's Archive." + :in-order-to ((test-op (test-op "ritherdon-archive-test")))) diff --git a/src/config.lisp b/src/config.lisp new file mode 100644 index 0000000..552f223 --- /dev/null +++ b/src/config.lisp @@ -0,0 +1,44 @@ +(in-package :cl-user) +(defpackage ritherdon-archive.config + (:use :cl) + (:import-from :envy + :config-env-var + :defconfig) + (:export :config + :*application-root* + :*static-directory* + :*template-directory* + :appenv + :developmentp + :productionp)) +(in-package :ritherdon-archive.config) + +(setf (config-env-var) "APP_ENV") + +(defparameter *application-root* (asdf:system-source-directory :ritherdon-archive)) +(defparameter *static-directory* (merge-pathnames #P"static/" *application-root*)) +(defparameter *template-directory* (merge-pathnames #P"templates/" *application-root*)) + +(defconfig :common + `(:databases ((:maindb :sqlite3 :database-name ":memory:")))) + +(defconfig |development| + '()) + +(defconfig |production| + '()) + +(defconfig |test| + '()) + +(defun config (&optional key) + (envy:config #.(package-name *package*) key)) + +(defun appenv () + (uiop:getenv (config-env-var #.(package-name *package*)))) + +(defun developmentp () + (string= (appenv) "development")) + +(defun productionp () + (string= (appenv) "production")) diff --git a/src/db.lisp b/src/db.lisp new file mode 100644 index 0000000..6fcb587 --- /dev/null +++ b/src/db.lisp @@ -0,0 +1,23 @@ +(in-package :cl-user) +(defpackage ritherdon-archive.db + (:use :cl) + (:import-from :ritherdon-archive.config + :config) + (:import-from :datafly + :*connection*) + (:import-from :cl-dbi + :connect-cached) + (:export :connection-settings + :db + :with-connection)) +(in-package :ritherdon-archive.db) + +(defun connection-settings (&optional (db :maindb)) + (cdr (assoc db (config :databases)))) + +(defun db (&optional (db :maindb)) + (apply #'connect-cached (connection-settings db))) + +(defmacro with-connection (conn &body body) + `(let ((*connection* ,conn)) + ,@body)) diff --git a/src/main.lisp b/src/main.lisp new file mode 100644 index 0000000..a921a9f --- /dev/null +++ b/src/main.lisp @@ -0,0 +1,30 @@ +(in-package :cl-user) +(defpackage ritherdon-archive + (:use :cl) + (:import-from :ritherdon-archive.config + :config) + (:import-from :clack + :clackup) + (:export :start + :stop)) +(in-package :ritherdon-archive) + +(defvar *appfile-path* + (asdf:system-relative-pathname :ritherdon-archive #P"app.lisp")) + +(defvar *handler* nil) + +(defun start (&rest args &key server port debug &allow-other-keys) + (declare (ignore server port debug)) + (when *handler* + (restart-case (error "Server is already running.") + (restart-server () + :report "Restart the server" + (stop)))) + (setf *handler* + (apply #'clackup *appfile-path* args))) + +(defun stop () + (prog1 + (clack:stop *handler*) + (setf *handler* nil))) diff --git a/src/view.lisp b/src/view.lisp new file mode 100644 index 0000000..b6b8037 --- /dev/null +++ b/src/view.lisp @@ -0,0 +1,51 @@ +(in-package :cl-user) +(defpackage ritherdon-archive.view + (:use :cl) + (:import-from :ritherdon-archive.config + :*template-directory*) + (:import-from :caveman2 + :*response* + :response-headers) + (:import-from :djula + :add-template-directory + :compile-template* + :render-template* + :*djula-execute-package*) + (:import-from :datafly + :encode-json) + (:export :render + :render-json)) +(in-package :ritherdon-archive.view) + +(djula:add-template-directory *template-directory*) + +(defparameter *template-registry* (make-hash-table :test 'equal)) + +(defun render (template-path &optional env) + (let ((template (gethash template-path *template-registry*))) + (unless template + (setf template (djula:compile-template* (princ-to-string template-path))) + (setf (gethash template-path *template-registry*) template)) + (apply #'djula:render-template* + template nil + env))) + +(defun render-json (object) + (setf (getf (response-headers *response*) :content-type) "application/json") + (encode-json object)) + + +;; +;; Execute package definition + +(defpackage ritherdon-archive.djula + (:use :cl) + (:import-from :ritherdon-archive.config + :config + :appenv + :developmentp + :productionp) + (:import-from :caveman2 + :url-for)) + +(setf djula:*djula-execute-package* (find-package :ritherdon-archive.djula)) diff --git a/src/web.lisp b/src/web.lisp new file mode 100644 index 0000000..1cc7130 --- /dev/null +++ b/src/web.lisp @@ -0,0 +1,35 @@ +(in-package :cl-user) +(defpackage ritherdon-archive.web + (:use :cl + :caveman2 + :ritherdon-archive.config + :ritherdon-archive.view + :ritherdon-archive.db + :datafly + :sxql) + (:export :*web*)) +(in-package :ritherdon-archive.web) + +;; for @route annotation +(syntax:use-syntax :annot) + +;; +;; Application + +(defclass () ()) +(defvar *web* (make-instance ')) +(clear-routing-rules *web*) + +;; +;; Routing rules + +(defroute "/" () + (render #P"index.html")) + +;; +;; Error pages + +(defmethod on-exception ((app ) (code (eql 404))) + (declare (ignore app)) + (merge-pathnames #P"_errors/404.html" + *template-directory*)) diff --git a/static/css/main.css b/static/css/main.css new file mode 100644 index 0000000..2e05864 --- /dev/null +++ b/static/css/main.css @@ -0,0 +1,21 @@ +@charset "UTF-8"; + +body { + font-family: 'Myriad Pro', Calibri, Helvetica, Arial, sans-serif; +} + +a:link { + color: #005585; + text-decoration: none; +} +a:visited { + color: #485270; +} +a:hover { + color: #b83800; + text-decoration: underline; +} + +#main { + text-align: center; +} diff --git a/templates/_errors/404.html b/templates/_errors/404.html new file mode 100644 index 0000000..5d0d4ae --- /dev/null +++ b/templates/_errors/404.html @@ -0,0 +1,47 @@ + + + + + 404 NOT FOUND + + + +
+
+
404
+
NOT FOUND
+
+
+ + diff --git a/templates/index.html b/templates/index.html new file mode 100644 index 0000000..6a3c687 --- /dev/null +++ b/templates/index.html @@ -0,0 +1,7 @@ +{% extends "layouts/default.html" %} +{% block title %}Welcome to Caveman2{% endblock %} +{% block content %} +
+ Welcome to Caveman2! +
+{% endblock %} diff --git a/templates/layouts/default.html b/templates/layouts/default.html new file mode 100644 index 0000000..6dba578 --- /dev/null +++ b/templates/layouts/default.html @@ -0,0 +1,11 @@ + + + + + {% block title %}{% endblock %} + + + + {% block content %}{% endblock %} + + diff --git a/tests/ritherdon-archive.lisp b/tests/ritherdon-archive.lisp new file mode 100644 index 0000000..c3504a8 --- /dev/null +++ b/tests/ritherdon-archive.lisp @@ -0,0 +1,12 @@ +(in-package :cl-user) +(defpackage ritherdon-archive-test + (:use :cl + :ritherdon-archive + :prove)) +(in-package :ritherdon-archive-test) + +(plan nil) + +;; blah blah blah. + +(finalize)