net-deertopia/src/net/deertopia/doerg/server.clj

(ns net.deertopia.doerg.server
  (:require [clojure.pprint :refer [pprint]]
            [clojure.tools.logging :as l]
            [hiccup2.core :as hiccup]
            [net.deertopia.doerg.html :as doerg-html]
            [net.deertopia.doerg.config :as-alias cfg]
            [net.deertopia.doerg.slug :as slug]
            [net.deertopia.doerg.config :as cfg]
            [net.deertopia.doerg.roam :as roam]
            [org.httpkit.server :as http]
            [reitit.coercion]
            [reitit.coercion.spec]
            [reitit.ring.coercion]
            [reitit.core :as r]
            [reitit.ring]
            [reitit.ring.middleware.exception :as reitit-exception]
            [ring.util.response :as response]
            [spec-tools.spell]
            [reitit.spec]
            [reitit.dev.pretty]
            [clojure.spec.alpha :as s]
            [net.deertopia.doerg.render :as doerg-render]
            [net.deertopia.doerg.cached-file :as cached-file]
            [babashka.fs :as fs]
            [aero.core :as aero]
            [clojure.string :as str]
            [net.deertopia.doerg :as-alias doerg]
            [net.deertopia.doerg.config :as doerg-config]))


;;; Routes

(def homepage-slug "68XqhHerTWCbE--RYLEdHw")
(def not-found-slug "PGDHTvUzQ62Js1Y5db-A8g")

(defn hello [req]
  (-> (hiccup/html {}
        [:html
         [:head
          [:title "hello"]
          doerg-html/charset
          doerg-html/viewport]
         [:body
          [:pre
           (with-out-str
             (pprint req))]]])
      str
      response/response
      (response/content-type "text/html")))

(defn html-dir []
  (-> cfg/*cfg* ::cfg/state-directory (fs/file "html")))

(defn not-found [req]
  (response/not-found "not found"))

(defn org-file->html-file [org-file]
  (fs/file (html-dir)
           (-> org-file
               fs/file-name
               (fs/strip-ext {:ext "org"})
               (str ".html"))))

(defn slug-link [slug & contents]
  [:a {:href (str "/n/" slug)}
   contents])

(defmethod doerg-render/org-link "id"
  [{:keys [path raw-link children]}]
  [:span.org-link
   (slug-link (slug/from-uuid path)
              (or (seq children) raw-link))
   #_[:a {:href (str "/n/" (slug/from-uuid path))}
    (or (seq children) raw-link)]])

(defn backlinks-postamble [node]
  [:section#backlinks
   [:h2 "Backlinks"]
   [:ul
    (for [n (->> (roam/backlinks node)
                 (sort-by (comp str/lower-case roam/title)))]
      [:li (slug-link (roam/slug n)
                      (roam/title n))])]])

(defn node-by-slug [{{:keys [slug]} :path-params :as req}]
  (if-some [node (some-> slug slug/from-string roam/get-node)]
    (let [org-file (roam/org-file node)
          html-file (org-file->html-file org-file)]
      (cached-file/cached-file
       :file html-file
       :stale? (cached-file/newer-than? org-file html-file)
       :compute #(doerg-render/to-html
                  org-file
                  :postamble (backlinks-postamble node)))
      (-> (str html-file)
          response/file-response
          (response/content-type "text/html")))
    (not-found req)))

(defn node-by-id [req]
  (hello req))

(def exception-middleware
  (reitit-exception/create-exception-middleware
   (merge
    reitit-exception/default-handlers
    {::reitit-exception/wrap
     (fn [handler e request]
       (l/error e "error in fucking somwhere dude")
       (handler e request))})))

(defn handle-homepage [req]
  (-> req
      (assoc-in [:path-params :slug] homepage-slug)
      node-by-slug))

(defn handle-resource [{:keys [uri]}]
  (if-some [[_ resource] (re-matches #"^/resource/ibm-plex-web/(.*)" uri)]
    (-> resource
        (response/file-response
         {:root (-> doerg-config/*cfg* ::doerg/ibm-plex-web str)}))
    (-> uri
        (str/replace-first #"^/resource/" "")
        (response/resource-response
         {:root "net/deertopia/doerg/public"
          :allow-symlinks? true}))))

(defn handle-favicon [_]
  (response/resource-response "net/deertopia/doerg/favicon.ico"))

(def router
  (reitit.ring/router
   #{["/" #'handle-homepage]
     ["/n/:slug" #'node-by-slug]
     ["/id/:id" #'node-by-id]
     ["/resource/*" #'handle-resource]
     ["/myreq" #'hello]
     ["/favicon.ico" #'handle-favicon]}
   {:validate reitit.spec/validate
    :exception reitit.dev.pretty/exception
    :spec :reitit.spec/default-data
    :data
    {:coercion reitit.coercion.spec/coercion
     :middleware [exception-middleware
                  reitit.ring.coercion/coerce-request-middleware
                  reitit.ring.coercion/coerce-response-middleware
                  #_reitit.ring.coercion/coerce-exceptions-middleware]}}))


;;; Server API

(def app (reitit.ring/ring-handler router))

(defonce server (atom nil))

(defn stop! []
  (when @server
    (http/server-stop! @server {:timeout 100})
    (reset! server nil)
    (l/info "Stopped server")))

;; For some reason, the log messages from `stop!` are not flushed
;; before the JVM shuts dowm.  Nevertheless, the server /does/ come to
;; a graceful halt.
(def ^:private shutdown-hook (Thread. stop!))

(defn start! []
  (if @server
    (throw (IllegalStateException. "Server already started"))
    (do (reset! server
                (http/run-server (bound-fn* #'app)
                                 {:port (-> cfg/*cfg* ::cfg/port)
                                  :legacy-return-value? false}))
        ;; For some reason, the log messages are not flushed before
        ;; the JVM shuts dowm.  Nevertheless, the server /does/ come
        ;; to a graceful halt.
        (try (.addShutdownHook (Runtime/getRuntime) shutdown-hook)
             (catch IllegalArgumentException e
               (when (not= "Hook previously registered"
                           (ex-message e))
                 (throw e))))
        (l/infof "Server started on port %d"
                 (-> cfg/*cfg* ::cfg/port)))))

(defn status []
  (if @server
    (http/server-status @server)
    :stopped))