mvp

src/clojsa/handler.clj

@@ -1,11 +1,19 @@
 (ns clojsa.handler
-  (:require [compojure.core :refer :all]
+  (:require [clojsa.views :refer [index-page thread-page]]
+            [compojure.core :refer :all]
             [compojure.route :as route]
-            [ring.middleware.defaults :refer [wrap-defaults site-defaults]]))
+            [ring.middleware.defaults :refer [wrap-defaults site-defaults]]
+            [ring.middleware.session :refer [wrap-session]]
+            [ring.middleware.session.cookie :refer (cookie-store)]))
 
 (defroutes app-routes
-  (GET "/" [] "Hello World")
+  (GET "/" request (index-page request))
+  (GET "/thread/:id" [id page]
+       (thread-page (Integer/parseInt id) (Integer/parseInt page)))
   (route/not-found "Not Found"))
 
 (def app
-  (wrap-defaults app-routes site-defaults))
+  (-> app-routes
+      (wrap-defaults site-defaults)
+      (wrap-session {:cookie-attrs {:max-age 3600}
+                     :store (cookie-store {:key "12345678abcdefgh"})})))

src/clojsa/saclient.clj

@@ -0,0 +1,81 @@
+(ns clojsa.saclient
+  (:require [clojure.string :as string]
+            [clj-http.client :as client]
+            [hickory.core :refer :all]
+            [hickory.select :as s]
+            [hickory.convert :refer [hickory-to-hiccup]]))
+
+(def url "https://forums.somethingawful.com/")
+(defn thread-url
+  ([id]
+   (thread-url id 1))
+  ([id page]
+   (let [base-url (str url "showthread.php")
+         query {:threadid id
+                :pagenumber page}]
+     {:href base-url :params query})))
+
+(defn thread-response [url]
+  (let [resp (client/get (:href url) {:query-params (:params url)})]
+    (:body resp)))
+
+(def witcher-thread (thread-response (thread-url 3720352 3)))
+
+(defn hickory-doc [doc]
+  (-> doc parse as-hickory))
+
+(defn parse-title [htree]
+  (-> (s/select (s/child (s/tag :title)) htree)
+      first :content first))
+
+(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 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-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 get-thread [id page]
+  (thread-map id (thread-response (thread-url id page))))

src/clojsa/views.clj

@@ -0,0 +1,77 @@
+(ns clojsa.views
+  (:use [hiccup core page])
+  (:require [clojsa.saclient :refer [get-thread]]
+            [clojure.string :as string]
+            [clojure.java.io :as io]
+            [cheshire.core :as json]))
+
+
+(defn header-fragment []
+  (html
+   [:nav]))
+
+(defn main-template [opts & insert-body-here]
+  (html5
+   {:lang "de"}
+   [:head
+    [:meta {:charset "utf-8"}]
+    [:meta {:http-equiv "x-ua-compatible" :content "ie=edge"}]
+    [:meta {:name "viewport" :content "width=device-width, initial-scale=1"}]
+    [:title (get opts :title "clojsa")]
+    (include-css "/css/bulma.min.css")
+    (include-css "/css/style.css")
+    (include-js "/js/htmx.min.js")]
+   [:body
+    {:hx-boost "false"}
+    [:header
+     (header-fragment)]
+    [:main
+     insert-body-here]
+    (include-js "/js/main.js")]))
+
+(defn index-page [req]
+  (let [thread (get-thread 3720352 3)]
+    (main-template {:title (:title thread)}
+                   [:div.container
+                    (for [post (:content thread)]
+                      [:div.post (:pb post)])])))
+
+(defn paginate [id cur last]
+  [:nav.container.pagination {:hx-boot "false"}
+   [:a.pagination-previous
+    {:href (format "/thread/%d?page=%d" id (dec cur))} "<"]
+   [:a.pagination-next
+    {:href (format "/thread/%s?page=%d" id (inc cur))} ">"]
+   [:ul.pagination-list
+    [:li
+     [:a.pagination-link
+      {:href (format "/thread/%d?page=%d" id 1)} (str 1)]]
+    [:li
+     [:span.pagination-ellipsis "&hellip;"]]
+    (for [i (range (- cur 2) (+ cur 3))]
+      [:li
+       [:a.pagination-link
+        {:href (format "/thread/%d?page=%d" id i)
+         :class (when (= i cur) "is-current")} (str i)]])
+    [:li
+     [:span.pagination-ellipsis "&hellip;"]]
+    [:li
+     [:a.pagination-link
+      {:href (format "/thread/%d?page=%d" id last)} (str last)]]]])
+
+(defn thread-page [id page]
+  (let [thread (get-thread id page)
+        {:keys [id title page-count content]} thread]
+    (main-template
+     {:title title}
+     [:div.container
+      [:h1.is-size-3.mb-4 title]]
+     [:section.thread
+      (for [post content]
+        [:article.container.box.columns
+         [:aside.userinfo.column
+          (:ui post)]
+         [:main.postbody.content.column.is-four-fifths
+          (:pb post)]])]
+     [:section
+      (paginate id page page-count)])))