(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."))))))
(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)))
(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."))))))
(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))))
![[logo]](/logo.png){kind=logo}