Browse Source
I'm going to try this with Python and Django first. Because it's not my personal project, it might be better to use a language which is more mainstream. It should reduce the 'Bus Factor'.stable
Craig Oates
2 years ago
14 changed files with 0 additions and 360 deletions
@ -1,39 +0,0 @@
|
||||
(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*) |
@ -1,11 +0,0 @@
|
||||
(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))) |
@ -1,29 +0,0 @@
|
||||
(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")))) |
@ -1,44 +0,0 @@
|
||||
(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")) |
@ -1,23 +0,0 @@
|
||||
(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)) |
@ -1,30 +0,0 @@
|
||||
(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))) |
@ -1,51 +0,0 @@
|
||||
(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)) |
@ -1,35 +0,0 @@
|
||||
(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*)) |
@ -1,21 +0,0 @@
|
||||
@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; |
||||
} |
@ -1,47 +0,0 @@
|
||||
<!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> |
@ -1,7 +0,0 @@
|
||||
{% 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 %} |
@ -1,11 +0,0 @@
|
||||
<!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