wisp

get interweb fluff
Log | Files | Refs

g (2742B)


      1 #!/usr/bin/env racket
      2 ;;
      3 ;; SPDX-License-Identifier: ISC
      4 ;;
      5 ;; Copyright © 2019 rsiddharth <s@ricketyspace.net>
      6 ;;
      7 
      8 #lang racket/base
      9 
     10 (require racket/date)
     11 (require racket/list)
     12 (require racket/port)
     13 (require racket/format)
     14 (require racket/string)
     15 
     16 (require json)
     17 (require net/http-client)
     18 (require openssl)
     19 
     20 (require html-parsing)
     21 (require sxml)
     22 (require sxml/sxpath)
     23 
     24 
     25 (define HOST "news.ycombinator.com")
     26 
     27 
     28 (define (fmt n w) (~a n #:width w #:align 'right #:pad-string "0"))
     29 
     30 (define (slug)
     31   (let* ((d (current-date)))
     32     (string-join `(,(fmt (date-year d) 4)
     33                    ,(fmt (date-month d) 2)
     34                    ,(fmt (date-day d) 2)) "")))
     35 
     36 (define (fp)
     37   "Fetch HN Front Page."
     38   (let ((hc (http-conn-open HOST #:ssl? (ssl-make-client-context 'secure)
     39                             #:port 443)))
     40     (define-values (status headers port) (http-conn-sendrecv! hc "/"))
     41     (port->string port)))
     42 
     43 (define (athings)
     44   "Get top 20 athings from HN front page."
     45   (let ((x (html->xexp (fp)))
     46         (s (sxpath "//tr[@class=\"athing\"]")))
     47     (take (s x) 20)))
     48 
     49 (define (athing:id a)
     50   "Return athing id"
     51   (let ((id (sxml:attr a 'id)))
     52     (if (empty? id) (error "athing:id: Unable to get id") id)))
     53 
     54 (define (athing:link a)
     55   "Return athing link (HREF DESC)"
     56   (let* ((s (sxpath "//a[@class=\"storylink\"]"))
     57          (l (s a)))
     58     (list (sxml:text l) (sxml:attr (car l) 'href))))
     59 
     60 (define (athings:latest h athings:sxml)
     61   (cond ((empty? athings:sxml) h)
     62         (else
     63          (let* ((athing (car athings:sxml))
     64                 (id (athing:id athing))
     65                 (link (athing:link athing)))
     66            (athings:latest (hash-set h (string->symbol id) link)
     67                            (cdr athings:sxml))))))
     68 
     69 (define (athings:data-dir)
     70   (let ((dir (build-path (find-system-path 'orig-dir) "data")))
     71     (unless (directory-exists? dir) (make-directory dir))
     72     dir))
     73 
     74 (define (athings:file)
     75   (build-path (athings:data-dir) (slug)))
     76 
     77 (define (athings:hash f)
     78   (cond ((file-exists? f)
     79          (call-with-input-file f (λ (in) (read-json in))))
     80         (else (make-immutable-hash))))
     81 
     82 (define (athings:list)
     83   (let ((f (build-path (athings:data-dir) "list")))
     84     (cond ((file-exists? f) (call-with-input-file f (λ (in) (read-json in))))
     85           (else '()))))
     86 
     87 (define (athings:index slug)
     88   (let ((f (build-path (athings:data-dir) "list"))
     89         (l (athings:list)))
     90     (unless (member slug l)
     91         (call-with-output-file f (λ (out) (write-json (cons slug l) out))
     92           #:exists 'truncate))))
     93 
     94 (define (g)
     95   (let* ((f (athings:file))
     96          (h (athings:latest (athings:hash f) (athings))))
     97     (call-with-output-file f (λ (out) (write-json h out)) #:exists 'truncate)
     98     (athings:index (slug))))
     99 
    100 (g)