#lang scheme/base
(provide parse-ramblings)
(require
 scheme/dict
 "style.ss"
 "entry.ss")

(define (false . _) #f)


;; Pure functions
(define (parse-ramblings file section)
  (let*
      ;; Parse the file into a list of articles.
      ((raw-articles (map parse-article (file->entries file)))

       ;; Build list of article dictionaries with formatted
       ;; contents node.
       (article-dicts
        (let ((header   (car raw-articles))
              (articles (cdr raw-articles)))
          (cons (format-index header articles) articles)))
       
       ;; Bundle into ID-indexed dictionary + add meta tags.
       (sec  (cons 'Section section))
       (ids  (for/list ((ad article-dicts)) (dict-ref ad 'ID)))
       (ids- (cdr (append ids (list (car ids)))))
       (ids+ (cons (car (reverse ids)) ids))
       (dict (for/list ((ad article-dicts)
                        (id  ids)
                        (id+ ids+)
                        (id- ids-))
               ;; (printf "~a ~a ~a\n" id id+ id-)
               (cons id
                     `((ID+ . ,id+)
                       (ID- . ,id-)
                       ,sec
                       ,@ad)))))
    dict))
  

(define (parse-article lines)
  (let-values (((d lines) (article->dict+lines lines)))
    (let ((->sym/false (lambda (x)
                         (cond
                          ((not x) #f)
                          ((symbol? x) x)
                          ((string? x) (string->symbol x))
                          (else #f))))
          
          (ref (lambda (dict key) (dict-ref dict key false)))
          (set (lambda (dict key value) (dict-set dict key value))))
      (let* ((d (set d 'ID
                     ;; Posts are identified by an explicitly
                     ;; specified ID, an MD5 hash of the data it is
                     ;; associated to, or the Index derived from the
                     ;; date.  Note that these IDs should be
                     ;; specific enough to be googlable.
                     (->sym/false (or (ref d 'ID)
                                      (ref d 'MD5)
                                      (ref d 'Index)))))
             (d (set d 'Lines lines)))
        d))))


(define (format-index header raw-articles)
  (let-values (((index-info articles)
                (make-index-info (foldl cons '() raw-articles))))
       
    ;; Create contents node.
    `((ID       . contents)
      (IndexIDs . ,index-info)
      (xhtml    ,
       (list
        (let ((lines (dict-ref header 'Lines)))
          (with-handlers
              ;; Default is sweb format.
              ((void (lambda _ (lines->xhtml lines))))
            ;; But try raw XHTML first.
            (xhtml-lines->xexpr lines)
            ;; (lines->xhtml lines)
            ))
        `(pre () ,@articles))))))


         


                      

(define-syntax-rule (push! stack val)
  (set! stack (cons val stack)))

(define (make-index-info article-lst)
  (let* ((index-info '())
         (last-trunc-index "")
         (articles
          (map
           (lambda (n)
             (let* ((index (dict-ref n 'Index))
                    (id    (dict-ref n 'ID))
                    (Index (symbol->string index))
                    (ID    (symbol->string id))
                    (e (dict-ref n 'Entry "<untitled>"))
                    (trunc-index
                     (with-handlers ((void void))
                       (substring Index 0 8))))
               (push! index-info
                      (list index id e))
               `(,(if (equal? trunc-index last-trunc-index)
                      '"         "
                      (begin
                        (set! last-trunc-index trunc-index)
                        (format "~a " trunc-index)))
                 (a ((name ,ID)))
                 (a ((href ,ID)) ,e) ;; " " ,d
                 (br))))
           article-lst)))
    (values index-info
            (apply append articles))))