Craig Oates
2 years ago
17 changed files with 375 additions and 20 deletions
@ -1,19 +1,8 @@ |
|||||||
# ---> CommonLisp |
|
||||||
*.FASL |
|
||||||
*.fasl |
*.fasl |
||||||
*.lisp-temp |
|
||||||
*.dfsl |
|
||||||
*.pfsl |
|
||||||
*.d64fsl |
|
||||||
*.p64fsl |
|
||||||
*.lx64fsl |
|
||||||
*.lx32fsl |
|
||||||
*.dx64fsl |
|
||||||
*.dx32fsl |
*.dx32fsl |
||||||
*.fx64fsl |
*.dx64fsl |
||||||
*.fx32fsl |
*.lx32fsl |
||||||
*.sx64fsl |
*.lx64fsl |
||||||
*.sx32fsl |
*.x86f |
||||||
*.wx64fsl |
*~ |
||||||
*.wx32fsl |
.#* |
||||||
|
|
@ -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). |
@ -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*) |
@ -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))) |
@ -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")))) |
@ -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")) |
@ -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)) |
@ -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))) |
@ -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)) |
@ -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 <web> (<app>) ()) |
||||||
|
(defvar *web* (make-instance '<web>)) |
||||||
|
(clear-routing-rules *web*) |
||||||
|
|
||||||
|
;; |
||||||
|
;; Routing rules |
||||||
|
|
||||||
|
(defroute "/" () |
||||||
|
(render #P"index.html")) |
||||||
|
|
||||||
|
;; |
||||||
|
;; Error pages |
||||||
|
|
||||||
|
(defmethod on-exception ((app <web>) (code (eql 404))) |
||||||
|
(declare (ignore app)) |
||||||
|
(merge-pathnames #P"_errors/404.html" |
||||||
|
*template-directory*)) |
@ -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; |
||||||
|
} |
@ -0,0 +1,47 @@ |
|||||||
|
<!DOCTYPE html> |
||||||
|
<html> |
||||||
|
<head> |
||||||
|
<meta charset="utf-8"> |
||||||
|
<title>404 NOT FOUND</title> |
||||||
|
<style type="text/css"> |
||||||
|
html { |
||||||
|
height: 100%; |
||||||
|
} |
||||||
|
|
||||||
|
body { |
||||||
|
height: 100%; |
||||||
|
font-family: 'Myriad Pro', Calibri, Helvetica, Arial, sans-serif; |
||||||
|
background-color: #DFDFDF; |
||||||
|
} |
||||||
|
|
||||||
|
#main { |
||||||
|
display: table; |
||||||
|
width: 100%; |
||||||
|
height: 100%; |
||||||
|
} |
||||||
|
|
||||||
|
.error { |
||||||
|
display: table-cell; |
||||||
|
text-align: center; |
||||||
|
vertical-align: middle; |
||||||
|
} |
||||||
|
|
||||||
|
.error .code { |
||||||
|
font-size: 1600%; |
||||||
|
font-weight: bold; |
||||||
|
} |
||||||
|
|
||||||
|
.error .message { |
||||||
|
font-size: 400%; |
||||||
|
} |
||||||
|
</style> |
||||||
|
</head> |
||||||
|
<body> |
||||||
|
<div id="main"> |
||||||
|
<div class="error"> |
||||||
|
<div class="code">404</div> |
||||||
|
<div class="message">NOT FOUND</div> |
||||||
|
</div> |
||||||
|
</div> |
||||||
|
</body> |
||||||
|
</html> |
@ -0,0 +1,7 @@ |
|||||||
|
{% extends "layouts/default.html" %} |
||||||
|
{% block title %}Welcome to Caveman2{% endblock %} |
||||||
|
{% block content %} |
||||||
|
<div id="main"> |
||||||
|
Welcome to <a href="http://8arrow.org/caveman/">Caveman2</a>! |
||||||
|
</div> |
||||||
|
{% endblock %} |
@ -0,0 +1,11 @@ |
|||||||
|
<!DOCTYPE html> |
||||||
|
<html> |
||||||
|
<head> |
||||||
|
<meta charset="utf-8"> |
||||||
|
<title>{% block title %}{% endblock %}</title> |
||||||
|
<link rel="stylesheet" type="text/css" media="screen" href="/css/main.css"> |
||||||
|
</head> |
||||||
|
<body> |
||||||
|
{% block content %}{% endblock %} |
||||||
|
</body> |
||||||
|
</html> |
Loading…
Reference in new issue