@@ -10,9 +10,10 @@

 (ql:quickload :spinneret)

 (ql:quickload :clack)

 (ql:quickload :clack-errors)

+(ql:quickload :cl-markdown)

 (defpackage :blogerate

-  (:use :cl :alexandria :ningle :anaphora :ningle))

+  (:use :cl :alexandria :ningle :anaphora :ningle :spinneret))

 (in-package :blogerate)

 (ubiquitous:restore 'blogerate)

@@ -20,18 +21,30 @@

 (manardb:use-mmap-dir "/tmp/manardb-blogerate")

 (manardb:defmmclass blog ()

-    ((id :initarg :id :accessor blog-id)

-     (posts :initarg :posts :accessor blog-posts :initform nil)

-     (tags :initform (make-hash-table :test #'equal) :accessor blog-tags)

-     (authors :initform (make-hash-table :test #'equal) :accessor blog-authors)

-     (sets :initform (make-hash-table :test #'equal) :accessor blog-sets)))

+  ((id :initarg :id :accessor blog-id)

+   (posts :initarg :posts :accessor blog-posts :initform nil)

+   (tags :initform nil :accessor blog-tags)

+   (authors :initform nil :accessor blog-authors)

+   (sets :initform nil :accessor blog-sets)

+   (seed :initarg :seed

+         :initform (make-array 10

+                               :element-type '(unsigned-byte 8)

+                               :initial-contents (loop for x from 1 to 10 collect (random 256)))

+         :accessor blog-seed)))

+

+(manardb:defmmclass post-set ()

+  ((id :initarg :id :accessor set-id :initform nil)

+   (name :initarg :name :accessor set-name)

+   (posts :initarg :posts :accessor set-posts :initform nil)

+   (seed :initarg :seed

+         :initform (make-array 10

+                               :element-type '(unsigned-byte 8)

+                               :initial-contents (loop for x from 1 to 10 collect (random 256)))

+         :accessor set-seed)))

 (manardb:defmmclass post ()

     ((id :initarg :id :accessor post-id :initform (with-output-to-string (s)

-                                                    (uuid:print-bytes s

-                                                                      (uuid:make-v5-uuid

-                                                                        uuid:+namespace-oid+

-                                                                        "blump"))))

+                                                    (uuid:print-bytes s (uuid:make-v4-uuid))))

      (title :initarg :title :accessor post-title :initform "")

      (text :initarg :text :accessor post-text :initform "")

      (author :initarg :author :accessor post-author :initform "")

@@ -39,15 +52,44 @@

      (tags :initarg :tags :initform '() :accessor post-tags)))

 (defun make-post (blog title text author set &key (tags nil tags-p))

-  (let ((result (make-instance 'post :title title :text text :author author :set set :tags tags)))

+  (let ((result (make-instance 'post :title title :text text :author author :set set :tags tags))

+        (set-obj (get-set :name set :author author)))

     (push result (blog-posts blog))

     (when tags-p

       (mapcar (lambda (x) (push (cons x result) (blog-tags blog)))

               (post-tags result)))

-    (push (cons (post-set result) result) (blog-sets blog))

+    (push result (set-posts set-obj))

+    (unless (member set (blog-sets blog) :key #'car :test #'string=)

+      (push (cons set set-obj) (blog-sets blog)))

     (push (cons (post-author result) result) (blog-authors blog))

     result))

+(defparameter *blog* (get-blog "my-blog9"))

+(defvar *app* (make-instance 'ningle:<app>))

+

+

+(defun get-set-by-id (id &optional (blog *blog*))

+  (awhen (blog-sets blog)

+    (awhen (assoc id it :test #'string=)

+      (cdr it))))

+

+(defun get-set-by-name-and-author (name author)

+  (flet ((new-set ()

+           (let ((new-set (make-instance 'post-set :name name)))

+             (setf (set-id new-set) (get-set-id (set-seed new-set) name author))

+             new-set)))

+    (aif (manardb:retrieve-all-instances 'post-set)

+      (aif (car (remove-if-not (lambda (x) (equal (get-set-id (set-seed x) name author) (set-id x)))

+                               it))

+        it

+        (new-set))

+      (new-set))))

+

+(defun get-set (&key id name author)

+  (if id

+    (get-set-by-id id)

+    (get-set-by-name-and-author name author)))

+

 (defun get-blog (id)

   (flet ((new-blog () (make-instance 'blog :id id)))

     (aif (manardb:retrieve-all-instances 'blog)

@@ -56,9 +98,6 @@

         (new-blog))

       (new-blog))))

-(defparameter *blog* (get-blog "my-blog3"))

-(defparameter *app* (make-instance 'ningle:<app>))

-

 (defmacro with-page ((&key title) &body body)

   `(spinneret:with-html-string

      (:doctype)

@@ -66,67 +105,141 @@

        (:head

          (:link :rel "stylesheet" :href "/static/main.css")

          (:title ,title))

-       (:body ,@body))))

+       (:body

+         (:main

+           ,@body)))))

+

+(defmacro format-post (item)

+  (alexandria:once-only (item)

+    `(spinneret:with-html

+       (:section :class "post-show"

+        (:h2

+          (post-title ,item))

+        (:article

+          (:raw

+            (nth-value 1 (cl-markdown:markdown (post-text ,item) :stream nil))))

+        (:span :class "author"

+         (post-author ,item))

+        (:span :class "set"

+         (post-set ,item))

+        (:ul.tags

+          (loop for tag in (post-tags ,item)

+                collect (:li tag)))))))

+

+(defun get-set-posts (set-name)

+  (car

+    (loop for (set . post) in (blog-sets *blog*)

+          if (string= set set-name)

+          collect post)))

+

+(defun get-tag (tag-name)

+  (mapcar #'cdr

+          (remove-if-not (lambda (x) (string= x tag-name))

+                         (blog-tags *blog*)

+                         :key #'car)))

+

+(setf (route *app* "/posts/:set" :method :GET)

+      (lambda (params)

+        (declare (ignorable params))

+        (let* ((set-name (cdr (assoc :set params)))

+               (set-title (format nil "Set ~a" set-name))

+               (set (get-set :id set-name)))

+          (format nil "~s" (get-set :id set-name))

+          (with-page (:title set-title)

+            (:header

+              (:h1 (set-name set)))

+            (loop for post in (set-posts set)

+                  collect (format nil "~s" (format-post post)))))))

+(setf (route *app* "/posts/:set/:tag" :method :GET)

+      (lambda (params)

+        (let* ((set-id (cdr (assoc :set params)))

+               (tag-name (cdr (assoc :tag params)))

+               (set (get-set :id set-id))

+               (set-posts (set-posts set))

+               (tag-posts (get-tag tag-name))

+               (display-posts (intersection set-posts tag-posts

+                                            :key #'post-id

+                                            :test #'string=)))

+          (with-page (:title (format nil "Set: ~a Tag: ~a" (set-name set) tag-name))

+            (:header (:h1 (format nil "Set: ~a Tag: ~a" (set-name set) tag-name)))

+            (mapcar (lambda (post) (format nil "~s" (format-post post)))

+                    display-posts)))))

+

+(spinneret:deftag form-input (body attrs &key name label (type "text"))

+  (declare (ignore body))

+  (alexandria:once-only (name)

+    `(:div.input-group :class ,name ,@attrs

+       ;(:label :for ,name ,label)

+       (:input :placeholder ,label :type ,type :name ,name))))

 (setf (route *app* "/post/new" :method :GET)

       (lambda (params)

         (declare (ignorable params))

-        (with-page (:title "new post")

-          (:header

-            (:h1 "New Post:"))

-          (:section :class "post-new"

-            (:form :action "/post/new" :method "POST"

-             (:input :type "text" :name "title")

-             (:input :type "text" :name "author")

-             (:textarea :name "post")

-             (:input :type "text" :name "set")

-             (:input :type "text" :name "tags")

-             (:input :type "submit"))))))

+          (with-page (:title "new post")

+            (:header

+              (:h1 "New Post:"))

+            (:section :class "post-new"

+              (:form :action "/post/new" :method "POST"

+               (form-input :name "title" :label "Title")

+               (form-input :name "author" :label "Author")

+               (:div.input-group.post

+                 ;(:label :for "post" "Post Content")

+                 (:textarea :placeholder "Content" :name "post"))

+               (form-input :name "set" :label "Set")

+               (form-input :name "tags" :label "Comma-separated Tags")

+               (form-input :type "submit"))))))

 (defun str-assoc-cdr (key alist)

   (cdr (assoc key alist :test #'equal)))

 (defun split-tags (str)

-  (mapcar (lambda (x) (string-trim " " x)) (split-sequence:split-sequence #\, str)))

+  (mapcar (lambda (x) (string-trim " " x))

+          (split-sequence:split-sequence #\, str)))

+

+(defun get-set-id (blog-seed set-name author-name)

+  (let* ((o nil)

+         (digester (ironclad:make-digest :tiger))

+         (digest (progn

+                   (ironclad:update-digest digester blog-seed)

+                   (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array set-name))

+                   (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array author-name))

+                   (ironclad:byte-array-to-hex-string

+                     (ironclad:produce-digest digester))))

+         (digest-length (length digest)))

+    (dotimes (x (ceiling (/ digest-length 5)))

+      (push (subseq digest

+                    (* x 5)

+                    (min digest-length (* (1+ x) 5)))

+            o))

+    (format nil "~{~a~^-~}" o)))

 (setf (route *app* "/post/new" :method :POST)

       (lambda (params)

         (format nil "~s" params)

-        (let ((new-post

+        (let* ((author (str-assoc-cdr "author" params))

+               (set (str-assoc-cdr "set" params))

+               (new-post

                 (make-post *blog*

                            (str-assoc-cdr "title" params)

                            (str-assoc-cdr "post" params)

-                           (str-assoc-cdr "author" params)

-                           (str-assoc-cdr "set" params)

+                           author

+                           set

                            :tags (split-tags (str-assoc-cdr "tags" params)))))

           (with-page (:title (post-title new-post))

             (:header

-              (:h1 (post-title new-post)))

-            (:section :class "post-show"

-             (:article

-               (post-text new-post))

-             (:span :class "author"

-              (post-author new-post))

-             (:span :class "set"

-              (post-set new-post)))))))

+              (:h1 "What a Piece of Blog is This?"))

+            (format-post new-post)))))

 (setf (route *app* "/" :method :GET)

       (lambda (params)

-        (with-page (:title "Blog")

+        (declare (ignore params))

+        (with-page (:title "What a Piece of Blog is This?")

           (:header

-            (:h1 "Blog"))

+            (:h1 "What a Piece of Blog is This?"))

           (loop for new-post in (blog-posts *blog*)

                 collect

-                (:section :class "post-show"

-                 (:h2

-                   (post-title new-post))

-                 (:article

-                   (post-text new-post))

-                 (:span :class "author"

-                  (post-author new-post))

-                 (:span :class "set"

-                  (post-set new-post)))))))

+                (format-post new-post)))))

 (defparameter *handler*

@@ -136,4 +249,4 @@

       ;:csrf

       ;clack-errors:*clack-error-middleware*

       (:static :path "/static/" :root #p"./static/")

-      *app*) :port 5000))

+      *app*) :port 5050))

@@ -5,29 +5,77 @@

 }

 body {

-  background:  hsl(44, 87%, 94%);

+  background: #fdf6e3;

   color: hsl(194, 14%, 40%);

-  text-rendering: geometric-precision;

+  text-rendering: geometricPrecision;

   font-family: Caudex;

+  padding-top: 10vh;

+}

+

+main {

+  background: #eee8d5;

+  width: 66vw;

+  margin-left: 16.5vw;

+  display:block;

 }

 header {

-  padding: 2em;

+  /*padding: 2em;*/

   font-size: 2vmin;

   height: 10vh;

   width: 66vw;

-  margin-left: 16.5vw;

   border: thin solid black;

+  position: fixed;

+  top: 0px;

+  line-height: 10vh;

+  text-align: center;

+  z-index: 100;

+}

+

+header h1 {

+  text-shadow: 0px 0px 0.5em hsl(194, 14%, 40%);

+  color:  hsl(44, 87%, 94%);

+  padding: 0px;

+  margin: 0px;

+}

+

+h1, h2 {

+  text-align: center;

+  margin-top: 1em;

+  margin-bottom: 0.5em;

+}

+

+

+

+header::before {

+  position: absolute;

+  top: 0px;

+  bottom: 0px;

+  left: 0px;

+  right: 0px;

+  content: " ";

+  display: block;

+  background:  hsla(194, 14%, 40%, 0.7);

+  z-index: -1;

+  -webkit-backdrop-filter: blur(2px);

 }

 section.post-new, section.post-show {

   padding: 2em;

-  width: 66vw;

-  margin-left: 16.5vw;

-  border: thin solid black;

+  overflow: hidden;

+  border: thin solid hsl(194, 14%, 40%);

+  border-top: none;

+  border-bottom-width: medium;

+  border-bottom-style: double;

 }

+

 section.post-new {

-  height: 90vh;

+  overflow-y: auto;

+  min-height: 90vh;

+}

+

+form {

+  position: relative;

 }

 input[type=text], textarea {

@@ -36,11 +84,39 @@ input[type=text], textarea {

 input, textarea {

   padding: 0.5em 1em;

-  border: thin solid black;

-  background:   hsl(44, 87%, 94%);

+  border: thin solid #fdf6e3;

+  border-radius: 0.5rem;

+  background:  #fdf6e3;

   color: hsl(194, 14%, 40%);

 }

+input[type=submit], button {

+  color: hsl(44, 87%, 94%);

+  text-shadow: 0px 0px 0.2em hsl(194, 14%, 40%), 0px 0px 0.2em hsl(44, 87%, 94%);

+  background-image: linear-gradient(

+    hsla(194, 14%, 40%, 0.25),

+    hsla(194, 14%, 40%, 0.5),

+    hsl(194, 14%, 40%)

+  );

+}

+

+div.input-group {

+  display: inline-block;

+}

+

+input[type=submit]:hover, button:hover {

+  background-image: linear-gradient(

+    hsl(194, 14%, 40%),

+    hsla(194, 14%, 40%, 0.5),

+    hsla(194, 14%, 40%, 0.25)

+  );

+}

+

+input[type=text], textarea {

+  box-shadow: inset 0em 0em 1em #eee8d5,

+              0em 0em 1em #eee8d5;

+}

+

 section.post-new textarea {

   display: block;

   width: 100%;

@@ -48,29 +124,63 @@ section.post-new textarea {

   margin-bottom: 1em;

 }

-input[name=title] {

+.input-group.title {

   width: 100%;

+}

+

+.input-group.title label,

+.input-group.title input {

   font-size: 150%;

   font-weight: bolder;

   margin-bottom: 1em;

 }

-input[name=author] {

+

+.input-group.title label, .input-group.author label {

+  width: 33%;

+  text-align: right;

+  display: inline-block;

+}

+

+.input-group label {

+  text-transform: uppercase;

+}

+

+.input-group.post {

+  width: 100%;

+}

+

+.input-group.title input, .input-group.author input {

+  display: inline-block;

   width: 66%;

-  margin-left: 34%;

+}

+

+.input-group.author {

+  width: 100%;

   margin-bottom: 1em;

 }

-input[name=set] {

+.input-group.set {

   width: 24%;

   margin-bottom: 1em;

 }

-input[name=tags] {

+input[type=text] {

+  width: 100%;

+}

+

+.input-group.tags {

   width: 74%;

   margin-left: 1%;

   margin-bottom: 1em;

   clear: both;

 }

-input[type=submit] {

+input[type=submit], button {

+  cursor: pointer;

+  position: absolute;

+  right: 0px;

+}

+

+ul, ol {

+  margin-left: 1.5em;

 }