git.fiddlerwoaroof.com
Browse code

feat(hn-browser): initial version

Edward authored on 02/02/2022 19:02:25
Showing 2 changed files
hn-browser.deliver.lisp
History View file @ ba443e9
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,30 @@
1 
+(defun utf-8-file-encoding (pathname ef-spec buffer length)
2 
+  (declare (ignore pathname buffer length))
3 
+  (system:merge-ef-specs ef-spec :utf-8))
4 
+
5 
+(setq system:*file-encoding-detection-algorithm*
6 
+      (substitute 'utf-8-file-encoding
7 
+                  'system:locale-file-encoding
8 
+                  system:*file-encoding-detection-algorithm*))
9 
+(set-default-character-element-type 'simple-char)
10 
+
11 
+(in-package :cl-user)
12 
+
13 
+(format t "~&CURDIR: ~a~%" (truename "."))
14 
+(load-all-patches)
15 
+(load "~/quicklisp/setup.lisp")
16 
+(ql:quickload '(:cells :data-lens :drakma :lquery :fwoar-lisputils :alexandria :serapeum))
17 
+(compile-file "/Users/edwlan/git_repos/git.fiddlerwoaroof.com/lisp-sandbox/hn-browser.lisp")
18 
+(load "/Users/edwlan/git_repos/git.fiddlerwoaroof.com/lisp-sandbox/hn-browser")
19 
+
20 
+(deliver (intern "STARTUP" "FWOAR.LISP-SANDBOX.HN-BROWSER")
21 
+         (create-macos-application-bundle
22 
+          "HNReader.app"
23 
+          :document-types nil
24 
+          :identifier "fwoar.cj.HNReader"
25 
+          :version "0.0.never")
26 
+         0
27 
+         :split :resources
28 
+         :interface :capi
29 
+         ;;:startup-bitmap-file nil
30 
+         )
hn-browser.lisp
History View file @ ba443e9
0 31 
new file mode 100644
... ... 
@@ -0,0 +1,206 @@
1 
+(defpackage :fwoar.lisp-sandbox.hn-browser
2 
+  (:use :cl))
3 
+(in-package :fwoar.lisp-sandbox.hn-browser)
4 
+
5 
+(lquery:define-lquery-macro progn (nodes &rest args)
6 
+  `(lquery:$
7 
+     (inline ,nodes)
8 
+     ,@args))
9 
+
10 
+(lquery:define-lquery-function hn-score (item)
11 
+  (lquery:$1 (inline item)
12 
+             (next)
13 
+             ".score"
14 
+             (text)))
15 
+
16 
+(lquery:define-lquery-function hn-age (item)
17 
+  (lquery:$1 (inline item)
18 
+             (next)
19 
+             ".age"
20 
+             (text)))
21 
+
22 
+(lquery:define-lquery-function hn-comments (item)
23 
+  (lquery:$1 (inline item)
24 
+             (next)
25 
+             ".age"
26 
+             (lquery-funcs:next)
27 
+             (next)
28 
+             (next)
29 
+             (attr "href")))
30 
+
31 
+(defun get-hn-data-cached ()
32 
+  (let ((a (load-time-value (list nil))))
33 
+    (if (car a)
34 
+        (car a)
35 
+      (setf (car a)
36 
+            (drakma:http-request "http://news.ycombinator.com")))))
37 
+
38 
+(defun scrape-hn-page (text)
39 
+  (let* ((hnmain (lquery:$ (initialize text)
40 
+                   "#hnmain .itemlist tr.athing"
41 
+                   (combine (progn ".title a" (attr "href")
42 
+                              (node))
43 
+                            (progn ".title a" (text)
44 
+                              (node))
45 
+                            (hn-score)
46 
+                            (hn-age)
47 
+                            (hn-comments)))))
48 
+    (map 'vector
49 
+         (serapeum:op (apply 'make-hn-item _*))
50 
+         hnmain)))
51 
+
52 
+(defclass hn-item ()
53 
+  ((%url :initarg :url :reader url)
54 
+   (%title :initarg :title :reader title)
55 
+   (%score :initarg :score :reader score)
56 
+   (%age :initarg :age :reader age)
57 
+   (%comments :initarg :comments :reader comments)))
58 
+
59 
+(defun make-hn-item (url title score age comments)
60 
+  (flet ((normalize-uri (url)
61 
+           (puri:merge-uris (puri:parse-uri url)
62 
+                            "https://news.ycombinator.com")))
63 
+    (make-instance 'hn-item
64 
+                   :url (normalize-uri url)
65 
+                   :title title
66 
+                   :score (when score (parse-integer score :junk-allowed t))
67 
+                   :age age
68 
+                   :comments (when comments (normalize-uri comments)))))
69 
+
70 
+(defclass hn-store ()
71 
+  ((%items :initarg :items :accessor items)
72 
+   (%selected-item-idx :initarg :selected :accessor selected-item-idx)
73 
+   (%url-type :accessor url-type :initform :|Article|)))
74 
+
75 
+(fw.lu:defclass+ get-page ()
76 
+  ((%page-url :initarg :page-url :reader page-url)))
77 
+
78 
+(fw.lu:defclass+ select-item ()
79 
+  ((%item :initarg :item :reader item)))
80 
+
81 
+(fw.lu:defclass+ update-url-type ()
82 
+  ((%new-type :initarg :new-type :reader new-type)))
83 
+
84 
+(defun selected-item (store)
85 
+  (elt (items store)
86 
+       (selected-item-idx store)))
87 
+
88 
+(defun get-hn-data (suffix)
89 
+  (drakma:http-request (format nil "https://news.ycombinator.com/~a" suffix)))
90 
+
91 
+(serapeum:defalias ui-data
92 
+  (data-lens:<>1
93 
+   (data-lens:transform-tail (data-lens:over (data-lens:applicable-when (lambda (it)
94 
+                                                                          (puri:render-uri it nil))
95 
+                                                                        (complement 'null))))
96 
+   (data-lens:juxt 'title 'url 'comments)))
97 
+
98 
+(defgeneric apply-action (store action)
99 
+  (:method :around (store action)
100 
+   (prog1 store
101 
+     (call-next-method)))
102 
+  (:method ((store hn-store) (action null))
103 
+   (let ((hn-items (scrape-hn-page (get-hn-data-cached))))
104 
+     (setf (items store) hn-items
105 
+           (selected-item-idx store) 0)))
106 
+  (:method ((store hn-store) (action get-page))
107 
+   (let ((hn-items (scrape-hn-page (get-hn-data (page-url action)))))
108 
+     (setf (items store) hn-items)))
109 
+  (:method ((store hn-store) (action select-item))
110 
+   (let ((item (item action)))
111 
+     (setf (selected-item-idx store) (position item (items store)))))
112 
+  (:method ((store hn-store) (action update-url-type))
113 
+   (setf (url-type store) (new-type action))))
114 
+
115 
+(defun request-new-items (interface page)
116 
+  (apply-action interface (get-page page)))
117 
+
118 
+(defun open-item (interface item)
119 
+  (apply-action interface
120 
+                (select-item item)))
121 
+
122 
+(defun switch-article-comments (item interface)
123 
+  (apply-action interface (update-url-type item)))
124 
+
125 
+(capi:define-interface hn-reader (capi:interface hn-store)
126 
+  ()
127 
+  (:panes
128 
+   (pages capi:list-panel
129 
+          :reader hnr-pages
130 
+          :items (list "news" "newest" "ask" "show" "jobs")
131 
+          :initial-constraints '(:visible-max-width (:string "newestest"))
132 
+          :selection-callback 'request-new-items
133 
+          :callback-type :interface-item)
134 
+   (item-panel capi:list-panel
135 
+               :reader hnr-item-panel
136 
+               :print-function 'title
137 
+               :selection-callback 'open-item
138 
+               :callback-type :interface-item)
139 
+   (browser capi:browser-pane
140 
+            :reader hnr-browser
141 
+            :url "https://fwoar.co"))
142 
+  (:layouts
143 
+   (browser-tabs capi:tab-layout
144 
+                 '(browser)
145 
+                 :selection-callback 'switch-article-comments
146 
+                 :items '(:|Article| :|Comments|))
147 
+   (right-side capi:column-layout
148 
+               '(item-panel :divider browser-tabs)
149 
+               :y-ratios '(1 nil 2)
150 
+               :uniform-size-p nil)
151 
+   (main-layout capi:row-layout
152 
+                '(pages :divider right-side)
153 
+                :visible-min-width '(:character 120)
154 
+                :visible-min-height '(:character 40)
155 
+                :x-ratios '(1 nil 2)
156 
+                :uniform-size-p nil))
157 
+  (:default-initargs
158 
+   :layout 'main-layout
159 
+   :title "HN Reader"))
160 
+
161 
+(defun refresh-items (interface)
162 
+  (let ((pane (hnr-item-panel interface)))
163 
+    (capi:apply-in-pane-process
164 
+     pane
165 
+     (lambda (pane)
166 
+       (let ((cleaned-items (remove-if 'null (items interface) :key 'title)))
167 
+         (capi:remove-items pane
168 
+                            (constantly t))
169 
+         (capi:append-items pane
170 
+                            cleaned-items)))
171 
+     pane)))
172 
+
173 
+(defmethod apply-action :after ((store hn-reader) (action null))
174 
+  (refresh-items store))
175 
+
176 
+(defmethod apply-action :after ((store hn-reader) (action get-page))
177 
+  (refresh-items store))
178 
+
179 
+(defmethod apply-action :after ((store hn-reader) (action update-url-type))
180 
+  (apply-action store (select-item (selected-item store))))
181 
+
182 
+(defmethod apply-action :after ((store hn-reader) (action select-item))
183 
+  (let ((pane (hnr-browser store)))
184 
+    (capi:apply-in-pane-process
185 
+     pane
186 
+     (lambda (pane)
187 
+       ;;(format *debug-stream* "> ~{~s~^ ~}~%" (list item interface))
188 
+       (let ((current-item (capi:choice-selected-item (hnr-item-panel store)))
189 
+             (url-type (url-type store)))
190 
+         (ecase url-type
191 
+           (:|Article|
192 
+            (capi:browser-pane-navigate pane
193 
+                                        (second (ui-data (selected-item store)))))
194 
+           (:|Comments|
195 
+            (with-accessors ((comments comments)) current-item
196 
+              (when comments
197 
+                (capi:browser-pane-navigate pane
198 
+                                            (third (ui-data (selected-item store))))))))))
199 
+     pane)))
200 
+
201 
+(defmethod initialize-instance :after ((o hn-reader) &key)
202 
+  (apply-action o nil))
203 
+
204 
+(defun startup ()
205 
+  (capi:display (make-instance 'hn-reader)))
206 
+
0 207 
\ No newline at end of file