postmortem dev dependency for debugging

don't pass state objects to the view.
don't construct urls in the view.

the controller is to prepare a view based on request parameters,
session state, data model

project.clj

@@ -2,7 +2,7 @@
   :description "FIXME: write description"
   :url "http://example.com/FIXME"
   :min-lein-version "2.0.0"
-  :dependencies [[org.clojure/clojure "1.10.0"]
+  :dependencies [[org.clojure/clojure "1.10.1"]
                  [compojure "1.6.1"]
                  [ring/ring-jetty-adapter "1.7.1"]
                  [ring/ring-defaults "0.3.2"]
@@ -10,9 +10,11 @@
                  [hickory "0.7.1"]
                  [environ "1.1.0"]]
   :plugins [[lein-ring "0.12.5"]]
-  :ring {:handler clojsa.handler/app}
+  :ring {:handler clojsa.handler/app
+         :nrepl {:start? true :port 9000}}
   :uberjar-name "clojsa-standalone.jar"
   :profiles
   {:dev {:dependencies [[javax.servlet/servlet-api "2.5"]
-                        [ring/ring-mock "0.3.2"]]}
+                        [ring/ring-mock "0.3.2"]
+                        [postmortem "0.4.0"]]}
    :production {:env {:production true}}})

resources/public/css/style.css

@@ -14,21 +14,27 @@ body {
   margin: 0 auto;
 }
 
+#login-form .control {
+  min-width: 20rem;
+  max-width: 30vw;
+}
+
 nav.pagination {
   background-color: #fff;
   margin-top: 2rem;
 }
 
-.userinfo > dd.registered {
+.userinfo .registered {
   font-size: 0.75rem;
 }
 
-.userinfo > dd.title {
+.userinfo .avatar-title {
   margin-top: 1rem;
   font-size: inherit;
   font-weight: inherit;
   line-height: inherit;
 }
+.userinfo .avatar-title img.img { vertical-align: bottom; }
 
 .content .bbc-block > h4 {
   font-size: 1rem;

src/clojsa/awful/client.clj

@@ -1,6 +1,5 @@
-(ns clojsa.saclient
+(ns clojsa.awful.client
-  (:require [clojure.string :as string]
+  (:require [http.async.client :as http]))
-            [http.async.client :as http]))
 
 
 (def url "https://forums.somethingawful.com/")
@@ -22,7 +21,6 @@
          query {:pagenumber page}]
      {:href base-url :params query})))
 
-
 (defn login-response [username password session]
   (with-open [client (http/create-client)]
     (let [login-url (str url "account.php")
@@ -36,7 +34,7 @@
           http/await
           http/cookies))))
 
-(defn bookmarks-response [session url]
+(defn text-response [session url]
   (with-open [client (http/create-client)]
     (let [{:keys [href params]} url
           req-cookies (:cookies session)
@@ -45,15 +43,6 @@
           headers (http/headers resp)]
       (-> resp
           http/await
-          http/string))))
+          http/body
-
+          .toByteArray
-(defn thread-response [session url]
+          (String. "windows-1252")))))
-  (with-open [client (http/create-client)]
-    (let [{:keys [href params]} url
-          req-cookies (:cookies session)
-          resp (http/GET client href :query params :cookies req-cookies)
-          status (http/status resp)
-          headers (http/headers resp)]
-      (-> resp
-          http/await
-          http/string))))

src/clojsa/awful/parser.clj

