rdiedrich/clojsa
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

multimethods

Browse Source
This commit is contained in:
Rüdiger Diedrich 2020-06-30 18:36:19 +02:00
parent 0c81a2f51a
commit 00f57ae117
1 changed files with 48 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
src/clojsa/saparser.clj
View File

@ -14,64 +14,63 @@
:tag :div
:content content})
(defn element-node [kw htree]
(case kw
(defmulti element-node (fn [kw htree] kw))
:author
(-> (s/select (s/child (s/class :author)) htree)
first :content first)
(defmethod element-node :author [_ htree]
(-> (s/select (s/child (s/class :author)) htree)
first :content first))
:bookmarks
(s/select (s/descendant
(s/id :forum) (s/tag :tbody) (s/tag :tr)) htree)
(defmethod element-node :bookmarks [_ htree]
(s/select (s/descendant
(s/id :forum) (s/tag :tbody) (s/tag :tr)) htree))
:pagecount
(-> (s/select (s/descendant
(s/class :pages) (s/tag :option)) htree)
last :content first Integer/parseInt)
(defmethod element-node :pagecount [_ htree]
(-> (s/select (s/descendant
(s/class :pages) (s/tag :option)) htree)
last :content first Integer/parseInt))
:title
(-> (s/select (s/child (s/tag :title)) htree)
first :content first
(string/replace #" - The Something Awful Forums" ""))
(defmethod element-node :title [_ htree]
(-> (s/select (s/child (s/tag :title)) htree)
first :content first
(string/replace #" - The Something Awful Forums" "")))
:thread
(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)))))
(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))))
(defn processed-element [kw elem]
(case kw
:bookmark
(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}))
(defmulti processed-element (fn [kw elem] kw))
:postbody
(hickory-to-hiccup (hickory-div (:content elem) "postbody"))
(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})))
:postdate
(string/trim (last (hickory-to-hiccup elem)))
(defmethod processed-element :postbody [_ elem]
(hickory-to-hiccup (hickory-div (:content elem) "postbody")))
:userinfo
(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))})))
(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)