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