(declaim (optimize (debug 3) (speed 0) (safety 3)))
 (ql:quickload :alexandria)
 (ql:quickload :ironclad)
 (ql:quickload :uuid)
 (ql:quickload :bordeaux-threads)
 (ql:quickload :manardb)
 (ql:quickload :ningle)
 (ql:quickload :anaphora)
 (ql:quickload :ubiquitous)
 (ql:quickload :spinneret)
 (ql:quickload :clack)
 (ql:quickload :clack-errors)

 (ql:quickload :cl-markdown)

 
 (defpackage :blogerate

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

 
 (in-package :blogerate)
 (ubiquitous:restore 'blogerate)
 
 (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 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-v4-uuid))))

      (title :initarg :title :accessor post-title :initform "")
      (text :initarg :text :accessor post-text :initform "")
      (author :initarg :author :accessor post-author :initform "")
      (post-set :initarg :set :accessor post-set :initform "")
      (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))
         (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 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)
       (aif (car (remove-if-not (lambda (x) (equal id (blog-id x))) it))
         it
         (new-blog))
       (new-blog))))
 
 (defmacro with-page ((&key title) &body body)
   `(spinneret:with-html-string
      (:doctype)
      (:html
        (:head
          (:link :rel "stylesheet" :href "/static/main.css")
          (:title ,title))

        (: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"
                (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)))
 
 (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* ((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)

                            author
                            set

                            :tags (split-tags (str-assoc-cdr "tags" params)))))
           (with-page (:title (post-title new-post))
             (:header

               (:h1 "What a Piece of Blog is This?"))
             (format-post new-post)))))

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

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

           (:header

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

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

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

 
 
 (defparameter *handler*
   (clack:clackup
     (lack.builder:builder
       :session
       ;:csrf
       ;clack-errors:*clack-error-middleware*
       (:static :path "/static/" :root #p"./static/")

       *app*) :port 5050))