Browse Source

delete caveman2 (initial install) code.

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
parent
commit
24b396d47b
  1. 39
      app.lisp
  2. 0
      db/schema.sql
  3. 11
      ritherdon-archive-test.asd
  4. 29
      ritherdon-archive.asd
  5. 44
      src/config.lisp
  6. 23
      src/db.lisp
  7. 30
      src/main.lisp
  8. 51
      src/view.lisp
  9. 35
      src/web.lisp
  10. 21
      static/css/main.css
  11. 47
      templates/_errors/404.html
  12. 7
      templates/index.html
  13. 11
      templates/layouts/default.html
  14. 12
      tests/ritherdon-archive.lisp

39
app.lisp

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

0
db/schema.sql

11
ritherdon-archive-test.asd

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

29
ritherdon-archive.asd

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

44
src/config.lisp

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

23
src/db.lisp

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

30
src/main.lisp

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

51
src/view.lisp

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

35
src/web.lisp

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

21
static/css/main.css

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

47
templates/_errors/404.html

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

7
templates/index.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 %}

11
templates/layouts/default.html

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

12
tests/ritherdon-archive.lisp

@ -1,12 +0,0 @@
(in-package :cl-user)
(defpackage ritherdon-archive-test
(:use :cl
:ritherdon-archive
:prove))
(in-package :ritherdon-archive-test)
(plan nil)
;; blah blah blah.
(finalize)
Loading…
Cancel
Save