diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index a93c7e274..931c1bf01 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -5,7 +5,7 @@ A web-based UI. module Hledger.Cli.Commands.Web where -import Control.Concurrent -- (forkIO) +import Control.Concurrent (forkIO, threadDelay) import Data.Either import Network.Wai.Handler.SimpleServer (run) import System.FilePath (()) @@ -73,21 +73,16 @@ instance Yesod HledgerWebApp where approot = appRoot mkYesod "HledgerWebApp" [$parseRoutes| / IndexPage GET +/style.css StyleCss GET /transactions TransactionsPage GET POST /register RegisterPage GET /balance BalancePage GET -/style.css StyleCss GET -/params ParamsDebug GET |] -getParamsDebug = do - r <- getRequest - return $ RepHtml $ toContent $ show $ reqGetParams r - getIndexPage :: Handler HledgerWebApp () getIndexPage = redirect RedirectTemporary TransactionsPage -getStyleCss :: Handler HledgerWebApp RepPlain +getStyleCss :: Handler HledgerWebApp () getStyleCss = do app <- getYesod let dir = appWebdir app @@ -110,10 +105,10 @@ withLatestJournalRender reportfn = do params <- getParams t <- liftIO $ getCurrentLocalTime let head' x = if null x then "" else head x - as = head' $ params "a" - ps = head' $ params "p" - opts = appOpts app ++ [Period ps] - args = appArgs app ++ [as] + a = head' $ params "a" + p = head' $ params "p" + opts = appOpts app ++ [Period p] + args = appArgs app ++ [a] fspec = optsToFilterSpec opts args t -- reload journal if changed j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" @@ -122,15 +117,13 @@ withLatestJournalRender reportfn = do -- run the specified report using this request's params let s = reportfn opts fspec j' -- render the standard template - req <- getRequest msg <- getMessage Just here <- getRoute - hamletToRepHtml $ template here req msg as ps "hledger" s + hamletToRepHtml $ template here msg a p "hledger" s -template :: HledgerWebAppRoutes - -> Request -> Maybe (Html ()) -> String -> String +template :: HledgerWebAppRoutes -> Maybe (Html ()) -> String -> String -> String -> String -> Hamlet HledgerWebAppRoutes -template here req msg as ps title content = [$hamlet| +template here msg a p title content = [$hamlet| !!! %html %head @@ -140,29 +133,28 @@ template here req msg as ps title content = [$hamlet| %body ^navbar'^ #messages $m$ - ^addform'^ + ^addform^ #content %pre $string.content$ |] where m = fromMaybe (string "") msg - navbar' = navbar here req as ps - addform' = addform req as ps + navbar' = navbar here a p stylesheet = StyleCss metacontent = "text/html; charset=utf-8" -navbar :: HledgerWebAppRoutes -> Request -> String -> String -> Hamlet HledgerWebAppRoutes -navbar here req as ps = [$hamlet| +navbar :: HledgerWebAppRoutes -> String -> String -> Hamlet HledgerWebAppRoutes +navbar here a p = [$hamlet| #navbar %a#hledgerorglink!href=$string.hledgerurl$ hledger.org ^navlinks'^ ^searchform'^ %a#helplink!href=$string.manualurl$ help |] - where navlinks' = navlinks req as ps - searchform' = searchform here as ps + where navlinks' = navlinks a p + searchform' = searchform here a p -navlinks :: Request -> String -> String -> Hamlet HledgerWebAppRoutes -navlinks _ as ps = [$hamlet| +navlinks :: String -> String -> Hamlet HledgerWebAppRoutes +navlinks a p = [$hamlet| #navlinks ^transactionslink^ | $ ^registerlink^ | $ @@ -173,7 +165,7 @@ navlinks _ as ps = [$hamlet| registerlink = navlink "register" RegisterPage balancelink = navlink "balance" BalancePage navlink s dest = [$hamlet|%a.navlink!href=@?u@ $string.s$|] - where u = (dest, [("a", as), ("p", ps)]) + where u = (dest, [("a", a), ("p", p)]) searchform :: HledgerWebAppRoutes -> String -> String -> Hamlet HledgerWebAppRoutes searchform here a p = [$hamlet| @@ -199,8 +191,8 @@ searchform here a p = [$hamlet| helplink topic = [$hamlet|%a!href=$string.u$ ?|] where u = manualurl ++ if null topic then "" else '#':topic -addform :: Request -> String -> String -> Hamlet HledgerWebAppRoutes -addform _ _ _ = [$hamlet| +addform :: Hamlet HledgerWebAppRoutes +addform = [$hamlet| %form#addform!action=$string.action$!method=POST %table!border=0 %tr