#!/usr/bin/env racket
#lang racket

(require html xml "ansi-color.rkt" "aoc-lib.rkt")

;; finds a given element of an xexpr
(define (find-element el doc)
  (match doc
    [(list (== el) _ ...) doc]
    [(list tag attrs children ...)
     (ormap (curry find-element el) children)]
    [_ #f]))

(struct style-ast [fg bg fs children] #:transparent)
;; convert xexpr tree to an ast with lower-level styling
(define (xexpr->style-ast doc)
  (match doc
    [(? string?) (style-ast #f #f #f doc)]
    [(list 'script _ ...) #f]
    [(list-no-order 'p (list 'span (list-no-order '(class "share")) _ ...) _ ...) #f]
    [(list 'li _ children ...)
     (define out-children (filter identity (map xexpr->style-ast children)))
     (style-ast #f #f #f (cons (style-ast #f #f #f "- ") out-children))]
    [(list tag attrs children ...)
     (define-values [fg bg fs]
       (match* (tag attrs)
         [('main _) (values #f #f #f)]
         [('article _) (values #f #f #f)]
         [('p (list-no-order '(class "day-success") _ ...)) (values 'yellow #f 'bold)]
         [('p _) (values #f #f #f)]
         [('pre _) (values #f #f #f)]
         [('h2 _) (values #f #f 'bold)]
         [('ul _) (values #f #f #f)]
         [('a _) (values 'green #f #f)]
         [('code _) (values 'white 234 #f)]
         [('span _) (values #f #f #f)]
         [('em (list-no-order '(class "star") _ ...)) (values 'yellow #f 'bold)]
         [('em _) (values #f #f 'bold)]
         [(_ _)
          (printf "warning: unhandled ~a ~a\n" tag attrs)
          (#f #f #f)]))
     (define inner-children (filter identity (map xexpr->style-ast children)))
     (define new-children
       (if ((or/c 'h2 'pre 'p) tag)
         (let ([nls (list (style-ast #f #f #f "\n") (style-ast #f #f #f "\n"))])
           (append nls inner-children nls))
         inner-children))
     (style-ast fg bg fs new-children)]))


(define (output-style-ast ast)
  (define num-newlines (make-parameter #f))

  (define (helper ast [prev-bg ""] [prev-fg ""] [prev-fs ""])
    (match-define (style-ast fg bg fs children) ast)
    (when bg (background-color bg))
    (when fg (foreground-color fg))
    (when fs (font-style fs))
    (match children
      ["\n"
       (unless (or (false? (num-newlines)) (>= (num-newlines) 2))
         (num-newlines (add1 (num-newlines)))
         (display "\n"))]
      [(? string? str)
       (num-newlines 0)
       (if (string-contains? str "\n")
         (for ([i (in-naturals)] [line (in-list (string-split (string-trim str "\n") "\n"))])
           (color-display (format (if (zero? i) "~a~a" "\n~a~a") erase-line line)))
         (color-display str))]
      [_ (map (lambda (item) (helper item (or bg prev-bg) (or fg prev-fg) (or fs prev-fs)))
              children)])
    (when prev-bg (background-color prev-bg))
    (when prev-fg (foreground-color prev-fg))
    (when prev-fs (font-style prev-fs)))

  (num-newlines #f)
  (helper ast))

(command-line
  #:program "get-challenge"
  #:args (day)
  (define in (aoc-fetch-challenge (getenv "AOC_YEAR") day (getenv "AOC_SESSION")))
  (use-html-spec #f)
  (define doc-xmls (read-html-as-xml in))
  (close-input-port in)
  (define doc `(top-element ,@(map xml->xexpr doc-xmls)))

  (define main (find-element 'main doc))
  (define ast (xexpr->style-ast main))
  ; (pretty-write ast)
  (output-style-ast ast))