yppdb.ss
(module yppdb mzscheme
  (require (lib "servlet.ss" "web-server")
           (lib "etc.ss")
           (lib "list.ss")
           (lib "plt-match.ss")
           (lib "struct.ss"))
  (require (planet "with-bindings.ss" ("jaymccarthy" "with-bindings.plt" 1))
           (planet "wtk-list-table.ss" ("jaymccarthy" "wtk.plt" 1))
           (planet "list.ss" ("jaymccarthy" "mmss.plt" 1))
           (planet "maybe.ss" ("jaymccarthy" "mmss.plt" 1))
           (planet "string.ss" ("jaymccarthy" "mmss.plt" 1))
           (planet "url-param.ss" ("jaymccarthy" "url-param.plt" 1)))
  (require "yppdb-db.ss")
  (provide interface-version timeout generate-start
           instance-expiration-handler)
  
  (define interface-version 'v2-transitional)
  (define timeout (* 60 15))
  (define instance-expiration-handler 
    (make-instance-expiration-handler
     (lambda (failed-request)
       (template `((p "Failed to detect restorable URL."))))))
  
  ; Paper list
  (define list-papers/search-term (make-web-cell:local (list "title" "")))
  (bind-url-parameter list-papers/search-term 'search read/string write/string) 
  (define (get-paper-list)
    (apply paper-list/search (web-cell:local-ref list-papers/search-term)))
  
  ; Main template
  (define (template embed/url body)
    `(html (head (title "Your Personal Paper Database")
                 (style ([type "text/css"])
                        "div#banner { text-align: center; }
                         div#header { text-align: center; }
                         div#header ul li {
                         	padding-left: 10px;
                         	padding-right: 10px;
                         	display: inline;
                         }
                         div#search {
                         	text-align: center;
                         	float: right;
                         	width: 20%;
                         }
                         div#filter {
                         	float: right;
                         	clear: right;
                         	width: 24%;
                         }
                         div#body {
                         	float: left;
                         	width: 74%;
                         }
                         div#body a {
                         	text-decoration: none;
                         } 
                         div#body a:hover {
                         	text-decoration: underline;
                         }
                         div#footer {
                         	float: right;
                          	clear: right;
                         	width: 100%;
                         }
                         table#sort-by {
                         	text-align: center;
                         	width: 100%;
                         }
                         a {
                         	color: blue;
                         }
                         a.k-url:visited {
                         	color: blue;
                         }
                         span.unread {
                         	font-style: italic;
                         }"))
           (body 
            (div ([id "banner"])
                 (h2 "Your Personal Paper Database"))
            (div ([id "header"])
                 (div ([id "search"])
                      ,(match (web-cell:local-ref list-papers/search-term)
                         [(list selected-field current-search)
                          `(form ([method "POST"]
                                  [action ,(embed/url
                                            (lambda (request)
                                              (let ([the-bindings (request-bindings request)])
                                                (with-binding the-bindings (field-name value)
                                                              (web-cell:local-mask list-papers/search-term (list field-name value))
                                                              (list-papers)))))])                            
                                 (select ([name "field-name"])
                                         ,@(map
                                            (lambda (f)
                                              `(option ([value ,(car f)]
                                                        ,@(if (string=? (car f) selected-field)
                                                              `([selected "true"])
                                                              empty))
                                                       ,(cadr f)))
                                            `(("author" "Author")
                                              ("title" "Title")
                                              ("year" "Year")
                                              ("notes" "Notes") )))
                                 nbsp
                                 (input ([type "text"] [name "value"] [size "10"] [value ,current-search]))
                                 (br)
                                 (input ([type "submit"] [value "Search"])))]))
                 
                 (ul
                  (li (a ([class "k-url"]
                          [href ,(embed/url
                                  (lambda _
                                    (list-papers)))])
                         "List"))
                  (li (a ([class "k-url"]
                          [href ,(embed/url
                                  (lambda _
                                    (edit-paper empty-paper)
                                    (list-papers)))])
                         "Add"))))
            ,@body
            (div ([id "footer"])
                 (p ([align "right"])
                    "Powered by " (a ([href "http://www.plt-scheme.org/"])
                                     (img ([width "53"] [height "19"] [src "/Defaults/documentation/plt-logo.gif"]))) 
                    (br)
                    (font ([size "2"]) "For more information on PLT Software, please follow the icon link."))))))
  
  ; Sub-pages
  (define list-papers/ui-state (with-table-ui:initial-state 'year))
  (bind-url-parameter list-papers/ui-state 'paper-list string->table-ui-state table-ui-state->string)
  (define (list-papers)
    (send/suspend/dispatch
     (lambda (embed/url)
       (template 
        embed/url
        (list
         (with-table-ui embed/url list-papers/ui-state "paper-list"
                        (list (make-table-column 'title "Title" "Title"
                                                 (lambda (o)
                                                   `(a ([href ,(paper-url o)]) ,(paper-title o)))
                                                 (<=/proj string-ci<=? paper-title))
                              (make-table-column 'author "Author" "Author"
                                                 paper-author
                                                 (<=/proj string-ci<=? paper-author))
                              (make-table-column 'year "Year" "Year"
                                                 (lambda (o)
                                                   (number->string (paper-year o)))
                                                 (<=/proj <= paper-year))
                              (make-table-column 'read "Read" "Read"
                                                 (lambda (o)
                                                   `(a ([class "k-url"]
                                                        [href ,(embed/url (lambda _ 
                                                                            (edit-paper o)
                                                                            (list-papers)))])
                                                       ,(if (paper-read o)
                                                            "*"
                                                            "#")))
                                                 (<=/proj (lambda (a b)
                                                            (and a b))
                                                          paper-read)))
                        (append
                         (list (make-list-filter 'read paper-read "Read")
                               (make-list-filter 'unread (lambda (o) (not (paper-read o))) "Unread"))
                         (map (lambda (category)
                                (make-list-filter category (lambda (o) (member category (paper-categories o)))
                                                  (symbol->string category)))
                              (paper-list-categories)))
                        empty
                        get-paper-list
                        (lambda (the-list-ui)
                          `(div ([id "filter"])
                                (ul (li (a ([class "k-url"]
                                            [href ,(embed/url (list-ui-clear-filters the-list-ui))])
                                           "Clear All Filters")))
                                (ul ,@((list-ui-map-filters the-list-ui)
                                       (lambda (tag filtered? filter)
                                         (let ([link `(a ([class "k-url"]
                                                          [href ,(embed/url filter)])
                                                         ,tag)])
                                           `(li ,(if filtered?
                                                     `(strong ,link)
                                                     link))))))))))))))
  
  (define (edit-paper p)
    (send/suspend/dispatch
     (lambda (embed/url)
       (template 
        embed/url
        `((div ([id "body"])
               (form ([method "POST"]
                      [action ,(embed/url
                                (lambda (request)
                                  (let ([the-bindings (request-bindings request)])
                                    (with-bindings/default-values 
                                     the-bindings 
                                     (read) ((title "") (author "") (year "0") (url "") (categories "()") (notes "")) ()
                                     (let ([new-paper
                                            (paper-list-replace p
                                                                (copy-struct paper p
                                                                             [paper-title title]
                                                                             [paper-author author]
                                                                             [paper-year (string->number year)]
                                                                             [paper-url url]
                                                                             [paper-categories (read/string categories)]
                                                                             [paper-read read]
                                                                             [paper-notes notes]))])
                                       (redirect/get)
                                       new-paper)))))])
                     (table
                      (tr (td "Title:") (td (input ([type "text"] [size "83"] [name "title"] [value ,(paper-title p)]))))
                      (tr (td "Author:") (td (input ([type "text"] [size "83"] [name "author"] [value ,(paper-author p)]))))
                      (tr (td "Year:") (td (input ([type "text"] [name "year"] [value ,(number->string (paper-year p))]))))
                      (tr (td "Categories:") (td (input ([type "text"] 
                                                         [size "83"] 
                                                         [name "categories"]
                                                         [value ,(write/string (paper-categories p))]))))
                      (tr (td "URL:") (td (input ([type "text"] [size "83"] [name "url"] [value ,(paper-url p)]))))
                      (tr (td "Read?") (td (input ([type "checkbox"] [name "read"] 
                                                                     ,@(if (paper-read p)
                                                                           `([checked "true"])
                                                                           `())))))
                      (tr (td ([valign "top"]) "Notes:") (td (textarea ([rows "24"] [cols "80"] [name "notes"]) ,(paper-notes p))))
                      (tr (td ([colspan "2"] [align "right"]) 
                              (input ([type "submit"] [value ,(if (not (eq? empty-paper p))
                                                                  "Save" 
                                                                  "Add")]))))))))))))
  
  (define (generate-start path-to-db)
    (lambda (initial-request)
      (report-errors-to-browser send/back)
      (paper-list-load path-to-db)
      (list-papers))))