;; -*- scheme -*-
;; website entry point

(module wowri mzscheme 

  ;; reusable code is stored here
  (require "../lib/web-util.ss"
           "../lib/sweb.ss"
           "../lib/facade.ss"
           "../lib/dynamic.ss"
           "../lib/rpc.ss"
           (lib "match.ss")
           (lib "servlet.ss" "web-server")
           )
  
  ;; plt servlet interface
  (provide interface-version timeout start)
  (define interface-version 'v1)
  (define timeout +inf.0)


  ;; FORMATTING

  ;; 'db' denotes the content database. it takes a single path
  ;; argument and returns a list of tags if the path element points to
  ;; a dictionary, or the leaf element otherwise.

  (define (pane db paneid)
    `((dl ,@(map
             (lambda (p)
               (let ((name  (db `(name ,p content)))
                     (link  (db `(link ,p content)      ;; external
                                (lambda () (str p)))))  ;; internal  
                 `(dt (a ((href ,link)) ,name) (br) (br))))
             (db `(,paneid index))))))

  (define (body db page)
    (cdr (db `(xhtml ,page content))))
  
  (define (topnav db navid)
    `((big
       ,@(list-join " | "
		    (map
		     (lambda (p)
		       `(a ((href ,(str p)))
			   ,(db `(name ,p content))))
		     (db `(,navid index)))))))

    
  (define (page db p)
    ;; (printf "access: ~a\n" p)
    `(html
      (body ()
       (link ((rel  "stylesheet")
              (href "wowri.css")
              (type "text/css")))
                 
       (div ((id "header"))   (image ((src "/content/logo.png"))))
       (div ((id "profiles")) ,@(topnav db 'profiles))
       (div ((id "left"))     ,@(pane db 'left))
       (div ((id "right"))    ,@(pane db 'right))
       (div ((id "content"))  ,@(body db p))
       )))


  ;; STYLE

  (define (stylesheet db )
    (let* ((linkco `((color "#FF0000") 
		     (background-color "transparent") 
		     (text-decoration none)))
           (panco  `((color "#FF0000") (background "#000000")))
           (texco  `((color "#FFFFFF") (background "#000000")))
           (panel  `(,@panco
                     (width "15%")))
           (abs    `((position absolute)))
           (rel    `((position relative)))
           (mar     (db '(margin meta)))
           
           (margin `((margin-left  ,mar)
                     (margin-right ,mar)))
          )
    
      (css
       `((body      ,@texco (height "100%")
                    (font
                     ,(format
                       "~a georgia, \"Book Antiqua\",  palatino, serif"
                       (db '(font-size meta)))))

         (h1        (font-size ,(db '(h1-font-size meta)))
                    (text-align center))
         (h2        (font-size ,(db '(h2-font-size meta)))
                    (text-align center))

         (a:link    ,@linkco)
         (a:visited ,@linkco)
         (a:active  ,@linkco)
         (a:hover   ,@linkco)
         (ul        (list-style-type square))

         ("#header"   (background-color "#000000") (text-align center))
         ("#left"     ,@panel ,@abs (left  10) (text-align right))
         ("#right"    ,@panel ,@abs (right 10))
         ("#profiles" ,@panco ,@rel (text-align center) (margin-bottom "25px"))
         ("#content"  ,@texco ,@rel ,@margin)

         ))))


  ;; DISPATCH
  
  
  ;; Cache file on remote host using tools/fileserv.ss server.
  ;; FIXME: make this robust to server restarts (re-open connection).
  (define (make-cache host port filename)
    (cached-remote-file-object
     (make-tcp-rpc host port)
     (lambda (bytes)
       (printf "refreshing cache\n")
       (dict->db
        (read-website
         (open-input-bytes bytes))))
     filename))
  
  (define *cache*
    (make-cache "wowri-data" 1717
                "/home/melissa/womenwriters.us.to/wowri.xml"))

  (define (start req)
    (with-errors-to-browser
     send/finish
     (lambda ()
       (let ((path (cddr (req->strings req))))

         ;; format page
         (let ((db (force-dynamic *cache*)))
            (match path
                  (("wowri.css")  (stylesheet db))
                  (("")           (page db 'home))
                  ((p)            (page db (string->symbol p)))
                  ;; (redirect-to (format "~a/" db)))
                  (else
                   (not-found))))))))
              
     
  )