#lang racket

(provide (contract-out
          [render (-> document? void?)]
          [parse (-> (listof string?) document?)]
          [match-link (-> document? integer? (or/c url? #f))]
          [struct document ((items (listof (or/c text? link? pre?))))]))

(require net/url-string)

;; a gemtext document is represented as a list of structs, a struct
;; for each type of item in a document.
(struct document (items))

(struct text (line))
(struct link (url line id))
(struct pre (lines))

;;;
;;; PARSING
;;;

(define (parse-url line link-#)
  (let ([split (string-split (substring line 2))])
    (if (empty? split)
        (text line)
        (link (string->url (car split))
              (if (>= (length split) 2)
                  (string-join (cdr split))
                  (car split))
              link-#))))

(define (parse lines)
  (define (iter document lines state link-id)
    ;; when there are no more lines, we have finished parsing.
    (if (empty? lines)
        ;; consing inherently makes everything backwards
        (reverse document)

        ;; otherwise, we have a state machine to traverse.
        (cond
          ;; turn off preformatted mode
          [(and (symbol=? 'preformatted state)
                (or (empty? (cdr lines))
                    (string-prefix? (car lines) "```")))

           ;; also hard to follow. at this point:
           ;; 1. the car of the document is necessarily a preformatted block
           ;;    and the contents of that block are backwards
           ;; 2. take those contents, reverse them, append them to the
           ;; cdr of the document
           (iter (cons (pre (reverse (pre-lines (car document))))
                       (cdr document))
                 (cdr lines)
                 'normal
                 link-id)]

          ;; add line to most recent preformat block
          [(symbol=? 'preformatted state)
           ;; little bit hard to follow: take the existing
           ;; preformatted blocks content, cons the new line;
           ;; then, cons the new preformatted block to the cdr of
           ;; the document
           (iter (cons (pre (cons (car lines)
                                  (pre-lines (car document))))
                       (cdr document))
                 (cdr lines)
                 'preformatted
                 link-id)]

          ;; rest of this is normal mode

          ;; link lines
          [(string-prefix? (car lines) "=>")
           (let ([parsed (parse-url (car lines) link-id)])
                 (iter (cons parsed document)
                       (cdr lines)
                       'normal
                       (if (link? parsed)
                           (add1 link-id)
                           link-id)))]

          ;; preformatting toggle lines
          [(string-prefix? (car lines) "```")
           ;; add preformatted block to document and toggle mode
           (iter (cons (pre (list)) document)
                 (cdr lines)
                 'preformatted
                 link-id)]

          [else
           (iter (cons (text (car lines))
                       document)
                 (cdr lines)
                 'normal
                 link-id)])))

  (document (iter (list) lines 'normal 1)))

;;;
;;; RENDERING
;;;

;; takes one long string and reflows it within an 80 character wide
;; column
(define (render-paragraph paragraph)
  ;; collects from one list of words into another such that the new
  ;; list does not exceed 80 characters when joined, and returns the
  ;; new list and remainder of the first list
  (define (inner-iter acc rst)
    (let ([line (string-join acc)])
      (if (or (empty? rst)
              (> (string-length line) 80))
          (values acc rst)
          (inner-iter (append acc (list (car rst)))
                      (cdr rst)))))

  ;; collects from a list of words into sublists of words such that
  ;; each sublist is no greater than 80 characters when joined
  (define (outer-iter acc rst)
    (if (empty? rst)
        acc
        (let-values ([(inner-acc inner-rst)
                      (inner-iter (list) rst)])
          (outer-iter (append acc (list inner-acc)) inner-rst))))

  ;; the algorithm implemented here does not work for empty
  ;; paragraphs. thus, they are handled as a special case here.
  (if (non-empty-string? paragraph)
      ;; join each sublist into one string, and display one string per
      ;; line
      (for-each displayln
                (map string-join (outer-iter (list) (string-split paragraph))))
      (newline)))

;; given a document, which is a list of structs, render it out into
;; the current output port exactly as it will be shown to the user
(define (render document)
  (for-each
   (λ (item)
     (cond
       [(text? item)
        (render-paragraph (text-line item))]

       [(pre? item)
        (for-each displayln (pre-lines item))]

       [(link? item)
        (printf "[~a] ~a\n" (link-id item) (link-line item))]))

   (document-items document)))

(define (match-link document id)
  (define (iter next-structure)
    (cond
      [(and (link? (car next-structure))
            (= (link-id (car next-structure)) id))
       (link-url (car next-structure))]

      [(empty? (cdr next-structure))
       #f]

      [else
       (iter (cdr next-structure))]))

  (iter (document-items document)))