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

Using urlparams appropriately.

Browse Source
This commit is contained in:
michael 2010-07-06 03:36:08 +00:00
parent 6f555e02af
commit ea5f7979b2
1 changed files with 25 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
Hledger/Cli/Commands/WebYesod.hs
View File

@ -110,10 +110,11 @@ withLatestJournalRender reportfn = do
app <- getYesod app <- getYesod
params <- getParams params <- getParams
t <- liftIO $ getCurrentLocalTime t <- liftIO $ getCurrentLocalTime
let as = params "a" let head' x = if null x then "" else head x
ps = params "p" as = head' $ params "a"
opts = appOpts app ++ [Period $ unwords ps] ps = head' $ params "p"
args = appArgs app ++ as opts = appOpts app ++ [Period ps]
args = appArgs app ++ [as]
fspec = optsToFilterSpec opts args t fspec = optsToFilterSpec opts args t
-- reload journal if changed -- reload journal if changed
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
@ -125,11 +126,13 @@ withLatestJournalRender reportfn = do
req <- getRequest req <- getRequest
msg <- getMessage msg <- getMessage
--return $ RepHtml $ toContent $ renderHamlet id $ template req msg as ps "hledger" s --return $ RepHtml $ toContent $ renderHamlet id $ template req msg as ps "hledger" s
hamletToRepHtml $ template req msg as ps "hledger" s Just here <- getRoute
hamletToRepHtml $ template here req msg as ps "hledger" s
template :: Request -> Maybe (Html ()) -> [String] -> [String] template :: HledgerWebAppRoutes
-> Request -> Maybe (Html ()) -> String -> String
-> String -> String -> Hamlet HledgerWebAppRoutes -> String -> String -> Hamlet HledgerWebAppRoutes
template req msg as ps title content = [$hamlet| template here req msg as ps title content = [$hamlet|
!!! !!!
%html %html
%head %head
@ -144,13 +147,13 @@ template req msg as ps title content = [$hamlet|
%pre $string.content$ %pre $string.content$
|] |]
where m = fromMaybe (string "") msg where m = fromMaybe (string "") msg
navbar' = navbar req as ps navbar' = navbar here req as ps
addform' = addform req as ps addform' = addform req as ps
stylesheet = StyleCss stylesheet = StyleCss
metacontent = "text/html; charset=utf-8" metacontent = "text/html; charset=utf-8"
navbar :: Request -> [String] -> [String] -> Hamlet HledgerWebAppRoutes navbar :: HledgerWebAppRoutes -> Request -> String -> String -> Hamlet HledgerWebAppRoutes
navbar req as ps = [$hamlet| navbar here req as ps = [$hamlet|
#navbar #navbar
%a#hledgerorglink!href=$string.hledgerurl$ hledger.org %a#hledgerorglink!href=$string.hledgerurl$ hledger.org
^navlinks'^ ^navlinks'^
@ -158,9 +161,9 @@ navbar req as ps = [$hamlet|
%a#helplink!href=$string.manualurl$ help %a#helplink!href=$string.manualurl$ help
|] |]
where navlinks' = navlinks req as ps where navlinks' = navlinks req as ps
searchform' = searchform req as ps searchform' = searchform here req as ps
navlinks :: Request -> [String] -> [String] -> Hamlet HledgerWebAppRoutes navlinks :: Request -> String -> String -> Hamlet HledgerWebAppRoutes
navlinks _ as ps = [$hamlet| navlinks _ as ps = [$hamlet|
#navlinks #navlinks
^transactionslink^ | $ ^transactionslink^ | $
@ -168,14 +171,15 @@ navlinks _ as ps = [$hamlet|
^balancelink^ ^balancelink^
|] |]
where where
transactionslink = navlink "transactions" transactionslink = navlink "transactions" TransactionsPage
registerlink = navlink "register" registerlink = navlink "register" RegisterPage
balancelink = navlink "balance" balancelink = navlink "balance" BalancePage
navlink s = [$hamlet|%a.navlink!href=$string.u$ $string.s$|] navlink s dest = [$hamlet|%a.navlink!href=@?u@ $string.s$|]
where u = printf "../%s?a=%s&p=%s" s (intercalate "+" as) (intercalate "+" ps) -- FIXME use URL params instead where u = (dest, [("a", as), ("p", ps)])
searchform :: Request -> [String] -> [String] -> Hamlet HledgerWebAppRoutes searchform :: HledgerWebAppRoutes
searchform req as ps = [$hamlet| -> Request -> String -> String -> Hamlet HledgerWebAppRoutes
searchform here req a p = [$hamlet|
%form#searchform!action=$string.action$ %form#searchform!action=$string.action$
search for: $ search for: $
%input!name=a!size=20!value=$string.a$ %input!name=a!size=20!value=$string.a$
@ -188,20 +192,17 @@ searchform req as ps = [$hamlet|
|] |]
where where
action="" action=""
a = intercalate "+" as
p = intercalate "+" ps
ahelp = helplink "filter-patterns" ahelp = helplink "filter-patterns"
phelp = helplink "period-expressions" phelp = helplink "period-expressions"
resetlink resetlink
| null a && null p = [$hamlet||] | null a && null p = [$hamlet||]
| otherwise = [$hamlet|%span#resetlink $ | otherwise = [$hamlet|%span#resetlink $
%a!href=$string.u$ reset|] %a!href=@here@ reset|]
where u = B.unpack $ Network.Wai.pathInfo $ waiRequest req -- FIXME I'd be worried about this line
helplink topic = [$hamlet|%a!href=$string.u$ ?|] helplink topic = [$hamlet|%a!href=$string.u$ ?|]
where u = manualurl ++ if null topic then "" else '#':topic where u = manualurl ++ if null topic then "" else '#':topic
addform :: Request -> [String] -> [String] -> Hamlet HledgerWebAppRoutes addform :: Request -> String -> String -> Hamlet HledgerWebAppRoutes
addform _ _ _ = [$hamlet| addform _ _ _ = [$hamlet|
%form#addform!action=$string.action$!method=POST %form#addform!action=$string.action$!method=POST
%table!border=0 %table!border=0