@@ -0,0 +1,104 @@
+(ns clojsa.awful.parser
+  (:require [clojure.string :as string]
+            [clojure.pprint :refer [pprint]]
+            [hickory.core :refer :all]
+            [hickory.select :as s]
+            [hickory.convert :refer [hickory-to-hiccup]]))
+
+(defn hickory-doc [doc]
+  (-> doc parse as-hickory))
+
+(defn hickory-div [content class]
+  {:type :element
+   :attrs {:class class}
+   :tag :div
+   :content content})
+
+(defmulti element-node (fn [kw htree] kw))
+
+(defmethod element-node :author [_ htree]
+  (-> (s/select (s/child (s/class :author)) htree)
+      first :content first))
+
+(defmethod element-node :bookmarks [_ htree]
+  (s/select (s/descendant
+             (s/id :forum) (s/tag :tbody) (s/tag :tr)) htree))
+
+(defmethod element-node :pagecount [_ htree]
+  (-> (s/select (s/descendant
+                 (s/class :pages) (s/tag :option)) htree)
+      last :content first Integer/parseInt))
+
+(defmethod element-node :title [_ htree]
+  (-> (s/select (s/child (s/tag :title)) htree)
+      first :content first
+      (string/replace #" - The Something Awful Forums" "")))
+
+(defmethod element-node :thread [_ htree]
+  (let [thread-tree (first (s/select (s/descendant
+                                      (s/id :thread)) htree))
+        td-classes [:userinfo :postdate :postbody]]
+    (for [class-key td-classes]
+      (s/select (s/descendant
+                 (s/and (s/tag :td) (s/class class-key))) thread-tree))))
+
+(defmulti processed-element (fn [kw elem] kw))
+
+(defmethod processed-element :bookmark [_ elem]
+  (when-let [link (first
+                   (s/select (s/descendant
+                              (s/class :info) (s/tag :a)) elem))]
+    (let [thread-id (re-find #"\d+$" (:href (:attrs link)))
+          title (-> link :content first string/trim)]
+      {:id thread-id :title title})))
+
+(defmethod processed-element :postbody [_ elem]
+  (hickory-to-hiccup (hickory-div (:content elem) "postbody")))
+
+(defmethod processed-element :postdate [_ elem]
+  (string/trim (last (hickory-to-hiccup elem))))
+
+(defmethod processed-element :userinfo [_ elem]
+  (let [ui (first (s/select (s/descendant (s/tag :dl)) elem))
+        author (-> (s/select (s/descendant (s/class :author)) ui)
+                   first :content first)
+        regdate (-> (s/select (s/descendant (s/class :registered)) ui)
+                    first :content first)
+        title (-> (s/select (s/descendant (s/class :title)) ui) first)
+        avatar (-> (s/select (s/descendant (s/tag :img)) title) first)]
+    {:author author
+     :regdate regdate
+     :avatar-title (hickory-to-hiccup
+                    (hickory-div (:content title) "avatar-title"))
+     :avatar (when avatar (hickory-to-hiccup avatar))}))
+
+(defn thread-map [id page doc]
+  (let [htree       (hickory-doc doc)
+        title       (element-node :title htree)
+        page-count  (element-node :pagecount htree)
+        thread-tree (element-node :thread htree)
+        [userinfo postdate postbody] thread-tree]
+    {:title title
+     :id id
+     :page page
+     :page-count page-count
+     :content
+     (for [[ui pd pb] (partition 3 (interleave userinfo postdate postbody))
+           :when (not= "Adbot" (element-node :author ui))]
+       {:ui (processed-element :userinfo ui)
+        :pd (processed-element :postdate pd)
+        :pb (processed-element :postbody pb)})}))
+
+(defn bookmarks-map [page doc]
+  (let [htree       (hickory-doc doc)
+        title       (element-node :title htree)
+        page-count  (element-node :pagecount htree)
+        bookmarks-tree (element-node :bookmarks htree)]
+    {:title title
+     :page page
+     :page-count page-count
+     :content
+     (for [row bookmarks-tree
+           :let [parsed-row (processed-element :bookmark row)]
+           :when parsed-row]
+       parsed-row)}))

src/clojsa/handler.clj

@@ -1,8 +1,8 @@
 (ns clojsa.handler
   (:require [clojsa.views :as views]
-            [clojsa.saclient :as client]
+            [clojsa.awful.client :as client]
-            [clojsa.saparser :as parser]
+            [clojsa.awful.parser :as parser]
-            [compojure.core :refer :all]
+            [compojure.core :refer [defroutes GET POST]]
             [compojure.route :as route]
             [compojure.coercions :refer [as-int]]
             [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
@@ -14,29 +14,49 @@
 
 (defn get-thread [session id page]
   (let [turl (client/thread-url id page)
-        tresp (client/thread-response session turl)]
+        tresp (client/text-response session turl)]
     (parser/thread-map id page tresp)))
 
+(defn thread-page [session id page]
+  (let [thread (get-thread session id page)
+        {:keys [id page page-count title]} thread
+        login-part (views/login-form
+                    ["/thread/%d?page=%d" id page]
+                    (get session :loggedin false))
+        header-part (views/header-fragment login-part)
+        thread-part (views/thread-page thread)
+        paginate-part (views/paginate
+                       (str "/thread/" id) page page-count)]
+    (views/main-template {:title title}
+                         header-part thread-part paginate-part)))
+
 (defn get-bookmarks [session page]
   (let [burl (client/bookmarks-url page)
-        bresp (client/bookmarks-response session burl)]
+        bresp (client/text-response session burl)]
     (parser/bookmarks-map page bresp)))
 
 (defroutes app-routes
   (GET "/" request (views/index-page request))
 
-  (GET "/login" [] (views/login-page))
+  (GET "/login" []
+       (views/main-template
+        {:title "Login"}
+        (-> (views/login-form ["/bookmarks"] false)
+                               (views/login-page))))
 
-  (POST "/login" [username password :as {session :session}]
+  (POST "/login" [username password next :as {session :session}]
         (let [resp-cookies (client/login-response username password session)]
           {:status 302
-           :headers {"Location" "/bookmarks"}
+           :headers {"Location" next}
-           :session (assoc session :cookies resp-cookies)}))
+           :session (assoc session :cookies resp-cookies :loggedin true)}))
 
   (GET "/bookmarks" [page :<< as-int
                      :as {session :session}]
-       (let [beems (get-bookmarks session page)]
+       (if (get session :loggedin)
-         (views/bookmarks-page beems)))
+           (let [beems (get-bookmarks session page)]
+             (views/bookmarks-page beems))
+           {:status 302
+            :headers {"Location" "/login"}}))
 
   (GET "/bookmarks" []
        {:status 302 :headers {"Location" "/bookmarks?page=1"}})
@@ -44,8 +64,7 @@
   (GET "/thread/:id" [id :<< as-int
                       page :<< as-int
                       :as {session :session}]
-       (let [thread (get-thread session id page)]
+       (thread-page session id page))
-         (views/thread-page thread)))
 
   (GET "/thread/:id" [id]
        {:status 302 :headers {"Location" (str "/thread/" id "?page=1")}})

src/clojsa/saparser.clj

@@ -1,89 +0,0 @@
-(ns clojsa.saparser
-  (:require [clojsa.saclient :refer [thread-url thread-response]]
-            [clojure.string :as string]
-            [hickory.core :refer :all]
-            [hickory.select :as s]
-            [hickory.convert :refer [hickory-to-hiccup]]))
-
-(defn hickory-doc [doc]
-  (-> doc parse as-hickory))
-
-(defn parse-title [htree]
-  (-> (s/select (s/child (s/tag :title)) htree)
-      first :content first
-      (string/replace #" - The Something Awful Forums" "")))
-
-(defn parse-pagecount [htree]
-  (-> (s/select (s/descendant
-                 (s/class :pages) (s/tag :option)) htree)
-      last :content first Integer/parseInt))
-
-(defn parse-thread [htree]
-  (-> (s/select (s/descendant
-                 (s/id :thread))
-                htree)
-      first))
-
-(defn select-td [class-key htree]
-  (s/select (s/descendant
-             (s/and (s/tag :td) (s/class class-key))) htree))
-
-(defn parse-ui [ui]
-  (let [ui (first (s/select (s/descendant (s/tag :dl)) ui))]
-    (hickory-to-hiccup ui)))
-
-(defn parse-pd [pd]
-  (string/trim (last (hickory-to-hiccup pd))))
-
-(defn hickory-div [class content]
-  {:type :element,
-  :attrs {:class class},
-  :tag :div,
-  :content content})
-
-(defn parse-pb [pb]
-  (let [pb (-> pb :content)]
-    (hickory-to-hiccup (hickory-div "postbody" pb))))
-
-(defn thread-map [id page doc]
-  (let [htree       (hickory-doc doc)
-        title       (parse-title htree)
-        page-count  (parse-pagecount htree)
-        thread-tree (parse-thread htree)
-        userinfo    (select-td :userinfo thread-tree)
-        postdate    (select-td :postdate thread-tree)
-        postbody    (select-td :postbody thread-tree)]
-    {:title title
-     :id id
-     :page page
-     :page-count page-count
-     :content
-     (for [[ui pd pb] (partition 3 (interleave userinfo postdate postbody))
-           :when (not= "Adbot" (-> (s/select (s/child (s/class :author)) ui)
-                                   first :content first))]
-       {:ui (parse-ui ui) :pd (parse-pd pd) :pb (parse-pb pb)})}))
-
-(defn parse-bookmarks [htree]
-  (s/select (s/descendant
-             (s/id :forum)
-             (s/tag :tbody)
-             (s/tag :tr))
-            htree))
-
-(defn parse-row [htree]
-  (let [link (-> (s/select (s/descendant (s/class :info) (s/tag :a)) htree) first)
-        thread-id (re-find #"\d+$" (:href (:attrs link)))
-        title (-> link :content first string/trim)]
-    {:id thread-id :title  title}))
-
-(defn bookmarks-map [page doc]
-  (let [htree       (hickory-doc doc)
-        title       (parse-title htree)
-        page-count  (parse-pagecount htree)
-        bookmarks-tree (parse-bookmarks htree)]
-    {:title title
-     :page page
-     :page-count page-count
-     :content
-     (for [row bookmarks-tree]
-       (parse-row row))}))

src/clojsa/views.clj

@@ -1,16 +1,47 @@
 (ns clojsa.views
-  (:use [hiccup core page])
+  (:require [hiccup.core :refer [html]]
-  (:require [clojure.string :as string]
+            [hiccup.page :refer [html5 include-css include-js]]
             [clojure.pprint]
-            [clojure.java.io :as io]
             [ring.util.anti-forgery :refer [anti-forgery-field]]))
 
 
-(defn header-fragment []
+(defn login-form [next loggedin]
-  (html
+  (if loggedin
-   [:nav]))
+    [:a.navbar-item "Logout"]
+    [:div.navbar-item.has-dropdown.is-hoverable
+     [:a.navbar-link "Login"]
+     [:div.navbar-dropdown.is-right
+      [:div.navbar-item
+       [:form#login-form {:action "/login" :method "post"}
+        (anti-forgery-field)
+        [:input {:type "hidden" :name "next"
+                 :value (apply format next)}]
+        [:div.field
+         [:label.label {:for "username"} "username"]
+         [:div.control
+          [:input#username.input {:name "username" :type "text"
+                                  :placeholder "enter your username"}]]]
+        [:div.field
+         [:label.label {:for "password"} "password"]
+         [:div.control
+          [:input#password.input {:name "password" :type "password"
+                                  :placeholder "enter your password"}]]]
+        [:div.field
+         [:div.control
+          [:button.button.is-primary "Submit"]]]]]]]))
 
-(defn main-template [opts & insert-body-here]
+(defn header-fragment [login]
+  [:nav.navbar.is-transparent
+   [:div.navbar-brand
+    [:a.burger.navbar-burger {:role "button" :data-target "mainNav"}
+     (repeat 3 [:span {:aria-hidden "true"}])]]
+   [:div#mainNav.navbar-menu
+    [:div.navbar-start
+     [:a.navbar-item {:href "/bookmarks"} "Bookmarks"]]
+    [:div.navbar-end
+     login]]])
+
+(defn main-template [opts header & insert-body-here]
   (html5
    {:lang "de"}
    [:head
@@ -24,7 +55,7 @@
    [:body
     {:hx-boost "false"}
     [:header
-     (header-fragment)]
+     header]
     [:main
      insert-body-here]
     (include-js "/js/main.js")]))
@@ -36,70 +67,64 @@
     [:pre.output
      [:code (with-out-str (clojure.pprint/pprint req))]]]))
 
-(defn login-page []
+(defn login-page [login]
-  (main-template
+  [:div.container.box
-   {:title "login"}
+   login])
-   [:div.container.box
-    [:form#login-form {:action "/login" :method "post"}
-     (anti-forgery-field)
-     [:div.field
-      [:label.label {:for "username"}
-       "username"]
-      [:div.control
-       [:input#username.input {:name "username" :type "text" :placeholder "enter your username"}]]]
-     [:div.field
-      [:label.label {:for "password"}
-       "password"]
-      [:div.control
-       [:input#password.input {:name "password" :type "password" :placeholder "enter your password"}]]]
-     [:div.field
-      [:div.control
-       [:button.button.is-primary "Submit"]]]]]))
 
 (defn paginate [base cur last]
-  [:nav.container.box.pagination {:hx-boot "false"}
+  (let [page-fstring "%s?page=%d"
-   [:a.pagination-previous
+        href (partial format page-fstring base)]
-    {:href (format "%s?page=%d" base (dec cur))} "<"]
+    [:section
-   [:a.pagination-next
+     [:nav.container.box.pagination {:hx-boot "false"}
-    {:href (format "%s?page=%d" base (inc cur))} ">"]
+      [:a.pagination-previous
-   [:ul.pagination-list
+       {:href (href (dec cur))} "<"]
-    [:li
+      [:a.pagination-next
-     [:a.pagination-link
+       {:href (href (inc cur))} ">"]
-      {:href (format "%s?page=%d" base 1)} (str 1)]]
+      [:ul.pagination-list
-    [:li
+       [:li
-     [:span.pagination-ellipsis "&hellip;"]]
+        [:a.pagination-link
-    (for [i (range (- cur 2) (+ cur 3))]
+         {:href (href 1)} (str 1)]]
-      [:li
+       [:li
-       [:a.pagination-link
+        [:span.pagination-ellipsis "&hellip;"]]
-        {:href (format "%s?page=%d" base i)
+       (for [i (range (- cur 2) (+ cur 3))]
-         :class (when (= i cur) "is-current")} (str i)]])
+         [:li
-    [:li
+          [:a.pagination-link
-     [:span.pagination-ellipsis "&hellip;"]]
+           {:href (href i)
-    [:li
+            :class (when (= i cur) "is-current")} (str i)]])
-     [:a.pagination-link
+       [:li
-      {:href (format "%s?page=%d" base last)} (str last)]]]])
+        [:span.pagination-ellipsis "&hellip;"]]
+       [:li
+        [:a.pagination-link
+         {:href (href last)} (str last)]]]]]))
 
-(defn thread-page [thread]
+(defn thread-page [{:keys [title content]}]
-  (let [{:keys [id title page page-count content]} thread]
+  (list
-    (main-template
+   [:section.title [:div.container
-     {:title title}
+                    [:h1.is-size-3.mb-4 title]]]
-     [:div.container
+   [:section.thread
-      [:h1.is-size-3.mb-4 title]]
+    (for [post content]
-     [:section.thread
+      [:article.container.box
-      (for [post content]
+       [:div.tile.is-ancestor
-        [:article.container.box
+        [:aside.userinfo.card.is-shadowless.tile.is-3.is-parent
-         [:div.tile.is-ancestor
+         [:div.card-content.px-0.py-0
-          [:aside.userinfo.tile.is-3.is-parent
+          (let [{:keys [author regdate avatar avatar-title]} (:ui post)]
-           (:ui post)]
+            (list
-          [:main.postbody.content.tile.is-9.is-parent.is-vertical
+             [:div.media
-           [:div.tile.is-child
+              (when avatar
-            (:pb post)]
+                [:div.media-left.is-hidden-tablet
-           [:div.level.tile.is-child.is-12
+                 [:figure.image.is-64x64 avatar]])
-            [:div.level-right
+              [:div.media-content
-             [:span.postdate.level-item
+               [:p.author.title.is-4 author]
-              (:pd post)]]]]]])]
+               [:p.regdate.subtitle.is-6 regdate]]]
-     [:section
+             [:div.is-hidden-mobile
-      (paginate (str "/thread/" id) page page-count)])))
+              avatar-title]))]]
+        [:main.postbody.tile.is-9.is-parent.is-vertical
+         [:div.content.is-size-6.tile.is-child
+          (:pb post)]
+         [:div.level.is-mobile.tile.is-child.is-12
+          [:div.level-right
+           [:span.postdate.level-item
+            (:pd post)]]]]]])]))
 
 (defn bookmarks-page [beems]
   (let [{:keys [title page page-count content]} beems]