#lang scheme/base
;; This builds a cross-referenced graph from a ramblings file.

;; FIXME: put this in an object.


(require "tools.ss"
         "parse-ramblings-fast.ss"
         "ramblings-registry.ss"
         (planet zwizwa/lib/x/graph))


(provide nodelist->toc ramblings-file->nodelist)


(define all-words (make-hash))
(define (register! w [n #f])
  (hash-set! all-words w #t))

(define (ramblings-file->nodelist name filename)
  (parameterize
      ((register-word! register!))
    (let ((nl (ramblings-file->nodes filename)))
      (printf "~a ~a articles\n" filename (length nl))
      ;; Note that all the articles need to be forced to collect words.
      ;; (printf "~a\n" (for/list (((k v) all-words)) k))
      (for ((node nl))
        (n! node 'Section name))
      nl)))

(define (node->ID n) (n@ n 'ID))

(define (nodelist->toc in-nodes)

  ;; Build table of contents. (*) Reverse order (blog style) TODO:
  ;; sort by Index.  (**) Copy to make this fn transparent.
  (define toc
    (let ((nodes (map node-copy in-nodes))) ;; (**)
      (n! (car nodes) 'ID 'contents)
      (let ((toc (list->toc
                  (cons (car nodes) (reverse (cdr nodes))) ;; (*)
                  node->ID)))
        (for ((n nodes))
          (n! n 'toc
              toc
              ;; (lambda (n) (n@ toc n))           ;; Store it as a finite function
              ))
        toc)))

  ;; Create the contents page.
  (n! (toc-ref toc 'contents)
      'xhtml
      (append (n@ (toc-ref toc 'contents) 'xhtml)
              (build-index 
               (cdr (toc->list toc)))))
  toc)

(define (build-index lst)
  (let* ((last-trunc-index "")
         (articles
          (map
           (lambda (n)
             (let* ((Index (symbol->string (n@ n 'Index)))
                    (ID    (symbol->string (n@ n 'ID)))
                    (e (n@ n 'Entry "<untitled>"))
                    (trunc-index
                     (with-handlers ((void void))
                       (substring Index 0 8))))
               `(,(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))))
           lst)))
    (apply append articles)))