HN async: port of a port of a script from a reddit that turns an HN article into an org-mode file

hn-async.el

"
HN async: port of a port of a script from a reddit that turns an HN article into an org-mode file

@TODO: full eager graph walk of the json sub-structures
@TODO: full lazy walk at depth d
@TODO: org-mode overlay to intercept subtree unfolding as async GET
"

(setq lexical-binding t)

(require 'ht)
(require 'dash)
(require 'dash-functional)

;;; curl -sL https://news.ycombinator.com  | xmllint -html -xpath "//a[contains(@href,'item?id')]/@href" -  | sort | uniq

(defvar *ids* '(19183401 19189401 19190349 19192273
		19192300 19196414 19196489 19196501
		19196965 19197532 19198462 19198497
		19198649 19198748 19198776 19199127
		19199135 19199163 19199441 19199459
		19199525 19199539 19199548 19199647
		19199719 19199892 19199962 19200151
		19200835 19201419)
  "HN ids from the shell pipe above")

(defvar *max-depth* 12)

(defvar *hn/json-endpoint* "https://hacker-news.firebaseio.com/v0/item/%s.json?print=pretty")

;;; prelude

(defmacro commented (&rest body))

(defun pick (l)
  (let ((s (length l)))
    (nth (random s) l)))

(defun thru (f)
  (lambda (v)
    (funcall f v)
    v))

;;; hn utils

(defun url-of (id)
  (format *hn/json-endpoint* id))

(defun buffer:json (b)
  (with-current-buffer b
    (goto-char (1+ url-http-end-of-headers))
    (json-read)))

(defun ->kids (o)
  "Hn object -> kids id list (from json response vector).
O: JSON Object"
  (-map #'identity (cdr (assoc 'kids o))))

;;; this does recurse async but does not construct anything
;;; could pass a cont-accumulator k
;;;   out of order ? useless obv.
;;;   ordered topologically, k would be a store parent-id : child (id . json)
;;;
;;; formatter would then walk that shit ! (c) james brown.edu

(defun hn3 (id d k)
  (message "[beg][%d] %s" d id)
  (if (> d *max-depth*)
      (message "[abort] %d == %d" d *max-depth*)
    (-> id
	hn-url
	(url-retrieve
	 (lambda (s &rest c)
	   (message "[%d] log: %S" d id)
	   (mapcar (lambda (id) (hn3 id (1+ d) k))
		   (let* ((b (current-buffer))
			  (j (buffer:json b))
			  (ks (hn/kids j)))
		     (funcall (funcall k id) j)
		     ks)))))))


(defun test-hn3 ()
  "
  Works~ ... not pretty but I got a map of id -> node by id parent
  First depth level of comments .. @@hackishp
"
  (setq g (ht-create))
  (setq r (hn3 (pick *ids*)
	       0
	       (lambda (i) (message "[k] bound to : %S" i)
		 (lambda (j) (ht-set! g i j)))))
  (ht-size g)
  (ht-each (lambda (k v) (message "%S: %S" k v)) g)

  (let ((root (ht-get g 19198649)))
    (dolist (kid (hn/kids root))
      (let* ((kidj (ht-get g kid))
	     (body (cdr (assoc 'text kidj))))
	(message "  %S: %S" kid body)))))

;; cont 'a 'b ~ 'a -> ('b -> 'c)

;;:: id -> [id]
;; hn i = url-of i . getk >> json :: ->kids

(defalias 'kget 'url-retrieve)
(defalias 'cu '-partial)
(defalias 'co '-compose)

(defun h (id k)
  ":: id -> k -> [id]"
  (-> id
      url-of
      (kget (lambda (s &rest c)
	      (let* ((b (current-buffer))
		     (j (buffer:json b))
		     (ks (->kids j)))
		(funcall k j ks))))))

(commented
 (defvar ID 19183401)
 (h ID (co (cu #'message "%d kids") #'length)))

(commented
 (let* ((k (lambda (kids self)
	     (-flatten (-map (lambda (k) (hn k self)) kids))))
	(K (funcall Y K)))
   (h ID K)))

;; y f = f y f
;; (y f s) = \i -> f (y f) i

(defun Y (f)
  (lambda (v)
    (funcall (funcall f #'Y) v)))

(commented
 (let* ((-K (lambda (self)
	      (lambda (kids) (-flatten (-map (lambda (k) (h k self)) kids)))))
	(K (funcall #'Y -K)))
   (h ID K)))

;; (h x ->
;;    ... h (f x) x ->
;;                 ... h (f x) x -> ...@ )

;; /x -> @ := /y ->
;;     ... self (f x) @

(defun Y (f)
  (lambda (a)
    (funcall (funcall f (funcall #'Y f)) a)))

(let* ((fakt (lambda (self) (lambda (n) (if (< n 2) 1 (* n (funcall self (- n 1)))))))
       (fact (funcall #'Y fakt)))
  (funcall fact 10))

;;; let's try again

(defun h (id k)
  ":: id -> k -> [id]"
  (-> id
      url-of
      (kget (lambda (s &rest c)
	      (let* ((b (current-buffer))
		     (j (buffer:json b))
		     (ks (->kids j)))
		(funcall k j ks))))))

(defun YY (f)
  "binary Y"
  (lambda (a b)
    (funcall (funcall f (funcall #'YY f)) a b)))

(defun test-hn5 (id)
  (let* ((store (ht-create))
	 (-K (lambda (self)
	       (lambda (j kids)
		 (-if-let* ((kids kids)
			    (pid (cdr (assoc 'id j))))
		     (progn
		       (message ">>> %S -> %S" pid kids)
		       (ht-set! store pid kids))
		   (message ">>> [bottom] no more kids"))
		 (-flatten (-map (lambda (k) (h k self)) kids)))))
	 (K (funcall #'YY -K)))
    (h id K)
    
    (let ((pause 5))
      (message "absurd wait...(%d)" pause)
      (sleep-for pause))
    
    (message "Hacker News: %S" id)
    (message "----")
    (ht-each (lambda (k v) (message "%S: %S" k v)) store)
    store))

(test-hn5 (pick *ids*))

;; Y over async. gasp