#lang scheme/base

;; Simple templating frontend for http pages.

(provide (all-defined-out))
(require xml
         html
         scheme/pretty
         scheme/control
         web-server/managers/none
         web-server/dispatch
         
         web-server/servlet
         web-server/servlet-env
         
         mzlib/pregexp
         (planet zwizwa/lib/x/xml-tools)
         (planet zwizwa/lib/x/seq-tools)
         (planet zwizwa/lib/x/dynamic)
         )

(provide interface-version start manager)


(define interface-version 'v2)
(define manager
  (create-none-manager
   (lambda (req)
     `(html (head (title "No Continuations Here!"))
            (body (h1 "No Continuations Here!"))))))



;; HTML handling
;; We work with "element" as the base data unit.
(define (file->element filename)
  (cadr (with-input-from-file filename read-html-as-xml)))


(define (cached-file compile file)
  (cached-file-object
   (compose compile
            (lambda (f) (printf "l: ~a\n" f) f))
   file))


;; We keep track of all links.
(define *links* (make-hash))
(define (register-link! url section file el)
  ;; (printf "...... ~a/~a ~a\n" section file url)
  (hash-set! *links* url (list section file el)))

(define (report-links)
  `(xhtml ()
     (body ()
       ,@(hash-map
          *links*
          (lambda (url s/f/el)
            (apply (lambda (s f el)
                     `(div ,(format "~a/~a " s f) (a ((href ,url)) ,url) (br)))
                   s/f/el))))))
 

(define (gather-links! section file el)
  (element/attribute-for-each
   (lambda (ename aname val)
     (when
         (or (and (eq? ename 'a)   (eq? aname 'href))
             (and (eq? ename 'img) (eq? aname 'src)))
       (register-link! val section file el)))
   el)
  el)

   
(define div-content? (element-div-id? "content"))

;; Create a section (name template content-hash)

(define (sections ss)
  (make-immutable-hash
   (for/list ((s ss))
     (let ((file->content
            (lambda (filename)
              (gather-links! s filename
               (find-element div-content?
                             (file->element filename))))))
       (list s
             (cached-file
              (lambda (filename)
                (find-hole div-content?
                           (file->element filename)))
              (path->complete-path (build-path s "template.html")))
             (let ((filenames
                    (filter (lambda (x)
                              (and (not (equal? x "template.html"))
                                   (pregexp-match "\\.html$" x)))
                            (map path->string (directory-list s)))))
               (make-immutable-hash
                (begin
                  ;; (printf "~a:\n" s)
                  (for/list ((f (in-list filenames)))
                    ;; (printf "  ~a\n" f)
                    (cons f (cached-file
                             file->content
                             (path->complete-path (build-path s f))
                             )))))))))))

;; Data store
(define *sections* #f)

(define (assemble section item . params)
  (define (not-found)
    (abort `(html ()
              (body ()
                ,(format "File not found : ~a/~a." section item)))))
  (prompt
   (xml->xexpr
    (apply (lambda (template content)
             ((force-dynamic template)
              (force-dynamic (hash-ref content item not-found))))
           (hash-ref *sections* section not-found)))))

(define (start request)
  (let* ((plst (cdr (map path/param-path (url-path (request-uri request))))))
    (printf "r: ~a\n" (path->string (apply build-path plst)))
    (if (equal? plst '("admin" "links"))
        (report-links)
        (apply assemble plst))))


(define (reload-db!)
  (set! *sections* (sections '("dotp" "tlocd"))))

(current-directory "/home/tom/dotp/")
(reload-db!)


;; (define (start-server [port 8282]
;;                       [ss '("dotp" "tlocd")]) ;; FIXME: from */template.html
;;   (set! *sections* (sections ss))
;;   (printf "Starting webserver on port ~a\n" port)
;;   (serve/servlet start
;;                  #:listen-ip "0.0.0.0"
;;                  #:port port
;;                  #:command-line? #t
;;                  #:server-root-path "."
;;                  #:extra-files-paths '(".")
;;                  #:servlet-path "/"
;;                  #:servlet-regexp
;;                  (regexp
;;                   (apply string-append
;;                          (cdr (apply append 
;;                                      (for/list ((s (cons "admin" ss)))
;;                                                (list "|" (format "^/~a/" s)))))))))

;; (define (debug)
;;   (thread (lambda () (start-server 8383))))