git.fiddlerwoaroof.com
Browse code

inital

fiddlerwoaroof authored on 19/11/2015 07:42:41
Showing 2 changed files
blogerate.lisp
History View file @ 9d7c4d5
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,139 @@
1 
+(declaim (optimize (debug 3) (speed 0) (safety 3)))
2 
+(ql:quickload :alexandria)
3 
+(ql:quickload :ironclad)
4 
+(ql:quickload :uuid)
5 
+(ql:quickload :bordeaux-threads)
6 
+(ql:quickload :manardb)
7 
+(ql:quickload :ningle)
8 
+(ql:quickload :anaphora)
9 
+(ql:quickload :ubiquitous)
10 
+(ql:quickload :spinneret)
11 
+(ql:quickload :clack)
12 
+(ql:quickload :clack-errors)
13 
+
14 
+(defpackage :blogerate
15 
+  (:use :cl :alexandria :ningle :anaphora :ningle))
16 
+
17 
+(in-package :blogerate)
18 
+(ubiquitous:restore 'blogerate)
19 
+
20 
+(manardb:use-mmap-dir "/tmp/manardb-blogerate")
21 
+
22 
+(manardb:defmmclass blog ()
23 
+    ((id :initarg :id :accessor blog-id)
24 
+     (posts :initarg :posts :accessor blog-posts :initform nil)
25 
+     (tags :initform (make-hash-table :test #'equal) :accessor blog-tags)
26 
+     (authors :initform (make-hash-table :test #'equal) :accessor blog-authors)
27 
+     (sets :initform (make-hash-table :test #'equal) :accessor blog-sets)))
28 
+
29 
+(manardb:defmmclass post ()
30 
+    ((id :initarg :id :accessor post-id :initform (with-output-to-string (s)
31 
+                                                    (uuid:print-bytes s
32 
+                                                                      (uuid:make-v5-uuid
33 
+                                                                        uuid:+namespace-oid+
34 
+                                                                        "blump"))))
35 
+     (title :initarg :title :accessor post-title :initform "")
36 
+     (text :initarg :text :accessor post-text :initform "")
37 
+     (author :initarg :author :accessor post-author :initform "")
38 
+     (post-set :initarg :set :accessor post-set :initform "")
39 
+     (tags :initarg :tags :initform '() :accessor post-tags)))
40 
+
41 
+(defun make-post (blog title text author set &key (tags nil tags-p))
42 
+  (let ((result (make-instance 'post :title title :text text :author author :set set :tags tags)))
43 
+    (push result (blog-posts blog))
44 
+    (when tags-p
45 
+      (mapcar (lambda (x) (push (cons x result) (blog-tags blog)))
46 
+              (post-tags result)))
47 
+    (push (cons (post-set result) result) (blog-sets blog))
48 
+    (push (cons (post-author result) result) (blog-authors blog))
49 
+    result))
50 
+
51 
+(defun get-blog (id)
52 
+  (flet ((new-blog () (make-instance 'blog :id id)))
53 
+    (aif (manardb:retrieve-all-instances 'blog)
54 
+      (aif (car (remove-if-not (lambda (x) (equal id (blog-id x))) it))
55 
+        it
56 
+        (new-blog))
57 
+      (new-blog))))
58 
+
59 
+(defparameter *blog* (get-blog "my-blog3"))
60 
+(defparameter *app* (make-instance 'ningle:<app>))
61 
+
62 
+(defmacro with-page ((&key title) &body body)
63 
+  `(spinneret:with-html-string
64 
+     (:doctype)
65 
+     (:html
66 
+       (:head
67 
+         (:link :rel "stylesheet" :href "/static/main.css")
68 
+         (:title ,title))
69 
+       (:body ,@body))))
70 
+
71 
+
72 
+(setf (route *app* "/post/new" :method :GET)
73 
+      (lambda (params)
74 
+        (declare (ignorable params))
75 
+        (with-page (:title "new post")
76 
+          (:header
77 
+            (:h1 "New Post:"))
78 
+          (:section :class "post-new"
79 
+            (:form :action "/post/new" :method "POST"
80 
+             (:input :type "text" :name "title")
81 
+             (:input :type "text" :name "author")
82 
+             (:textarea :name "post")
83 
+             (:input :type "text" :name "set")
84 
+             (:input :type "text" :name "tags")
85 
+             (:input :type "submit"))))))
86 
+
87 
+(defun str-assoc-cdr (key alist)
88 
+  (cdr (assoc key alist :test #'equal)))
89 
+
90 
+(defun split-tags (str)
91 
+  (mapcar (lambda (x) (string-trim " " x)) (split-sequence:split-sequence #\, str)))
92 
+
93 
+(setf (route *app* "/post/new" :method :POST)
94 
+      (lambda (params)
95 
+        (format nil "~s" params)
96 
+        (let ((new-post
97 
+                (make-post *blog*
98 
+                           (str-assoc-cdr "title" params)
99 
+                           (str-assoc-cdr "post" params)
100 
+                           (str-assoc-cdr "author" params)
101 
+                           (str-assoc-cdr "set" params)
102 
+                           :tags (split-tags (str-assoc-cdr "tags" params)))))
103 
+          (with-page (:title (post-title new-post))
104 
+            (:header
105 
+              (:h1 (post-title new-post)))
106 
+            (:section :class "post-show"
107 
+             (:article
108 
+               (post-text new-post))
109 
+             (:span :class "author"
110 
+              (post-author new-post))
111 
+             (:span :class "set"
112 
+              (post-set new-post)))))))
113 
+
114 
+(setf (route *app* "/" :method :GET)
115 
+      (lambda (params)
116 
+        (with-page (:title "Blog")
117 
+          (:header
118 
+            (:h1 "Blog"))
119 
+          (loop for new-post in (blog-posts *blog*)
120 
+                collect
121 
+                (:section :class "post-show"
122 
+                 (:h2
123 
+                   (post-title new-post))
124 
+                 (:article
125 
+                   (post-text new-post))
126 
+                 (:span :class "author"
127 
+                  (post-author new-post))
128 
+                 (:span :class "set"
129 
+                  (post-set new-post)))))))
130 
+
131 
+
132 
+(defparameter *handler*
133 
+  (clack:clackup
134 
+    (lack.builder:builder
135 
+      :session
136 
+      ;:csrf
137 
+      ;clack-errors:*clack-error-middleware*
138 
+      (:static :path "/static/" :root #p"./static/")
139 
+      *app*) :port 5000))
static/main.css
History View file @ 9d7c4d5
0 140 
new file mode 100644
... ... 
@@ -0,0 +1,76 @@
1 
+* {
2 
+  box-sizing: border-box;
3 
+  padding: 0px;
4 
+  margin: 0px;
5 
+}
6 
+
7 
+body {
8 
+  background:  hsl(44, 87%, 94%);
9 
+  color: hsl(194, 14%, 40%);
10 
+  text-rendering: geometric-precision;
11 
+  font-family: Caudex;
12 
+}
13 
+
14 
+header {
15 
+  padding: 2em;
16 
+  font-size: 2vmin;
17 
+  height: 10vh;
18 
+  width: 66vw;
19 
+  margin-left: 16.5vw;
20 
+  border: thin solid black;
21 
+}
22 
+
23 
+section.post-new, section.post-show {
24 
+  padding: 2em;
25 
+  width: 66vw;
26 
+  margin-left: 16.5vw;
27 
+  border: thin solid black;
28 
+}
29 
+section.post-new {
30 
+  height: 90vh;
31 
+}
32 
+
33 
+input[type=text], textarea {
34 
+  display: inline-block;
35 
+}
36 
+
37 
+input, textarea {
38 
+  padding: 0.5em 1em;
39 
+  border: thin solid black;
40 
+  background:   hsl(44, 87%, 94%);
41 
+  color: hsl(194, 14%, 40%);
42 
+}
43 
+
44 
+section.post-new textarea {
45 
+  display: block;
46 
+  width: 100%;
47 
+  height: 60vh;
48 
+  margin-bottom: 1em;
49 
+}
50 
+
51 
+input[name=title] {
52 
+  width: 100%;
53 
+  font-size: 150%;
54 
+  font-weight: bolder;
55 
+  margin-bottom: 1em;
56 
+}
57 
+input[name=author] {
58 
+  width: 66%;
59 
+  margin-left: 34%;
60 
+  margin-bottom: 1em;
61 
+}
62 
+
63 
+input[name=set] {
64 
+  width: 24%;
65 
+  margin-bottom: 1em;
66 
+}
67 
+
68 
+input[name=tags] {
69 
+  width: 74%;
70 
+  margin-left: 1%;
71 
+  margin-bottom: 1em;
72 
+  clear: both;
73 
+}
74 
+
75 
+input[type=submit] {
76 
+}