(in-package :lolisp)
(defvar @html "text/html")
(defparameter *serb* nil
"The hunchentoot acceptor (server) that will serve our handlers and
files.")
(defmacro str (&rest strs)
"Concatenate a list of strings `strs' to one string."
`(concatenate 'string ,@strs))
(defmacro config-item (thing &aux (item (gensym)))
"Get `thing' from the alist `config', error if it doesn't exist"
`(let ((,item (assoc ,thing config)))
(when (atom ,item)
(error "No such config item"))
(cdr ,item)))
(defun loli-link (rating)
"Extract file_url from the JSON returned by `dex:get' and replace
escaped backslashes (\\\\/) with /.
Use cl-rng to pick a random page from the lolibooru API"
(cl-ppcre:register-groups-bind (url)
("(?:file_url\":\")(.*?)(?:\",)"
(dex:get (str "https://lolibooru.moe/post/index.json?tags=rating:"
(or (cl-ppcre:scan-to-strings "^-?[sqe]$" rating) "s")
"+-3dcg+-rape&limit=1&page="
(write-to-string (cl-rng:crandom :limit 25000 :transform 'floor)))))
(cl-ppcre:regex-replace-all "\\\\/" url "/")))
(defun based-loli (url)
(str "data:image/jpeg;base64," (qbase64:encode-bytes (dex:get url))))
(henh:handle :get (loli :uri "/loli/") @html
(rating)
(cl-who:with-html-output-to-string (x)
(:html
(:head
(:meta :charset "utf-8")
(:meta :name "viewport" :content "width=device-width, initial-scale=1")
(:title "lolisp")
(:style "body{position:relative;}img{object-fit:contain;width:100%;height:100%;}#about{position:absolute;top:8px;right:16px}"))
(:body
(:img :src (based-loli (loli-link rating)))
(:a :id "about" :href "/loli/about" "about")))
x))
(defun configure ()
(setf *serb* (make-instance 'hunchentoot:easy-acceptor
:port (config-item :port)
:address (config-item :host)
:document-root (config-item :document-root)
:error-template-directory (config-item :error-root)
;; We (eval) these because quoting streams is werid.
;; '*standard-ouput* is not of type stream why?
:access-log-destination (eval (config-item :access-log))
:message-log-destination (eval (config-item :error-log)))))
(defun start ()
(handler-case (configure)
(error (e) "Configuration failed: ~a" e))
(when (null *serb*)
(error "Serb is nill? ehh?"))
(hunchentoot:start *serb*))
(defun stop ()
(hunchentoot:stop *serb*))
(export '(configure
start
stop
*serb*))