From 93c1aec877d17218c4a786081707a4b05793eb9f Mon Sep 17 00:00:00 2001 From: rsiddharth Date: Tue, 18 Jun 2019 20:09:55 -0400 Subject: hn/g -> hn --- Makefile | 3 ++ hn | 100 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ hn/Makefile | 3 -- hn/g | 100 ------------------------------------------------------------ 4 files changed, 103 insertions(+), 103 deletions(-) create mode 100644 Makefile create mode 100755 hn delete mode 100644 hn/Makefile delete mode 100755 hn/g diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..f054558 --- /dev/null +++ b/Makefile @@ -0,0 +1,3 @@ +pkgs: + raco pkg install --skip-installed html-parsing sxml +.PHONY: pkgs diff --git a/hn b/hn new file mode 100755 index 0000000..0c424b7 --- /dev/null +++ b/hn @@ -0,0 +1,100 @@ +#!/usr/bin/env racket +;; +;; SPDX-License-Identifier: ISC +;; +;; Copyright © 2019 rsiddharth +;; + +#lang racket/base + +(require racket/date) +(require racket/list) +(require racket/port) +(require racket/format) +(require racket/string) + +(require json) +(require net/http-client) +(require openssl) + +(require html-parsing) +(require sxml) +(require sxml/sxpath) + + +(define HOST "news.ycombinator.com") + + +(define (fmt n w) (~a n #:width w #:align 'right #:pad-string "0")) + +(define (slug) + (let* ((d (current-date))) + (string-join `(,(fmt (date-year d) 4) + ,(fmt (date-month d) 2) + ,(fmt (date-day d) 2)) ""))) + +(define (fp) + "Fetch HN Front Page." + (let ((hc (http-conn-open HOST #:ssl? (ssl-make-client-context 'secure) + #:port 443))) + (define-values (status headers port) (http-conn-sendrecv! hc "/")) + (port->string port))) + +(define (athings) + "Get top 20 athings from HN front page." + (let ((x (html->xexp (fp))) + (s (sxpath "//tr[@class=\"athing\"]"))) + (take (s x) 20))) + +(define (athing:id a) + "Return athing id" + (let ((id (sxml:attr a 'id))) + (if (empty? id) (error "athing:id: Unable to get id") id))) + +(define (athing:link a) + "Return athing link (HREF DESC)" + (let* ((s (sxpath "//a[@class=\"storylink\"]")) + (l (s a))) + (list (sxml:text l) (sxml:attr (car l) 'href)))) + +(define (athings:latest h athings:sxml) + (cond ((empty? athings:sxml) h) + (else + (let* ((athing (car athings:sxml)) + (id (athing:id athing)) + (link (athing:link athing))) + (athings:latest (hash-set h (string->symbol id) link) + (cdr athings:sxml)))))) + +(define (athings:data-dir) + (let ((dir (build-path (find-system-path 'orig-dir) "data/hn"))) + (unless (directory-exists? dir) (make-directory dir)) + dir)) + +(define (athings:file) + (build-path (athings:data-dir) (slug))) + +(define (athings:hash f) + (cond ((file-exists? f) + (call-with-input-file f (λ (in) (read-json in)))) + (else (make-immutable-hash)))) + +(define (athings:list) + (let ((f (build-path (athings:data-dir) "list"))) + (cond ((file-exists? f) (call-with-input-file f (λ (in) (read-json in)))) + (else '())))) + +(define (athings:index slug) + (let ((f (build-path (athings:data-dir) "list")) + (l (athings:list))) + (unless (member slug l) + (call-with-output-file f (λ (out) (write-json (cons slug l) out)) + #:exists 'truncate)))) + +(define (hn) + (let* ((f (athings:file)) + (h (athings:latest (athings:hash f) (athings)))) + (call-with-output-file f (λ (out) (write-json h out)) #:exists 'truncate) + (athings:index (slug)))) + +(hn) diff --git a/hn/Makefile b/hn/Makefile deleted file mode 100644 index f054558..0000000 --- a/hn/Makefile +++ /dev/null @@ -1,3 +0,0 @@ -pkgs: - raco pkg install --skip-installed html-parsing sxml -.PHONY: pkgs diff --git a/hn/g b/hn/g deleted file mode 100755 index 027f4db..0000000 --- a/hn/g +++ /dev/null @@ -1,100 +0,0 @@ -#!/usr/bin/env racket -;; -;; SPDX-License-Identifier: ISC -;; -;; Copyright © 2019 rsiddharth -;; - -#lang racket/base - -(require racket/date) -(require racket/list) -(require racket/port) -(require racket/format) -(require racket/string) - -(require json) -(require net/http-client) -(require openssl) - -(require html-parsing) -(require sxml) -(require sxml/sxpath) - - -(define HOST "news.ycombinator.com") - - -(define (fmt n w) (~a n #:width w #:align 'right #:pad-string "0")) - -(define (slug) - (let* ((d (current-date))) - (string-join `(,(fmt (date-year d) 4) - ,(fmt (date-month d) 2) - ,(fmt (date-day d) 2)) ""))) - -(define (fp) - "Fetch HN Front Page." - (let ((hc (http-conn-open HOST #:ssl? (ssl-make-client-context 'secure) - #:port 443))) - (define-values (status headers port) (http-conn-sendrecv! hc "/")) - (port->string port))) - -(define (athings) - "Get top 20 athings from HN front page." - (let ((x (html->xexp (fp))) - (s (sxpath "//tr[@class=\"athing\"]"))) - (take (s x) 20))) - -(define (athing:id a) - "Return athing id" - (let ((id (sxml:attr a 'id))) - (if (empty? id) (error "athing:id: Unable to get id") id))) - -(define (athing:link a) - "Return athing link (HREF DESC)" - (let* ((s (sxpath "//a[@class=\"storylink\"]")) - (l (s a))) - (list (sxml:text l) (sxml:attr (car l) 'href)))) - -(define (athings:latest h athings:sxml) - (cond ((empty? athings:sxml) h) - (else - (let* ((athing (car athings:sxml)) - (id (athing:id athing)) - (link (athing:link athing))) - (athings:latest (hash-set h (string->symbol id) link) - (cdr athings:sxml)))))) - -(define (athings:data-dir) - (let ((dir (build-path (find-system-path 'orig-dir) "data"))) - (unless (directory-exists? dir) (make-directory dir)) - dir)) - -(define (athings:file) - (build-path (athings:data-dir) (slug))) - -(define (athings:hash f) - (cond ((file-exists? f) - (call-with-input-file f (λ (in) (read-json in)))) - (else (make-immutable-hash)))) - -(define (athings:list) - (let ((f (build-path (athings:data-dir) "list"))) - (cond ((file-exists? f) (call-with-input-file f (λ (in) (read-json in)))) - (else '())))) - -(define (athings:index slug) - (let ((f (build-path (athings:data-dir) "list")) - (l (athings:list))) - (unless (member slug l) - (call-with-output-file f (λ (out) (write-json (cons slug l) out)) - #:exists 'truncate)))) - -(define (g) - (let* ((f (athings:file)) - (h (athings:latest (athings:hash f) (athings)))) - (call-with-output-file f (λ (out) (write-json h out)) #:exists 'truncate) - (athings:index (slug)))) - -(g) -- cgit v1.2.3