#!/bin/sh
#|
if [ -x "$PLTHOME/bin/mzscheme" ]; then
  exec "$PLTHOME/bin/mzscheme" -qgr "$0" "$@"
else
  exec "mzscheme" -qgr "$0" "$@"
fi
|#

(require (lib "etc.ss") (lib "dirs.ss" "setup"))
(current-directory (this-expression-source-directory))

; for john?

;; This list determines the order of libraries in the index file:
(define libraries*
  '(#"A Functional Drawing Library (HtDC)"
    #"An Imperative Drawing Library (HtDC)"
    #"A Geometry Library (HtDC)"
    #"A Colors Library (HtDC)"
    ))

(define dest-dir (build-path (find-doc-dir) "teachpack-htdc"))
(printf "writing docs to ~s\n" (path->string dest-dir))

(require (lib "list.ss"))

(define thtml-files
  (filter (lambda (x) (regexp-match #rx#"[.]thtml$" (path->bytes x)))
          (directory-list)))

(unless (directory-exists? dest-dir) (make-directory dest-dir))

;; Get list of (list name file-basename) for library names
;; (assuming that foo.thtml is always the documentation for ../foo.ss)
(define lib-names
  (let ([rx (regexp (string-append "\\(define +LIBNAME +\"(.*?)\"\\)"))])
    (map (lambda (s)
           (let* ([m (or (regexp-match rx (open-input-file s))
                         (error 'mkdocs "LIBNAME+FILENAME not found in ~s" s))]
                  [basename (regexp-replace #rx#"[.]thtml$" (path->bytes s) #"")]
                  [ss-name (bytes->path (bytes-append basename #".ss"))])
             (unless (file-exists? (build-path 'up ss-name))
               (error 'mkdocs "Found ~s but no ~s teachpack found" s ss-name))
             (list (cadr m) (bytes->path basename))))
         (filter (lambda (f) (not (equal? (path->bytes f) #"index.thtml")))
                 thtml-files))))
;; Check that `lib-names' exactly match `libraires':
(let ([file-libs (map car lib-names)])
  (define (test x) (and (pair? x) x))
  (cond
   [(test (remove* libraries* lib-names (lambda (x y) (equal? x (car y))))) =>
    (lambda (libs)
      (error 'mkdocs "found libraries unlisted in mkdocs: ~s" libs))]
   [(test (remove* file-libs libraries*)) =>
    (lambda (libs)
      (error 'mkdocs "non-existent libraries listed in mkdocs: ~s" libs))])
  (let loop ([libs lib-names])
    (cond [(null? libs) 'ok]
          [(assoc (caar libs) (cdr libs)) =>
           (lambda (m)
             (error 'mkdocs "library ~s has two .thtml files: ~s and ~s"
                    (caar libs) (cdar libs) (cdr m)))]
          [else (loop (cdr libs))])))

;; Just like lib-names, but ordered according to libraries*
(define libraries (map (lambda (l) (assoc l lib-names)) libraries*))

(define LIBLINKS
  (map (lambda (lib)
         (format "<li><a href=~s>~a</a></li>\n"
                 (string-append (bytes->string/utf-8 (path->bytes (cadr lib))) ".html")
                 (car lib)
                 #;(string-append (bytes->string/utf-8 (path->bytes (cadr lib))) ".ss")))
       libraries))

;; Stuff for the preprocessed files
(require (lib "mzpp.ss" "preprocessor"))
(beg-mark "{") (end-mark "}")
(define index-entries '())
(define FILENAME #f)
(define LIBNAME  #f)
(define HTMLNAME #f)
(define-syntax idx
  (syntax-rules ()
    [(_ x)
     (begin (set! index-entries (cons (list FILENAME LIBNAME HTMLNAME `x)
                                      index-entries))
            (list "<a name=\""`x"\">"`x"</a>"))]))

;; Make html files
(for-each (lambda (thtml)
            (define html (bytes->path (regexp-replace #rx#"[.]thtml" (path->bytes thtml) #".html")))
            (printf "Processing ~a...\n" thtml)
            (set! HTMLNAME html)
            #;(set! FILENAME (bytes->path (regexp-replace #rx#"[.]thtml" (path->bytes thtml) #".ss")))
            (with-output-to-file (build-path dest-dir html)
              (lambda () (preprocess thtml))
              'replace))
          thtml-files)

;; Make hdindex file:
(let ([ifile (build-path dest-dir "hdindex")])
  (printf "Writing hdindex...\n")
  (with-output-to-file ifile
    (lambda ()
      (define (writeln x) (printf "~s\n" x))
      (define (do-entry filename libname html entry)
        (let ([entry (format "~a" entry)]
              [title (format "~a teachpack" libname)])
          (writeln `(,entry ,(bytes->string/utf-8 (path->bytes html)) ,entry ,title))))
      (printf "(\n")
      (let ([title "Teachpacks for \"How to Design Classes\""])
        (writeln `(,title "index.html" "HtDC" ,title)))
      (for-each (lambda (x) (apply do-entry x)) (reverse index-entries))
      (printf ")\n"))
    'truncate))