eww.scm (4122B)

      1 (define-module (home jaynw eww)
      2   #:use-module (guix gexp)
      3   #:export (eww-saint-cards))
      4 
      5 ;; This is a guile script that generates "prayer cards" that correspond to the saints
      6 ;; of the day. This is done by scraping the OCA website and producing valid yuck
      7 ;; syntax to be used with a `literal` widget in eww.
      8 
      9 ;; TODO: Batch process icons
     10 ;; TODO: Write better sxml code
     11 
     12 (define eww-saint-cards
     13   (program-file "eww-saint-cards"
     14                 #~(begin
     15                    (use-modules (ice-9 textual-ports)
     16                                 (ice-9 popen)
     17                                 (ice-9 rdelim)
     18                                 (srfi srfi-9)
     19                                 (sxml xpath)
     20                                 (htmlprag))
     21                    
     22                    ;; Used to help make collection clearer
     23                    (define-record-type saint
     24                      (make-saint name image-url)
     25                      saint?
     26                      (name saint-name)
     27                      (image-url saint-image-url))
     28                    
     29                    ;; Download content from a url and return the file path to it
     30                    (define (curl-tmp-file url)
     31                      (let* ((output (open-pipe* OPEN_READ "mktemp"))
     32                             (file (read-line output 'trim)))
     33                        (close-port output)
     34                        (system* "curl" "-s" url "-o" file)
     35                        file))
     36                    
     37                    ;; Return the saint name from an article
     38                    (define (extract-name article)
     39                      (car
     40                       ((node-join
     41                         (select-kids (node-typeof? 'h2))
     42                         (select-kids (node-typeof? '*text*)))
     43                        article)))
     44                    
     45                    ;; Return the icon url for an article or #f if there is none
     46                    (define (extract-image-url article)
     47                      (let ((url ((node-join
     48                                   (node-closure (node-typeof? 'img))
     49                                   (select-kids (node-typeof? '@))
     50                                   (select-kids (node-typeof? 'src))
     51                                   (select-kids (node-typeof? '*text*)))
     52                                  article)))
     53                        (if (null? url)
     54                            #f
     55                            (car url))))
     56                    
     57                    ;; Extract articles and a saint record from each
     58                    (define (extract-saints sxml)
     59                      (map-union
     60                       (lambda (article)
     61                         (make-saint (string-trim-right (extract-name article))
     62                                     (extract-image-url article)))
     63                       ((node-closure (node-typeof? 'article)) sxml)))
     64                    
     65                    ;; Fetch html, translate it to sxml and iterate over the extracted
     66                    ;; articles, producing yuck syntax
     67                    (display "(box ")
     68                    (let* ((output (open-pipe*
     69                                     OPEN_READ
     70                                     "curl" "-s"
     71                                     "https://www.oca.org/saints/lives"))
     72                           (file (get-string-all output))
     73                           (sxml-file (html->sxml file #:strict? #t)))
     74                      (close-port output)
     75                      (for-each
     76                       (lambda (saint)
     77                           (display "(box :class \"card\" ")
     78                           (let ((url (saint-image-url saint)))
     79                             (if url
     80                               (format #t "(image :tooltip \"~a\" :path \"~a\") "
     81                                       (saint-name saint)
     82                                       (curl-tmp-file url))
     83                               (format #t "(label :justify \"center\" :wrap true :text \"~a\")"
     84                                          (saint-name saint))))
     85                           (display ") "))
     86                       (extract-saints sxml-file)))
     87                    (display ")"))))