slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add a search form

Browse Source
This commit is contained in:
Simon Michael 2009-02-12 11:58:09 +00:00
parent e5f6952286
commit 08a3d43c39
1 changed files with 16 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
HappsCommand.hs
View File

@ -51,24 +51,30 @@ web opts args l = do
killThread tid killThread tid
putStrLn "shutdown complete" putStrLn "shutdown complete"
template = "<div align=center style=width:100%%>" ++ template r = printf (
" <a href=print>ledger</a>" ++ "<div style=float:right>" ++
" | <a href=register>register</a>" ++ "<form action=%s>search:&nbsp;<input name=a value=%s></form>" ++
" | <a href=balance>balance</a>" ++ "</div>" ++
"</div>" ++ "<div align=center style=width:100%%%%>" ++
"<pre>%s</pre>" " <a href=print>ledger</a>" ++
" | <a href=register>register</a>" ++
" | <a href=balance>balance</a>" ++
"</div>" ++
"<pre>%%s</pre>")
(dropWhile (=='/') $ rqUri r)
(fromMaybe "" $ queryValue "a" r)
type Handler = ServerPart Response type Handler = ServerPart Response
handlers :: [Opt] -> [String] -> Ledger -> [Handler] handlers :: [Opt] -> [String] -> Ledger -> [Handler]
handlers opts args l = handlers opts args l =
[ [
dir "print" [withRequest $ \r -> respond $ printreport r] dir "print" [withRequest $ \r -> respond r $ printreport r]
, dir "register" [withRequest $ \r -> respond $ registerreport r] , dir "register" [withRequest $ \r -> respond r $ registerreport r]
, dir "balance" [withRequest $ \r -> respond $ balancereport r] , dir "balance" [withRequest $ \r -> respond r $ balancereport r]
] ]
where where
respond = ok . setContentType "text/html" . toResponse . (printf template :: String -> String) respond r = ok . setContentType "text/html" . toResponse . (printf (template r) :: String -> String)
printreport r = showEntries opts (pats r ++ args) l printreport r = showEntries opts (pats r ++ args) l
registerreport r = showRegisterReport opts (pats r ++ args) l registerreport r = showRegisterReport opts (pats r ++ args) l
balancereport r = showBalanceReport (opts++[SubTotal]) (pats r ++ args) l balancereport r = showBalanceReport (opts++[SubTotal]) (pats r ++ args) l