git.fiddlerwoaroof.com
Raw Blame History
(defpackage :fwoar.lisp-sandbox.hn-browser
  (:use :cl))
(in-package :fwoar.lisp-sandbox.hn-browser)

(lquery:define-lquery-macro progn (nodes &rest args)
  `(lquery:$
     (inline ,nodes)
     ,@args))

(lquery:define-lquery-function hn-score (item)
  (lquery:$1 (inline item)
             (next)
             ".score"
             (text)))

(lquery:define-lquery-function hn-age (item)
  (lquery:$1 (inline item)
             (next)
             ".age"
             (text)))

(lquery:define-lquery-function hn-comments (item)
  (lquery:$1 (inline item)
             (next)
             ".age"
             (lquery-funcs:next)
             (next)
             (next)
             (attr "href")))

(defun get-hn-data-cached ()
  (let ((a (load-time-value (list nil))))
    (if (car a)
        (car a)
      (setf (car a)
            (drakma:http-request "http://news.ycombinator.com")))))

(defun scrape-hn-page (text)
  (let* ((hnmain (lquery:$ (initialize text)
                   "#hnmain .itemlist tr.athing"
                   (combine (progn ".title a" (attr "href")
                              (node))
                            (progn ".title a" (text)
                              (node))
                            (hn-score)
                            (hn-age)
                            (hn-comments)))))
    (map 'vector
         (serapeum:op (apply 'make-hn-item _*))
         hnmain)))

(defclass hn-item ()
  ((%url :initarg :url :reader url)
   (%title :initarg :title :reader title)
   (%score :initarg :score :reader score)
   (%age :initarg :age :reader age)
   (%comments :initarg :comments :reader comments)))

(defun make-hn-item (url title score age comments)
  (flet ((normalize-uri (url)
           (puri:merge-uris (puri:parse-uri url)
                            "https://news.ycombinator.com")))
    (make-instance 'hn-item
                   :url (normalize-uri url)
                   :title title
                   :score (when score (parse-integer score :junk-allowed t))
                   :age age
                   :comments (when comments (normalize-uri comments)))))

(defclass hn-store ()
  ((%items :initarg :items :accessor items)
   (%selected-item-idx :initarg :selected :accessor selected-item-idx)
   (%url-type :accessor url-type :initform :|Article|)))

(fw.lu:defclass+ get-page ()
  ((%page-url :initarg :page-url :reader page-url)))

(fw.lu:defclass+ select-item ()
  ((%item :initarg :item :reader item)))

(fw.lu:defclass+ update-url-type ()
  ((%new-type :initarg :new-type :reader new-type)))

(defun selected-item (store)
  (elt (items store)
       (selected-item-idx store)))

(defun get-hn-data (suffix)
  (drakma:http-request (format nil "https://news.ycombinator.com/~a" suffix)))

(serapeum:defalias ui-data
  (data-lens:<>1
   (data-lens:transform-tail (data-lens:over (data-lens:applicable-when (lambda (it)
                                                                          (puri:render-uri it nil))
                                                                        (complement 'null))))
   (data-lens:juxt 'title 'url 'comments)))

(defgeneric apply-action (store action)
  (:method :around (store action)
   (prog1 store
     (call-next-method)))
  (:method ((store hn-store) (action null))
   (let ((hn-items (scrape-hn-page (get-hn-data-cached))))
     (setf (items store) hn-items
           (selected-item-idx store) 0)))
  (:method ((store hn-store) (action get-page))
   (let ((hn-items (scrape-hn-page (get-hn-data (page-url action)))))
     (setf (items store) hn-items)))
  (:method ((store hn-store) (action select-item))
   (let ((item (item action)))
     (setf (selected-item-idx store) (position item (items store)))))
  (:method ((store hn-store) (action update-url-type))
   (setf (url-type store) (new-type action))))

(defun request-new-items (interface page)
  (apply-action interface (get-page page)))

(defun open-item (interface item)
  (apply-action interface
                (select-item item)))
  
(defun switch-article-comments (item interface)
  (apply-action interface (update-url-type item)))
  
(capi:define-interface hn-reader (capi:interface hn-store)
  ()
  (:panes
   (pages capi:list-panel
          :reader hnr-pages
          :items (list "news" "newest" "ask" "show" "jobs")
          :initial-constraints '(:visible-max-width (:string "newestest"))
          :selection-callback 'request-new-items
          :callback-type :interface-item)
   (item-panel capi:list-panel
               :reader hnr-item-panel
               :print-function 'title
               :selection-callback 'open-item
               :callback-type :interface-item)
   (browser capi:browser-pane
            :reader hnr-browser
            :url "https://fwoar.co"))
  (:layouts
   (browser-tabs capi:tab-layout
                 '(browser)
                 :selection-callback 'switch-article-comments
                 :items '(:|Article| :|Comments|))
   (right-side capi:column-layout
               '(item-panel :divider browser-tabs)
               :y-ratios '(1 nil 2)
               :uniform-size-p nil)
   (main-layout capi:row-layout
                '(pages :divider right-side)
                :visible-min-width '(:character 120)
                :visible-min-height '(:character 40)
                :x-ratios '(1 nil 2)
                :uniform-size-p nil))
  (:default-initargs
   :layout 'main-layout
   :title "HN Reader"))

(defun refresh-items (interface)
  (let ((pane (hnr-item-panel interface)))
    (capi:apply-in-pane-process
     pane
     (lambda (pane)
       (let ((cleaned-items (remove-if 'null (items interface) :key 'title)))
         (capi:remove-items pane
                            (constantly t))
         (capi:append-items pane 
                            cleaned-items)))
     pane)))

(defmethod apply-action :after ((store hn-reader) (action null))
  (refresh-items store))

(defmethod apply-action :after ((store hn-reader) (action get-page))
  (refresh-items store))

(defmethod apply-action :after ((store hn-reader) (action update-url-type))
  (apply-action store (select-item (selected-item store))))

(defmethod apply-action :after ((store hn-reader) (action select-item))
  (let ((pane (hnr-browser store)))
    (capi:apply-in-pane-process
     pane
     (lambda (pane)
       ;;(format *debug-stream* "> ~{~s~^ ~}~%" (list item interface))
       (let ((current-item (capi:choice-selected-item (hnr-item-panel store)))
             (url-type (url-type store)))
         (ecase url-type
           (:|Article|
            (capi:browser-pane-navigate pane
                                        (second (ui-data (selected-item store)))))
           (:|Comments|
            (with-accessors ((comments comments)) current-item
              (when comments
                (capi:browser-pane-navigate pane
                                            (third (ui-data (selected-item store))))))))))
     pane)))

(defmethod initialize-instance :after ((o hn-reader) &key)
  (apply-action o nil))

(defun startup ()
  (capi:display (make-instance 'hn-reader)))