#!/usr/bin/guile \
-q -e main -s
!#

(add-to-load-path (dirname (current-filename)))
(add-to-load-path (string-append (dirname (current-filename)) "/monad/"))
(add-to-load-path "/home/hugo/lib/guile")

(add-to-load-path "/home/hugo/code/calparse")  ; For (util), move that to a library

(setenv "LD_LIBRARY_PATH" (dirname (current-filename)))

(use-modules #; (sxml simple)
             ;; (sxml match)

             (srfi srfi-1)
             (srfi srfi-26)
             (srfi srfi-43)             ; Vector iteration

             ;; (ice-9 rdelim)
             (ice-9 regex)
             (ice-9 popen)

             (macros arrow)
             (util)

             (control monad)
             (control monad state)
             (data stack)

             (fmt-stack)
             (html)
             (json))

(define-macro (regex-case str . cases)
  `(cond
    ,@(map (lambda (case)
                (let ((pattern (car case))
                      (rest (cdr case)))
                  (if (eq? pattern 'else)
                      `(else ,@rest)
                      `((string-match ,pattern ,str) ,@rest))))
           cases)))

(define (substr-1 match)
  (match:substring match 1))

(define (class-handlers class)
  (fold (lambda (cl obj)
          (regex-case
           cl
           ("^DH$"           (set-style obj 'bold))
           ("^bg([BYC])$" => (compose (cut set-bg obj <>) string->symbol substr-1))
           ("^([BYC])$"   => (compose (cut set-fg obj <>) string->symbol substr-1))
           (else obj)))
        (empty-fmt-frame)
        (string-split class #\space)))

;;; TODO every push and pop should emit current ANSI-escape after it has run.

(use-modules (ice-9 match))

;;; TODO Every clause should return a string, in the state context of a state.

;;                  +-- State storage, "mutable"
;;                  |          +- Return value, static
;;                  V          V
;; sxml → State <fmt-stack> <string>
(define (fmt-tag tag)
  (match tag

    [('a _ body ...)
     (do fmt-before <- (get-attr)
         (push (make-fmt-frame 'underline 'B #f))
         fmt-with <- (get-attr)
         (pop)
         (return-state
          (string-append fmt-with (car body) fmt-before)))]

    [((or 'h1 'span) attrs nodes ...)
     (do let class = (hashq-ref attrs 'class)
         fmt-before <- (get-attr)
         (push (class-handlers class))
         fmt-with <- (get-attr)
         ret <- (fmap (cut string-append fmt-with <> fmt-before)
                      (fmap string-concatenate (sequence (map fmt-tag nodes))))
         (pop)
         (return-state ret))]

    ;; Default rule, since the above case requires a class list
    [(tag _ node nodes ...)
     (fmap string-concatenate (sequence (map fmt-tag (cons node nodes))))]

    ;; Just ignore tags without children
    [(tag _) (return-state "")]

    [(? string? str) (return-state str)]

    [default (return-state (format #f "[|~a|]" default))]))

(define (parse-html-string str)
  (let ((fname (tmpnam)))
    (with-output-to-file fname
      (lambda () (display str)))
    (parse-html fname)))

(define (text-for-num j int)
  (let* ((table (vector-ref j (- int 100)))
         (arr (hashq-ref table 'content))
         (text (array-ref arr 0)))
    text))

(define (max-date vect)
  (vector-fold (lambda (i accum el) (max accum (hashq-ref el 'date_updated_unix)))
               0 vect))

(define (main args)
  (let* (((self filename pagestr) args)
         (page (string->number pagestr)))

    (let ((last-updated (call-with-input-file ".last-updated" read)))
     (when (> (- (current-time) last-updated) 10000)
       (display "Downloading new data, please stand by...")
       (system* "curl"
                "-s" "http://api.texttv.nu/api/get/100-999?app=hugonikanor"
                "-o" filename)

       (let* ((json (get-json filename))
              (update (max-date json)))

         (with-output-to-file ".last-updated" (lambda () (display update)))

         (vector-for-each
          (lambda (i el)
            (let ((num (hashq-ref el 'num))
                  (text (vector-ref (hashq-ref el 'content) 0)))
              (with-output-to-file (format #f "cache/~a.ansi" num)
                (lambda () (-> (parse-html-string text)
                          fmt-tag
                          (run-state (list (make-fmt-frame "" "" "")))
                          car display)))))
          json)))

     (let ((p1 (format #f "cache/~a.ansi" page))
           (p2 (format #f "cache/~a.ansi" (1+ page))))
       (system* "paste" p1 p2))
     )))