diff --git a/Hledger/Cli/Commands/Add.hs b/Hledger/Cli/Commands/Add.hs index 3b826f882..1d3f16705 100644 --- a/Hledger/Cli/Commands/Add.hs +++ b/Hledger/Cli/Commands/Add.hs @@ -44,7 +44,7 @@ add opts args j getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO () getAndAddTransactions j opts args defaultDate = do (t, d) <- getTransaction j opts args defaultDate - j <- journalAddTransaction j t + j <- journalAddTransaction j opts t getAndAddTransactions j opts args d -- | Read a transaction from the command line, with history-aware prompting. @@ -134,11 +134,12 @@ askFor prompt def validator = do -- | Append this transaction to the journal's file. Also, to the journal's -- transaction list, but we don't bother updating the other fields - this -- is enough to include new transactions in the history matching. -journalAddTransaction :: Journal -> Transaction -> IO Journal -journalAddTransaction j@Journal{jtxns=ts} t = do +journalAddTransaction :: Journal -> [Opt] -> Transaction -> IO Journal +journalAddTransaction j@Journal{jtxns=ts} opts t = do appendToJournalFile j $ showTransaction t - putStrLn $ printf "\nAdded transaction to %s:" (filepath j) - putStrLn =<< registerFromString (show t) + when (Debug `elem` opts) $ do + putStrLn $ printf "\nAdded transaction to %s:" (filepath j) + putStrLn =<< registerFromString (show t) return j{jtxns=ts++[t]} -- | Append data to the journal's file, ensuring proper separation from diff --git a/Hledger/Cli/Commands/Balance.hs b/Hledger/Cli/Commands/Balance.hs index 0d16b5d79..46e722abb 100644 --- a/Hledger/Cli/Commands/Balance.hs +++ b/Hledger/Cli/Commands/Balance.hs @@ -96,9 +96,9 @@ balance report: -} module Hledger.Cli.Commands.Balance ( - balance - ,BalanceReport + BalanceReport ,BalanceReportItem + ,balance ,balanceReport ,balanceReportAsText -- ,tests_Balance diff --git a/Hledger/Cli/Commands/Print.hs b/Hledger/Cli/Commands/Print.hs index 111177698..9e2518745 100644 --- a/Hledger/Cli/Commands/Print.hs +++ b/Hledger/Cli/Commands/Print.hs @@ -5,8 +5,13 @@ A ledger-compatible @print@ command. -} -module Hledger.Cli.Commands.Print -where +module Hledger.Cli.Commands.Print ( + JournalReport + ,JournalReportItem + ,print' + ,journalReport + ,showTransactions +) where import Hledger.Data import Hledger.Cli.Options #if __GLASGOW_HASKELL__ <= 610 @@ -15,6 +20,12 @@ import System.IO.UTF8 #endif +-- | A "journal report" is just a list of transactions. +type JournalReport = [JournalReportItem] + +-- | The data for a single journal report item, representing one transaction. +type JournalReportItem = Transaction + -- | Print journal transactions in standard format. print' :: [Opt] -> [String] -> Journal -> IO () print' opts args j = do @@ -22,8 +33,11 @@ print' opts args j = do putStr $ showTransactions (optsToFilterSpec opts args t) j showTransactions :: FilterSpec -> Journal -> String -showTransactions filterspec j = - concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns - where - effective = EffectiveDate == whichdate filterspec - txns = jtxns $ filterJournalTransactions filterspec j +showTransactions fspec j = journalReportAsText [] fspec $ journalReport [] fspec j + +journalReportAsText :: [Opt] -> FilterSpec -> JournalReport -> String -- XXX unlike the others, this one needs fspec not opts +journalReportAsText _ fspec items = concatMap (showTransactionForPrint effective) items + where effective = EffectiveDate == whichdate fspec + +journalReport :: [Opt] -> FilterSpec -> Journal -> JournalReport +journalReport _ fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j \ No newline at end of file diff --git a/Hledger/Cli/Commands/Register.hs b/Hledger/Cli/Commands/Register.hs index dc20d476c..5f502a2bd 100644 --- a/Hledger/Cli/Commands/Register.hs +++ b/Hledger/Cli/Commands/Register.hs @@ -6,9 +6,9 @@ A ledger-compatible @register@ command. -} module Hledger.Cli.Commands.Register ( - register - ,RegisterReport + RegisterReport ,RegisterReportItem + ,register ,registerReport ,registerReportAsText ,showPostingWithBalanceForVty diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index 3ab604628..caaea4402 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -19,6 +19,7 @@ import Hledger.Cli.Commands.Print import Hledger.Cli.Commands.Register import Hledger.Cli.Options hiding (value) import Hledger.Cli.Utils +import Hledger.Cli.Version (version) import Hledger.Data import Hledger.Read (journalFromPathAndString) import Hledger.Read.Journal (someamount) @@ -47,14 +48,17 @@ data HledgerWebApp = HledgerWebApp { mkYesod "HledgerWebApp" [$parseRoutes| / IndexPage GET /journal JournalPage GET POST -/edit EditPage GET POST /register RegisterPage GET /balance BalancePage GET +/ledger LedgerPage GET /style.css StyleCss GET |] instance Yesod HledgerWebApp where approot = appRoot +-- defaultroute = LedgerPage +defaultroute = JournalPage + -- | A bundle of useful data passed to templates. data TemplateData = TD { here :: HledgerWebAppRoute -- ^ the current page's route @@ -62,18 +66,14 @@ data TemplateData = TD { ,msg :: Maybe (Html ()) -- ^ transient message ,a :: String -- ^ a (filter pattern) parameter ,p :: String -- ^ p (period expression) parameter - ,content :: Html () -- ^ html for the content area - ,contentplain :: String -- ^ or plain text content } -td = TD { +mktd = TD { here = IndexPage ,title = "hledger" ,msg = Nothing ,a = "" ,p = "" - ,content = nulltemplate id - ,contentplain = "" } -- | The web command. @@ -104,9 +104,10 @@ server baseurl port opts args j = do } withStore "hledger" $ do putValue "hledger" "journal" j - basicHandler port app + basicHandler' port Nothing app --- handlers +---------------------------------------------------------------------- +-- handlers & templates getStyleCss :: Handler HledgerWebApp () getStyleCss = do @@ -115,158 +116,107 @@ getStyleCss = do sendFile "text/css" $ dir "style.css" getIndexPage :: Handler HledgerWebApp () -getIndexPage = redirect RedirectTemporary BalancePage +getIndexPage = redirect RedirectTemporary defaultroute --- | Gather all the stuff we want for a typical hledger web request handler. -getHandlerParameters :: Handler HledgerWebApp - (String, String, [Opt], FilterSpec, Journal, Maybe (Html ()), HledgerWebAppRoute) -getHandlerParameters = do - Just here <- getCurrentRoute - (a, p, opts, fspec) <- getReportParameters - (j, err) <- getLatestJournal opts - msg <- getMessage' err - return (a, p, opts, fspec, j, msg, here) - where - -- | Get current report parameters for this request. - getReportParameters :: Handler HledgerWebApp (String, String, [Opt], FilterSpec) - getReportParameters = do - app <- getYesod - t <- liftIO $ getCurrentLocalTime - a <- fromMaybe "" <$> lookupGetParam "a" - p <- fromMaybe "" <$> lookupGetParam "p" - let opts = appOpts app ++ [Period p] - args = appArgs app ++ [a] - fspec = optsToFilterSpec opts args t - return (a, p, opts, fspec) - - -- | Update our copy of the journal if the file changed. If there is an - -- error while reloading, keep the old one and return the error, and set a - -- ui message. - getLatestJournal :: [Opt] -> Handler HledgerWebApp (Journal, Maybe String) - getLatestJournal opts = do - j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - (jE, changed) <- liftIO $ journalReloadIfChanged opts j - if not changed - then return (j,Nothing) - else case jE of - Right j' -> do liftIO $ putValue "hledger" "journal" j' - return (j',Nothing) - Left e -> do setMessage $ string "error while reading" {- ++ ": " ++ e-} - return (j, Just e) - - -- | Helper to work around a yesod feature (can't set and get a message in the same request.) - getMessage' :: Maybe String -> Handler HledgerWebApp (Maybe (Html ())) - getMessage' newmsgstr = do - oldmsg <- getMessage - return $ maybe oldmsg (Just . string) newmsgstr - --- renderLatestJournalWith :: ([Opt] -> FilterSpec -> Journal -> Html ()) -> Handler HledgerWebApp RepHtml --- renderLatestJournalWith reportHtml = do --- (a, p, opts, fspec, j, msg, here) <- getHandlerParameters --- let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=reportHtml opts fspec j} --- hamletToRepHtml $ pageLayout td' +---------------------------------------------------------------------- +-- | A basic journal view, like hledger print, with editing. getJournalPage :: Handler HledgerWebApp RepHtml getJournalPage = do - (a, p, _, fspec, j, msg, here) <- getHandlerParameters - let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content= - stringToPre $ showTransactions fspec j - } - hamletToRepHtml $ pageLayout td' - -getBalancePage :: Handler HledgerWebApp RepHtml -getBalancePage = do (a, p, opts, fspec, j, msg, here) <- getHandlerParameters - let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content= - balanceReportAsHtml opts td' $ balanceReport opts fspec j - } - hamletToRepHtml $ pageLayout td' + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} + editform' = editform td $ jtext j + txns = journalReportAsHtml opts td $ journalReport opts fspec j + hamletToRepHtml $ pageLayout td [$hamlet| +%div.journal + ^journalScripts^ + %div.nav2 + %a#addformlink!href!onclick="return addformToggle()" add one transaction + \ | $ + %a#editformlink!href!onclick="return editformToggle()" edit the whole journal + ^addform^ + ^editform'^ + #transactions ^txns^ +|] --- | Render a balance report as HTML. -balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Html () -balanceReportAsHtml _ td (items,total) = [$hamlet| -%table.balancereport - $forall items i - %tr.itemrule - %td!colspan=2 +-- | Render a journal report as HTML. +journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet HledgerWebAppRoute +journalReportAsHtml _ td items = [$hamlet| +%table.journalreport + $forall number.items i ^itemAsHtml' i^ - %tr.totalrule - %td!colspan=2 - %tr - %td - %td!align=right $mixedAmountAsHtml.total$ -|] id +|] where + number = zip [1..] itemAsHtml' = itemAsHtml td - itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet String - itemAsHtml TD{p=p} (a, adisplay, adepth, abal) = [$hamlet| - %tr.item - %td.account - $indent$ - %a!href=$aurl$ $adisplay$ - %td.balance!align=right $mixedAmountAsHtml.abal$ + itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet HledgerWebAppRoute + itemAsHtml _ (n, t) = [$hamlet| + %tr.item.$evenodd$ + %td.transaction + %pre $txn$ |] where - indent = preEscapedString $ concat $ replicate (2 * adepth) " " - aurl = printf "../register?a=^%s%s" a p' :: String - p' = if null p then "" else printf "&p=%s" p + evenodd = if even n then "even" else "odd" + txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse ---mixedAmountAsHtml = intercalate ", " . lines . show -mixedAmountAsHtml = preEscapedString . intercalate "
" . lines . show +journalScripts = [$hamlet| + +|] postJournalPage :: Handler HledgerWebApp RepPlain postJournalPage = do + edit <- runFormPost' $ maybeStringInput "edit" + if isJust edit then postEditForm else postAddForm + +-- | Handle a journal add form post. +postAddForm :: Handler HledgerWebApp RepPlain +postAddForm = do + (_, _, opts, _, _, _, _) <- getHandlerParameters today <- liftIO getCurrentDay -- get form input values. M means a Maybe value. (dateM, descM, acct1M, amt1M, acct2M, amt2M) <- runFormPost' @@ -315,12 +265,13 @@ postJournalPage = do Right t -> do let t' = txnTieKnot t -- XXX move into balanceTransaction j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - liftIO $ journalAddTransaction j t' + liftIO $ journalAddTransaction j opts t' setMessage $ string $ printf "Added transaction:\n%s" (show t') redirect RedirectTemporary JournalPage -postEditPage :: Handler HledgerWebApp RepPlain -postEditPage = do +-- | Handle a journal edit form post. +postEditForm :: Handler HledgerWebApp RepPlain +postEditForm = do -- get form input values, or basic validation errors. E means an Either value. textM <- runFormPost' $ maybeStringInput "text" let textE = maybe (Left "No value provided") Right textM @@ -343,134 +294,23 @@ postEditPage = do if not changed then do setMessage $ string $ "No change" - redirect RedirectTemporary EditPage + redirect RedirectTemporary JournalPage else do jE <- liftIO $ journalFromPathAndString Nothing f tnew either (\e -> do setMessage $ string e - redirect RedirectTemporary EditPage) + redirect RedirectTemporary JournalPage) (const $ do liftIO $ writeFileWithBackup f tnew setMessage $ string $ printf "Saved journal %s\n" (show f) redirect RedirectTemporary JournalPage) jE --- templates - -nulltemplate = [$hamlet||] - -stringToPre :: String -> Html () -stringToPre s = [$hamlet|%pre $s$|] id - -pageLayout :: TemplateData -> Hamlet HledgerWebAppRoute -pageLayout td@TD{here=here, title=title, msg=msg, content=content} = [$hamlet| -!!! -%html - %head - %title $title$ - %meta!http-equiv=Content-Type!content=$metacontent$ - %link!rel=stylesheet!type=text/css!href=@stylesheet@!media=all - %body - ^navbar.td^ - #messages $m$ - ^addform'.here^ - #content - $content$ -|] - where m = fromMaybe (string "") msg - addform' JournalPage = addform - addform' _ = nulltemplate - stylesheet = StyleCss - metacontent = "text/html; charset=utf-8" - -navbar :: TemplateData -> Hamlet HledgerWebAppRoute -navbar td = [$hamlet| - #navbar - %a.toprightlink!href=$hledgerurl$ hledger.org - \ $ - %a.toprightlink!href=$manualurl$ manual - \ $ - ^navlinks.td^ - ^searchform.td^ -|] - -navlinks :: TemplateData -> Hamlet HledgerWebAppRoute -navlinks TD{here=here,a=a,p=p} = [$hamlet| - #navlinks - ^journallink^ $ - (^editlink^) $ - | ^balancelink^ $ - | ^registerlink^ $ -|] - where - journallink = navlink here "journal" JournalPage - editlink = navlink here "edit" EditPage - registerlink = navlink here "register" RegisterPage - balancelink = navlink here "balance" BalancePage - navlink here s dest = [$hamlet|%a.$style$!href=@?u@ $s$|] - where u = (dest, concat [(if null a then [] else [("a", a)]) - ,(if null p then [] else [("p", p)])]) - style | here == dest = "navlinkcurrent" - | otherwise = "navlink" - -searchform :: TemplateData -> Hamlet HledgerWebAppRoute -searchform TD{here=here,a=a,p=p} = [$hamlet| - %form#searchform!method=GET - ^resetlink^ $ - %span!style=white-space:nowrap; - filter by: $ - %input!name=a!size=30!value=$a$ - ^ahelp^ $ - in period: $ - %input!name=p!size=30!value=$p$ - ^phelp^ $ - %input!type=submit!value=filter -|] - where - ahelp = helplink "filter-patterns" "?" - phelp = helplink "period-expressions" "?" - resetlink - | null a && null p = nulltemplate - | otherwise = [$hamlet|%span#resetlink!style=font-weight:bold; $ - %a!href=@here@ stop filtering|] - -helplink topic label = [$hamlet|%a!href=$u$ $label$|] - where u = manualurl ++ if null topic then "" else '#':topic - -editform :: TemplateData -> Hamlet HledgerWebAppRoute -editform TD{contentplain=t} = [$hamlet| - %form!method=POST - %table.form#editform!cellpadding=0!cellspacing=0!border=0 - %tr.formheading - %td!colspan=2 - %span!style=float:right; ^formhelp^ - %span#formheading Edit journal: - %tr - %td!colspan=2 - %textarea!name=text!rows=30!cols=80 - $t$ - %tr#addbuttonrow - %td - %a!href=@JournalPage@ cancel - %td!align=right - %input!type=submit!value=$submitlabel$ - %tr.helprow - %td - %td!align=right - #help Are you sure ? All previous data will be replaced -|] - where - submitlabel = "save journal" - formhelp = helplink "file-format" "file format help" - addform :: Hamlet HledgerWebAppRoute addform = [$hamlet| - %form!method=POST - %table.form#addform!cellpadding=0!cellspacing=0!border=0 - %tr.formheading - %td!colspan=4 - %span#formheading Add a transaction: + %form#addform!method=POST!style=display:none; + %table.form!cellpadding=0!cellspacing=0!border=0 %tr %td!colspan=4 %table!cellpadding=0!cellspacing=0!border=0 @@ -486,21 +326,21 @@ addform = [$hamlet| %tr.helprow %td %td - #help $datehelp$ ^datehelplink^ $ + .help $datehelp$ ^datehelplink^ $ %td %td - #help $deschelp$ + .help $deschelp$ ^transactionfields1^ ^transactionfields2^ %tr#addbuttonrow %td!colspan=4 - %input!type=submit!value=$addlabel$ + %input!type=hidden!name=add!value=1 + %input!type=submit!name=submit!value="add transaction" |] where datehelplink = helplink "dates" "..." datehelp = "eg: 7/20, 2010/1/1, " deschelp = "eg: supermarket (optional)" - addlabel = "add transaction" date = "today" desc = "" transactionfields1 = transactionfields 1 @@ -517,10 +357,10 @@ transactionfields n = [$hamlet| %tr.helprow %td %td - #help $accthelp$ + .help $accthelp$ %td %td - #help $amthelp$ + .help $amthelp$ |] where label | n == 1 = "To account" @@ -542,3 +382,255 @@ transactionfields n = [$hamlet| acctvar = numbered "accountname" amtvar = numbered "amount" +editform :: TemplateData -> String -> Hamlet HledgerWebAppRoute +editform _ content = [$hamlet| + %form#editform!method=POST!style=display:none; + %table.form#editform!cellpadding=0!cellspacing=0!border=0 + %tr + %td!colspan=2 + %textarea!name=text!rows=30!cols=80 + $content$ + %tr#addbuttonrow + %td + %span.help ^formathelp^ + %td!align=right + %span.help Are you sure ? Your journal will be overwritten. $ + %input!type=hidden!name=edit!value=1 + %input!type=submit!name=submit!value="save journal" + \ or $ + %a!href!onclick="return editformToggle()" cancel +|] + where + formathelp = helplink "file-format" "file format help" + +---------------------------------------------------------------------- + +-- | A combined accounts and postings view, like hledger balance + hledger register. +getLedgerPage :: Handler HledgerWebApp RepHtml +getLedgerPage = do + (a, p, opts, fspec, j, msg, here) <- getHandlerParameters + -- in this view, balance report is filtered only by period, not account/description filters + app <- getYesod + t <- liftIO $ getCurrentLocalTime + let args = appArgs app + fspec' = optsToFilterSpec opts args t + br = balanceReportAsHtml opts td $ balanceReport opts fspec' j + rr = registerReportAsHtml opts td $ registerReport opts fspec j + td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} + hamletToRepHtml $ pageLayout td [$hamlet| +%div.ledger + %div.accounts!style=float:left; ^br^ + %div.register ^rr^ +|] + +---------------------------------------------------------------------- + +-- | An accounts and balances view, like hledger balance. +getBalancePage :: Handler HledgerWebApp RepHtml +getBalancePage = do + (a, p, opts, fspec, j, msg, here) <- getHandlerParameters + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} + hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j + +-- | Render a balance report as HTML. +balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet HledgerWebAppRoute +balanceReportAsHtml _ td (items,total) = [$hamlet| +%table.balancereport + $forall items i + ^itemAsHtml' i^ + %tr.totalrule + %td!colspan=2 + %tr + %td + %td!align=right $mixedAmountAsHtml.total$ +|] + where + itemAsHtml' = itemAsHtml td + itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet HledgerWebAppRoute + itemAsHtml TD{a=a,p=p} (acct, adisplay, adepth, abal) = [$hamlet| + %tr.item.$current$ + %td.account + $indent$ + %a!href=$aurl$ $adisplay$ + %td.balance!align=right $mixedAmountAsHtml.abal$ + |] where + current = if not (null a) && containsRegex a acct then "current" else "" + indent = preEscapedString $ concat $ replicate (2 * adepth) " " + aurl = printf "../ledger?a=^%s%s" acct p' :: String + p' = if null p then "" else printf "&p=%s" p + +---------------------------------------------------------------------- + +-- | A postings view, like hledger register. +getRegisterPage :: Handler HledgerWebApp RepHtml +getRegisterPage = do + (a, p, opts, fspec, j, msg, here) <- getHandlerParameters + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} + hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j + +-- | Render a register report as HTML. +registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet HledgerWebAppRoute +registerReportAsHtml _ td items = [$hamlet| +%table.registerreport + $forall number.items i + ^itemAsHtml' i^ +|] + where + number = zip [1..] + itemAsHtml' = itemAsHtml td + itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet HledgerWebAppRoute + itemAsHtml TD{p=p} (n, (ds, posting, b)) = [$hamlet| + %tr.item.$evenodd$.$firstposting$ + %td.date $date$ + %td.description $desc$ + %td.account + %a!href=$aurl$ $acct$ + %td.amount!align=right $mixedAmountAsHtml.pamount.posting$ + %td.balance!align=right $mixedAmountAsHtml.b$ + |] where + evenodd = if even n then "even" else "odd" + (firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de) + Nothing -> ("", "", "") + acct = paccount posting + aurl = printf "../ledger?a=^%s%s" acct p' :: String + p' = if null p then "" else printf "&p=%s" p + +--mixedAmountAsHtml = intercalate ", " . lines . show +mixedAmountAsHtml = preEscapedString . intercalate "
" . lines . show + +---------------------------------------------------------------------- + +-- | A standalone journal edit form page. +getEditPage :: Handler HledgerWebApp RepHtml +getEditPage = do + (a, p, _, _, _, msg, here) <- getHandlerParameters + -- reload journal's text without parsing, if changed + j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" + changed <- liftIO $ journalFileIsNewer j + s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) -- XXX readFile may throw an error + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} + hamletToRepHtml $ pageLayout td $ editform td s + +---------------------------------------------------------------------- + +-- | Gather all the stuff we want for a typical hledger web request handler. +getHandlerParameters :: Handler HledgerWebApp + (String, String, [Opt], FilterSpec, Journal, Maybe (Html ()), HledgerWebAppRoute) +getHandlerParameters = do + Just here <- getCurrentRoute + (a, p, opts, fspec) <- getReportParameters + (j, err) <- getLatestJournal opts + msg <- getMessage' err + return (a, p, opts, fspec, j, msg, here) + where + -- | Get current report parameters for this request. + getReportParameters :: Handler HledgerWebApp (String, String, [Opt], FilterSpec) + getReportParameters = do + app <- getYesod + t <- liftIO $ getCurrentLocalTime + a <- fromMaybe "" <$> lookupGetParam "a" + p <- fromMaybe "" <$> lookupGetParam "p" + let opts = appOpts app ++ [Period p] + args = appArgs app ++ [a] + fspec = optsToFilterSpec opts args t + return (a, p, opts, fspec) + + -- | Update our copy of the journal if the file changed. If there is an + -- error while reloading, keep the old one and return the error, and set a + -- ui message. + getLatestJournal :: [Opt] -> Handler HledgerWebApp (Journal, Maybe String) + getLatestJournal opts = do + j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" + (jE, changed) <- liftIO $ journalReloadIfChanged opts j + if not changed + then return (j,Nothing) + else case jE of + Right j' -> do liftIO $ putValue "hledger" "journal" j' + return (j',Nothing) + Left e -> do setMessage $ string "error while reading" {- ++ ": " ++ e-} + return (j, Just e) + + -- | Helper to work around a yesod feature (can't set and get a message in the same request.) + getMessage' :: Maybe String -> Handler HledgerWebApp (Maybe (Html ())) + getMessage' newmsgstr = do + oldmsg <- getMessage + return $ maybe oldmsg (Just . string) newmsgstr + +pageLayout :: TemplateData -> Hamlet HledgerWebAppRoute -> Hamlet HledgerWebAppRoute +pageLayout td@TD{title=title, msg=msg} content = [$hamlet| +!!! +%html + %head + %title $title$ + %meta!http-equiv=Content-Type!content=$metacontent$ + %link!rel=stylesheet!type=text/css!href=@StyleCss@!media=all + %body + ^navbar.td^ + #messages $m$ + #content + ^content^ +|] + where m = fromMaybe (string "") msg + metacontent = "text/html; charset=utf-8" + +navbar :: TemplateData -> Hamlet HledgerWebAppRoute +navbar td = [$hamlet| + #navbar + %a.toprightlink!href=$hledgerurl$ hledger $version$ + \ $ + %a.toprightlink!href=$manualurl$ manual + \ $ + ^navlinks.td^ + ^filterform.td^ +|] + +navlinks :: TemplateData -> Hamlet HledgerWebAppRoute +navlinks td = [$hamlet| + #navlinks + ^journallink^ $ + | ^ledgerlink^ $ +|] + where + journallink = navlink td "journal" JournalPage + ledgerlink = navlink td "ledger" LedgerPage + -- | ^balancelink^ $ + -- | ^registerlink^ $ + -- balancelink = navlink td "balance" BalancePage + -- registerlink = navlink td "register" RegisterPage + +navlink :: TemplateData -> String -> HledgerWebAppRoute -> Hamlet HledgerWebAppRoute +navlink TD{here=here,a=a,p=p} s dest = [$hamlet|%a.$style$!href=@?u@ $s$|] + where u = (dest, concat [(if null a then [] else [("a", a)]) + ,(if null p then [] else [("p", p)])]) + style | dest == here = "navlinkcurrent" + | otherwise = "navlink" + +filterform :: TemplateData -> Hamlet HledgerWebAppRoute +filterform TD{here=here,a=a,p=p} = [$hamlet| + %form#filterform.$filtering$!method=GET + %span!style=white-space:nowrap; + ^filterformlabel^ $ + %input!name=a!size=30!value=$a$ + ^ahelp^ $ + in period: $ + %input!name=p!size=30!value=$p$ + ^phelp^ $ + %input!type=submit!value=filter +|] + where + ahelp = helplink "filter-patterns" "?" + phelp = helplink "period-expressions" "?" + (filtering, filterformlabel) + | null a && null p = ("", [$hamlet|filter by: $|]) + | otherwise = ("filtering", [$hamlet| +%a#stopfilterlink!href=@here@ stop filtering +\ $ +by $ +|]) + +helplink :: String -> String -> Hamlet HledgerWebAppRoute +helplink topic label = [$hamlet|%a!href=$u$!target=hledgerhelp $label$|] + where u = manualurl ++ if null topic then "" else '#':topic + +nulltemplate = [$hamlet||] + diff --git a/data/web/style.css b/data/web/style.css index 8e5ed18da..0ea2d8a1e 100644 --- a/data/web/style.css +++ b/data/web/style.css @@ -1,12 +1,19 @@ /* hledger web ui stylesheet */ -body { font-family: "helvetica","arial", "sans serif"; margin:0; } -#navbar { background-color:#eeeeee; border-bottom:2px solid #dddddd; padding:4px 4px 6px 4px; } +/* font families */ +body { font-family:helvetica,arial,"sans serif"; } +/* pre { font-family:monospace,courier,"courier new"; } */ +#editform textarea { font-family:courier,"courier new",monospace; } + +body { margin:0; } +#navbar { /* background-color:#eeeeee; */ /* border-bottom:2px solid #dddddd; */ padding:4px 4px 6px 4px; } #navlinks { display:inline; } .navlink { } .navlinkcurrent { font-weight:bold; } -#searchform { font-size:small; display:inline; margin-left:1em; } -#resetlink { font-size:small; } +.nav2 { font-size:small; } +#filterform { font-size:small; display:inline; margin-left:1em; } +.filtering { background-color:#eee; font-weight:bold; } +#stopfilterlink { font-size:small; } .toprightlink { font-size:small; margin-left:1em; float:right; } #messages { color:red; background-color:#ffeeee; margin:0.5em;} .form { margin:1em; font-size:small; } @@ -16,25 +23,50 @@ body { font-family: "helvetica","arial", "sans serif"; margin:0; } #addform #postingrow { } #addform #addbuttonrow { text-align:right; } #editform { width:95%; } -#editform textarea { background-color:#eeeeee; font-family:monospace; font-size:medium; width:100%; } +#editform textarea { /* background-color:#eeeeee; */ width:100%; } #content { margin:1em; } .formheading td { padding-bottom:8px; } #formheading { font-size:medium; font-weight:bold; } .helprow td { padding-bottom:8px; } -#help {font-style: italic; font-size:smaller; } +.help {font-style: italic; font-size:smaller; } /* for -fweb610 */ -#hledgerorglink, #helplink { float:right; margin-left:1em; } +/* #hledgerorglink, #helplink { float:right; margin-left:1em; } */ -/* .balancereport { font-size:small; } */ +.current { font-weight:bold; background-color:#eee; } +.description { padding-left:1em; } +.account { white-space:nowrap; padding-left:1em; } +.amount { white-space:nowrap; padding-left:1em; } +.balance { white-space:nowrap; padding-left:1em; } + /* don't let fields get too small in emptyish reports */ +.description { width:4em; } +.account, .amount, .balance { width:2em; } +/* .odd { background-color:#e8e8e8; } */ +/* .even { background-color:#e8f8e8; } */ +/* .even { background-color:#f0fff0; } */ + +.journalreport { font-size:small; } +table.journalreport { margin-top:1em; } +.journalreport td { border-top:thin solid #ddd; } +.journalreport pre { margin-top:0; } + +.ledger .accounts {padding-right:1em; margin-right:1em; border-right:thin solid #ddd;} +.ledger .register {} + +.balancereport { font-size:small; } .balancereport tr { vertical-align:top; } +table.balancereport { border-spacing:0; } +.ledger .balancereport td { padding:0; } /* .itemrule td { border-top:thin solid #ddd; } */ .totalrule td { border-top:thin solid black; } +table.registerreport { border-spacing:0; } .registerreport { font-size:small; } .registerreport tr { vertical-align:top; } +.registerreport td { padding-bottom:0.2em; } +/* .registerreport td { margin-left:0em; margin-right:0; } */ .registerreport .date { white-space:nowrap; } /* .registerreport .description { font-size:small; } */ -.registerreport .account { white-space:nowrap; } -.registerreport .amount { white-space:nowrap; } -.registerreport .balance { white-space:nowrap; } +/* .firstposting { background-color:#eee; } */ +.registerreport .even { background-color:#f0f0f0; } + diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index d7ad30596..f3e2c159b 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -104,7 +104,7 @@ ensureJournalFile f = do emptyJournal :: IO String emptyJournal = do d <- getCurrentDay - return $ printf "; journal created %s; see http://hledger.org/MANUAL.html#journal-file\n\n" (show d) + return $ printf "; journal created %s by hledger\n\n" (show d) -- | Read a Journal from this string, using the specified data format or -- trying all known formats, or give an error string.