diff --git a/Hledger/Cli/Commands/WebYesod.hs b/Hledger/Cli/Commands/WebYesod.hs index 6da0ffc4a..187a882ca 100644 --- a/Hledger/Cli/Commands/WebYesod.hs +++ b/Hledger/Cli/Commands/WebYesod.hs @@ -88,6 +88,14 @@ getParamsDebug = do getIndexPage :: Handler HledgerWebApp () getIndexPage = redirect RedirectTemporary TransactionsPage +getStyleCss :: Handler HledgerWebApp RepPlain +getStyleCss = do + app <- getYesod + let dir = appWebdir app + s <- liftIO $ readFile $ dir "style.css" + header "Content-Type" "text/css" + return $ RepPlain $ toContent s + getTransactionsPage :: Handler HledgerWebApp RepHtml getTransactionsPage = withLatestJournalRender (const showTransactions) @@ -98,51 +106,44 @@ getBalancePage :: Handler HledgerWebApp RepHtml getBalancePage = withLatestJournalRender showBalanceReport withLatestJournalRender :: ([Opt] -> FilterSpec -> Journal -> String) -> Handler HledgerWebApp RepHtml -withLatestJournalRender f = do +withLatestJournalRender reportfn = do app <- getYesod - req <- getRequest params <- getParams - msg <- getMessage t <- liftIO $ getCurrentLocalTime - -- today <- liftIO $ liftM showDate $ getCurrentDay let as = params "a" ps = params "p" opts = appOpts app ++ [Period $ unwords ps] args = appArgs app ++ as - fs = optsToFilterSpec opts args t - -- date = fromMaybe (decodeString today) $ getParam "date" - -- desc = fromMaybe "" $ getParam "desc" - -- acct = fromMaybe "" $ getParam "acctvar" - -- amt = fromMaybe "" $ getParam "amtvar" + fspec = optsToFilterSpec opts args t + -- reload journal if changed j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" (changed, j') <- liftIO $ journalReloadIfChanged opts j when changed $ liftIO $ putValue "hledger" "journal" j' - let content = f opts fs j' - return $ RepHtml $ toContent $ renderHamlet id $ template req msg as ps "hledger" content - -- hamletToRepHtml $ template "" s + -- run the specified report using this request's params + let s = reportfn opts fspec j' + -- render the standard template + req <- getRequest + msg <- getMessage + return $ RepHtml $ toContent $ renderHamlet id $ template req msg as ps "hledger" s + -- hamletToRepHtml $ template req msg as ps "hledger" s +-- template :: Request -> Maybe (Html ()) -> [String] -> [String] -> String -> String -> Hamlet (Routes HledgerWebApp) +-- Couldn't match expected type `Routes HledgerWebApp' +-- against inferred type `[Char]' -getStyleCss :: Handler HledgerWebApp RepPlain -getStyleCss = do - app <- getYesod - let dir = appWebdir app - s <- liftIO $ readFile $ dir "style.css" - header "Content-Type" "text/css" - return $ RepPlain $ toContent s - -template :: Request -> Maybe (Html ()) -> [String] -> [String] -> String -> String -> Hamlet String -template req msg as ps t s = [$hamlet| +-- template :: Request -> Maybe (Html ()) -> [String] -> [String] -> String -> String -> Hamlet String +template req msg as ps title content = [$hamlet| !!! %html %head + %title $string.title$ %meta!http-equiv=Content-Type!content=$string.metacontent$ %link!rel=stylesheet!type=text/css!href=@stylesheet@!media=all - %title $string.t$ %body ^navbar'^ #messages $m$ ^addform'^ #content - %pre $string.s$ + %pre $string.content$ |] where m = fromMaybe (string "") msg navbar' = navbar req as ps @@ -150,7 +151,7 @@ template req msg as ps t s = [$hamlet| stylesheet = "/style.css" metacontent = "text/html; charset=utf-8" -navbar :: Request -> [String] -> [String] -> Hamlet String +-- navbar :: Request -> [String] -> [String] -> Hamlet String navbar req as ps = [$hamlet| #navbar %a#hledgerorglink!href=@hledgerurl@ hledger.org @@ -161,7 +162,7 @@ navbar req as ps = [$hamlet| where navlinks' = navlinks req as ps searchform' = searchform req as ps -navlinks :: Request -> [String] -> [String] -> Hamlet String +-- navlinks :: Request -> [String] -> [String] -> Hamlet String navlinks _ as ps = [$hamlet| #navlinks ^transactionslink^ | $ @@ -175,7 +176,7 @@ navlinks _ as ps = [$hamlet| navlink s = [$hamlet|%a.navlink!href=@u@ $string.s$|] where u = printf "../%s?a=%s&p=%s" s (intercalate "+" as) (intercalate "+" ps) -searchform :: Request -> [String] -> [String] -> Hamlet String +-- searchform :: Request -> [String] -> [String] -> Hamlet String searchform req as ps = [$hamlet| %form#searchform!action=$string.action$ search for: $ @@ -202,7 +203,7 @@ searchform req as ps = [$hamlet| helplink topic = [$hamlet|%a!href=@u@ ?|] where u = manualurl ++ if null topic then "" else '#':topic -addform :: Request -> [String] -> [String] -> Hamlet String +-- addform :: Request -> [String] -> [String] -> Hamlet String addform _ _ _ = [$hamlet| %form#addform!action=$string.action$!method=POST %table!border=0 @@ -231,7 +232,7 @@ addform _ _ _ = [$hamlet| transactionfields1 = transactionfields 1 transactionfields2 = transactionfields 2 -transactionfields :: Int -> Hamlet String +-- transactionfields :: Int -> Hamlet String transactionfields n = [$hamlet| %tr %td @@ -252,7 +253,7 @@ transactionfields n = [$hamlet| postTransactionsPage :: Handler HledgerWebApp RepPlain postTransactionsPage = do today <- liftIO getCurrentDay - -- get form input values, or basic validation errors. E suffix means an Either value. + -- get form input values, or basic validation errors. E means an Either value. dateE <- runFormPost $ catchFormError $ notEmpty $ required $ input "date" descE <- runFormPost $ catchFormError $ required $ input "desc" acct1E <- runFormPost $ catchFormError $ notEmpty $ required $ input "acct1" @@ -294,8 +295,9 @@ postTransactionsPage = do Right t -> do let t' = txnTieKnot t -- XXX move into balanceTransaction j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - j' <- liftIO $ journalAddTransaction j t' >>= journalReload - liftIO $ putValue "hledger" "journal" j' + -- j' <- liftIO $ journalAddTransaction j t' >>= journalReload + -- liftIO $ putValue "hledger" "journal" j' + liftIO $ journalAddTransaction j t' setMessage $ string $ printf "Added transaction:\n%s" (show t') redirect RedirectTemporary TransactionsPage diff --git a/Hledger/Cli/Utils.hs b/Hledger/Cli/Utils.hs index 26bb615c0..8f493ce30 100644 --- a/Hledger/Cli/Utils.hs +++ b/Hledger/Cli/Utils.hs @@ -53,10 +53,10 @@ readJournalWithOpts opts s = do journalReload :: Journal -> IO Journal journalReload Journal{filepath=f} = readJournalFile Nothing f --- | Re-read a journal from its data file using the specified options, --- only if the file has changed since last read (or if there is no file, --- ie data read from stdin). Return a journal and a flag indicating --- whether it was re-read or not. +-- | Re-read a journal from its data file mostly, only if the file has +-- changed since last read (or if there is no file, ie data read from +-- stdin). The provided options are mostly ignored. Return a journal and a +-- flag indicating whether it was re-read or not. journalReloadIfChanged :: [Opt] -> Journal -> IO (Bool, Journal) journalReloadIfChanged opts j@Journal{filepath=f,filereadtime=tread} = do tmod <- journalFileModificationTime j