From 4467af1aa8af8a722dc9387f24923f34a235e0ca Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Mon, 26 Jul 2010 23:04:47 +0000 Subject: [PATCH] web: more web and report refactoring, and a html register report --- Hledger/Cli/Commands/Add.hs | 4 +- Hledger/Cli/Commands/Balance.hs | 55 +++++--- Hledger/Cli/Commands/Register.hs | 115 +++++++++------- Hledger/Cli/Commands/Vty.hs | 6 +- Hledger/Cli/Commands/Web.hs | 219 ++++++++++++++++++------------- Hledger/Cli/Tests.hs | 34 ++--- data/web/style.css | 13 ++ 7 files changed, 269 insertions(+), 177 deletions(-) diff --git a/Hledger/Cli/Commands/Add.hs b/Hledger/Cli/Commands/Add.hs index 9cab2cded..3b826f882 100644 --- a/Hledger/Cli/Commands/Add.hs +++ b/Hledger/Cli/Commands/Add.hs @@ -10,7 +10,7 @@ where import Hledger.Data import Hledger.Read.Journal (someamount) import Hledger.Cli.Options -import Hledger.Cli.Commands.Register (showRegisterReport) +import Hledger.Cli.Commands.Register (registerReport, registerReportAsText) #if __GLASGOW_HASKELL__ <= 610 import Prelude hiding (putStr, putStrLn, getLine, appendFile) import System.IO.UTF8 @@ -160,7 +160,7 @@ registerFromString :: String -> IO String registerFromString s = do now <- getCurrentLocalTime l <- readJournalWithOpts [] s - return $ showRegisterReport opts (optsToFilterSpec opts [] now) l + return $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] now) l where opts = [Empty] -- | Return a similarity measure, from 0 to 1, for two strings. diff --git a/Hledger/Cli/Commands/Balance.hs b/Hledger/Cli/Commands/Balance.hs index 0264a2d62..0d16b5d79 100644 --- a/Hledger/Cli/Commands/Balance.hs +++ b/Hledger/Cli/Commands/Balance.hs @@ -95,8 +95,14 @@ balance report: -} -module Hledger.Cli.Commands.Balance -where +module Hledger.Cli.Commands.Balance ( + balance + ,BalanceReport + ,BalanceReportItem + ,balanceReport + ,balanceReportAsText + -- ,tests_Balance +) where import Hledger.Data.Utils import Hledger.Data.Types import Hledger.Data.Amount @@ -110,7 +116,7 @@ import System.IO.UTF8 #endif --- | The data for a balance report. +-- | A balance report is a chart of accounts with balances, and their grand total. type BalanceReport = ([BalanceReportItem] -- ^ line items, one per account ,MixedAmount -- ^ total balance of all accounts ) @@ -126,24 +132,29 @@ type BalanceReportItem = (AccountName -- ^ full account name balance :: [Opt] -> [String] -> Journal -> IO () balance opts args j = do t <- getCurrentLocalTime - putStr $ showBalanceReport opts $ balanceReport opts (optsToFilterSpec opts args t) j + putStr $ balanceReportAsText opts $ balanceReport opts (optsToFilterSpec opts args t) j -- | Render a balance report as plain text suitable for console output. -showBalanceReport :: [Opt] -> BalanceReport -> String -showBalanceReport opts (items,total) = acctsstr ++ totalstr +balanceReportAsText :: [Opt] -> BalanceReport -> String +balanceReportAsText opts (items,total) = + unlines $ + map (balanceReportItemAsText opts) items + ++ + if NoTotal `elem` opts + then [] + else ["--------------------" + ,padleft 20 $ showMixedAmountWithoutPrice total + ] + +-- | Render one balance report line item as plain text. +balanceReportItemAsText :: [Opt] -> BalanceReportItem -> String +balanceReportItemAsText opts (a, adisplay, adepth, abal) = concatTopPadded [amt, " ", name] where - acctsstr = unlines $ map showitem items - totalstr | NoTotal `elem` opts = "" - | otherwise = printf "--------------------\n%s\n" $ padleft 20 $ showMixedAmountWithoutPrice total - -- | Render one balance report line item as plain text. - showitem :: BalanceReportItem -> String - showitem (a, adisplay, adepth, abal) = concatTopPadded [amt, " ", name] - where - amt = padleft 20 $ showMixedAmountWithoutPrice abal - name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a - | otherwise = depthspacer ++ adisplay - depthspacer = replicate (indentperlevel * adepth) ' ' - indentperlevel = 2 + amt = padleft 20 $ showMixedAmountWithoutPrice abal + name | Flat `elem` opts = accountNameDrop (dropFromOpts opts) a + | otherwise = depthspacer ++ adisplay + depthspacer = replicate (indentperlevel * adepth) ' ' + indentperlevel = 2 -- | Get a balance report with the specified options for this journal. balanceReport :: [Opt] -> FilterSpec -> Journal -> BalanceReport @@ -157,11 +168,13 @@ balanceReport opts filterspec j = (items, total) l = journalToLedger filterspec j -- | Get data for one balance report line item. mkitem :: AccountName -> BalanceReportItem - mkitem a = (a, adisplay, adepth, abal) + mkitem a = (a, adisplay, indent, abal) where - adisplay = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a] + adisplay | Flat `elem` opts = a + | otherwise = accountNameFromComponents $ reverse (map accountLeafName ps) ++ [accountLeafName a] where ps = takeWhile boring parents where boring = not . (`elem` interestingparents) - adepth = length interestingparents + indent | Flat `elem` opts = 0 + | otherwise = length interestingparents interestingparents = filter (`elem` interestingaccts) parents parents = parentAccountNames a abal | Flat `elem` opts = exclusiveBalance acct diff --git a/Hledger/Cli/Commands/Register.hs b/Hledger/Cli/Commands/Register.hs index 7a67000eb..dc20d476c 100644 --- a/Hledger/Cli/Commands/Register.hs +++ b/Hledger/Cli/Commands/Register.hs @@ -7,8 +7,11 @@ A ledger-compatible @register@ command. module Hledger.Cli.Commands.Register ( register - ,showRegisterReport - ,showPostingWithBalance + ,RegisterReport + ,RegisterReportItem + ,registerReport + ,registerReportAsText + ,showPostingWithBalanceForVty ,tests_Register ) where @@ -22,24 +25,80 @@ import System.IO.UTF8 import Text.ParserCombinators.Parsec +-- | A register report is a list of postings to an account or set of +-- accounts, with a running total. Postings may be actual postings, or +-- virtual postings aggregated over a reporting interval. +type RegisterReport = [RegisterReportItem] -- ^ line items, one per posting + +-- | The data for a single register report line item, representing one posting. +type RegisterReportItem = (Maybe (Day, String) -- ^ transaction date and description if this is the first posting + ,Posting -- ^ the posting + ,MixedAmount -- ^ balance so far + ) + -- | Print a register report. register :: [Opt] -> [String] -> Journal -> IO () register opts args j = do t <- getCurrentLocalTime - putStr $ showRegisterReport opts (optsToFilterSpec opts args t) j + putStr $ registerReportAsText opts $ registerReport opts (optsToFilterSpec opts args t) j --- | Generate the register report, which is a list of postings with transaction --- info and a running balance. -showRegisterReport :: [Opt] -> FilterSpec -> Journal -> String -showRegisterReport opts filterspec j = showPostingsWithBalance ps nullposting startbal +-- | Render a register report as plain text suitable for console output. +registerReportAsText :: [Opt] -> RegisterReport -> String +registerReportAsText opts = unlines . map (registerReportItemAsText opts) + +-- | Render one register report line item as plain text. Eg: +-- @ +-- date (10) description (20) account (22) amount (11) balance (12) +-- DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA +-- ^ displayed for first postings^ +-- only, otherwise blank +-- @ +registerReportItemAsText :: [Opt] -> RegisterReportItem -> String +registerReportItemAsText _ (dd, p, b) = concatTopPadded [datedesc, pstr, " ", bal] + where + datedesc = case dd of Nothing -> replicate datedescwidth ' ' + Just (da, de) -> printf "%s %s " date desc + where + date = showDate da + desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String + where + descwidth = datedescwidth - datewidth - 2 + datedescwidth = 32 + datewidth = 10 + pstr = showPostingForRegister p + bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) + +showPostingWithBalanceForVty showtxninfo p b = registerReportItemAsText [] $ mkitem showtxninfo p b + +-- | Get a register report with the specified options for this journal. +registerReport :: [Opt] -> FilterSpec -> Journal -> RegisterReport +registerReport opts fspec j = getitems ps nullposting startbal where ps | interval == NoInterval = displayableps - | otherwise = summarisePostings interval depth empty filterspan displayableps + | otherwise = summarisePostings interval depth empty filterspan displayableps + (precedingps, displayableps, _) = + postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings fspec j startbal = sumPostings precedingps - (precedingps,displayableps,_) = - postingsMatchingDisplayExpr (displayExprFromOpts opts) $ journalPostings $ filterJournalPostings filterspec j (interval, depth, empty) = (intervalFromOpts opts, depthFromOpts opts, Empty `elem` opts) - filterspan = datespan filterspec + filterspan = datespan fspec + +-- | Generate register report line items. +getitems :: [Posting] -> Posting -> MixedAmount -> [RegisterReportItem] +getitems [] _ _ = [] +getitems (p:ps) pprev b = i:(getitems ps p b') + where + i = mkitem isfirst p b' + isfirst = ptransaction p /= ptransaction pprev + b' = b + pamount p + +-- | Generate one register report line item, from a flag indicating +-- whether to include transaction info, a posting, and the current running +-- balance. +mkitem :: Bool -> Posting -> MixedAmount -> RegisterReportItem +mkitem False p b = (Nothing, p, b) +mkitem True p b = (ds, p, b) + where ds = case ptransaction p of Just (Transaction{tdate=da,tdescription=de}) -> Just (da,de) + Nothing -> Just (nulldate,"") -- | Convert a list of postings into summary postings, one per interval. summarisePostings :: Interval -> Maybe Int -> Bool -> DateSpan -> [Posting] -> [Posting] @@ -124,40 +183,6 @@ summarisePostingsInDateSpan (DateSpan b e) depth showempty ps balancetoshowfor a = (if isclipped a then inclbalof else exclbalof) (if null a then "top" else a) -{- | -Show postings one per line, plus transaction info for the first posting of -each transaction, and a running balance. Eg: - -@ -date (10) description (20) account (22) amount (11) balance (12) -DDDDDDDDDD dddddddddddddddddddd aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA - aaaaaaaaaaaaaaaaaaaaaa AAAAAAAAAAA AAAAAAAAAAAA -@ --} -showPostingsWithBalance :: [Posting] -> Posting -> MixedAmount -> String -showPostingsWithBalance [] _ _ = "" -showPostingsWithBalance (p:ps) pprev bal = this ++ showPostingsWithBalance ps p bal' - where - this = showPostingWithBalance isfirst p bal' - isfirst = ptransaction p /= ptransaction pprev - bal' = bal + pamount p - --- | Show one posting and running balance, with or without transaction info. -showPostingWithBalance :: Bool -> Posting -> MixedAmount -> String -showPostingWithBalance withtxninfo p b = concatTopPadded [txninfo, pstr, " ", bal] ++ "\n" - where - ledger3ishlayout = False - datedescwidth = if ledger3ishlayout then 34 else 32 - txninfo = if withtxninfo then printf "%s %s " date desc else replicate datedescwidth ' ' - date = showDate da - datewidth = 10 - descwidth = datedescwidth - datewidth - 2 - desc = printf ("%-"++(show descwidth)++"s") $ elideRight descwidth de :: String - pstr = showPostingForRegister p - bal = padleft 12 (showMixedAmountOrZeroWithoutPrice b) - (da,de) = case ptransaction p of Just (Transaction{tdate=da',tdescription=de'}) -> (da',de') - Nothing -> (nulldate,"") - tests_Register :: Test tests_Register = TestList [ diff --git a/Hledger/Cli/Commands/Vty.hs b/Hledger/Cli/Commands/Vty.hs index a237c06e4..53923e867 100644 --- a/Hledger/Cli/Commands/Vty.hs +++ b/Hledger/Cli/Commands/Vty.hs @@ -229,8 +229,8 @@ resetTrailAndEnter t scr a = enter t scr (aargs a) $ clearLocs a updateData :: LocalTime -> AppState -> AppState updateData t a@AppState{aopts=opts,ajournal=j} = case screen a of - BalanceScreen -> a{abuf=lines $ showBalanceReport opts $ balanceReport opts fspec j} - RegisterScreen -> a{abuf=lines $ showRegisterReport opts fspec j} + BalanceScreen -> a{abuf=lines $ balanceReportAsText opts $ balanceReport opts fspec j} + RegisterScreen -> a{abuf=lines $ registerReportAsText opts $ registerReport opts fspec j} PrintScreen -> a{abuf=lines $ showTransactions fspec j} where fspec = optsToFilterSpec opts (currentArgs a) t @@ -289,7 +289,7 @@ currentTransaction a@AppState{ajournal=j,abuf=buf} = ptransaction p where p = headDef nullposting $ filter ismatch $ journalPostings j ismatch p = postingDate p == parsedate (take 10 datedesc) - && take 70 (showPostingWithBalance False p nullmixedamt) == (datedesc ++ acctamt) + && take 70 (showPostingWithBalanceForVty False p nullmixedamt) == (datedesc ++ acctamt) datedesc = take 32 $ fromMaybe "" $ find (not . (" " `isPrefixOf`)) $ headDef "" rest : reverse above acctamt = drop 32 $ headDef "" rest (above,rest) = splitAt y buf diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index ac971c718..3ab604628 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -115,114 +115,155 @@ getStyleCss = do sendFile "text/css" $ dir "style.css" getIndexPage :: Handler HledgerWebApp () -getIndexPage = redirect RedirectTemporary JournalPage +getIndexPage = redirect RedirectTemporary BalancePage + +-- | 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' getJournalPage :: Handler HledgerWebApp RepHtml -getJournalPage = withLatestJournalRender (const showTransactions) +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' -getRegisterPage :: Handler HledgerWebApp RepHtml -getRegisterPage = withLatestJournalRender showRegisterReport - -withLatestJournalRender :: ([Opt] -> FilterSpec -> Journal -> String) -> Handler HledgerWebApp RepHtml -withLatestJournalRender reportfn = 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 - -- reload journal if changed, displaying any error as a message - j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - (jE, changed) <- liftIO $ journalReloadIfChanged opts j - let (j', err) = either (\e -> (j,e)) (\j -> (j,"")) jE - when (changed && null err) $ liftIO $ putValue "hledger" "journal" j' - if (changed && not (null err)) then setMessage $ string "error while reading" - else return () - -- run the specified report using this request's params - let s = reportfn opts fspec j' - -- render the standard template - msg' <- getMessage - -- XXX work around a bug, can't get the message we set above - let msg = if null err then msg' else Just $ string $ printf "Error while reading %s" (filepath j') - Just here <- getCurrentRoute - hamletToRepHtml $ pageLayout td{here=here, title="hledger", msg=msg, a=a, p=p, content=stringToPre s} - --- XXX duplication of withLatestJournalRender -getEditPage :: Handler HledgerWebApp RepHtml -getEditPage = do - -- app <- getYesod - -- t <- liftIO $ getCurrentLocalTime - a <- fromMaybe "" <$> lookupGetParam "a" - p <- fromMaybe "" <$> lookupGetParam "p" - -- opts = appOpts app ++ [Period p] - -- args = appArgs app ++ [a] - -- fspec = optsToFilterSpec opts args t - -- reload journal's text, without parsing, if changed - j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - changed <- liftIO $ journalFileIsNewer j - -- XXX readFile may throw an error - s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) - -- render the page - msg <- getMessage - Just here <- getCurrentRoute - -- XXX mucking around to squeeze editform into pageLayout - let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=(editform td') show, contentplain=s} - hamletToRepHtml $ pageLayout td' - --- XXX duplication of withLatestJournalRender getBalancePage :: Handler HledgerWebApp RepHtml getBalancePage = 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 - -- reload journal if changed, displaying any error as a message - j <- liftIO $ fromJust `fmap` getValue "hledger" "journal" - (jE, changed) <- liftIO $ journalReloadIfChanged opts j - let (j', err) = either (\e -> (j,e)) (\j -> (j,"")) jE - when (changed && null err) $ liftIO $ putValue "hledger" "journal" j' - if (changed && not (null err)) then setMessage $ string "error while reading" - else return () - Just here <- getCurrentRoute - msg' <- getMessage - -- XXX work around a misfeature, can't get a message we just set in this request - let msg = if null err then msg' else Just $ string $ printf "Error while reading %s" (filepath j') - -- run and render the report - let td' = td{here=here, title="hledger", msg=msg, a=a, p=p - ,content=(balanceReportToHtml opts td' $ balanceReport opts fspec j')} - hamletToRepHtml $ pageLayout td' + (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' -- | Render a balance report as HTML. -balanceReportToHtml :: [Opt] -> TemplateData -> BalanceReport -> Html () -balanceReportToHtml _ td (items,total) = [$hamlet| -%table +balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Html () +balanceReportAsHtml _ td (items,total) = [$hamlet| +%table.balancereport $forall items i - ^itemToHtml' i^ - %tr - %td!colspan=2!style="border-top:1px black solid;" + %tr.itemrule + %td!colspan=2 + ^itemAsHtml' i^ + %tr.totalrule + %td!colspan=2 %tr %td - %td!align=right $mixedAmountToHtml.total$ + %td!align=right $mixedAmountAsHtml.total$ |] id where - itemToHtml' = itemToHtml td - itemToHtml :: TemplateData -> BalanceReportItem -> Hamlet String - itemToHtml TD{p=p} (a, adisplay, adepth, abal) = [$hamlet| - %tr - %td + 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!align=right $mixedAmountToHtml.abal$ + %td.balance!align=right $mixedAmountAsHtml.abal$ |] 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 -mixedAmountToHtml = intercalate ", " . lines . show +--mixedAmountAsHtml = intercalate ", " . lines . show +mixedAmountAsHtml = preEscapedString . intercalate "
" . lines . show + +getRegisterPage :: Handler HledgerWebApp RepHtml +getRegisterPage = do + (a, p, opts, fspec, j, msg, here) <- getHandlerParameters + let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content= + registerReportAsHtml opts td' $ registerReport opts fspec j + } + hamletToRepHtml $ pageLayout td' + +-- | Render a register report as HTML. +registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Html () +registerReportAsHtml _ td items = [$hamlet| +%table.registerreport + $forall items i + %tr.itemrule + %td!colspan=5 + ^itemAsHtml' i^ +|] id + where + itemAsHtml' = itemAsHtml td + itemAsHtml :: TemplateData -> RegisterReportItem -> Hamlet String + itemAsHtml TD{p=p} (ds, posting, b) = [$hamlet| + %tr.item + %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 + (date, desc) = case ds of Just (da, de) -> (show da, de) + Nothing -> ("", "") + acct = paccount posting + aurl = printf "../register?a=^%s%s" acct p' :: String + p' = if null p then "" else printf "&p=%s" p + +queryStringFromAP a p = if null ap then "" else "?" ++ ap + where + ap = intercalate "&" [a',p'] + a' = if null a then "" else printf "&a=%s" a + p' = if null p then "" else printf "&p=%s" p + +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' = td{here=here, title="hledger", msg=msg, a=a, p=p, + content=(editform td') show, contentplain=s} -- XXX provide both to squeeze editform into pageLayout + hamletToRepHtml $ pageLayout td' postJournalPage :: Handler HledgerWebApp RepPlain postJournalPage = do diff --git a/Hledger/Cli/Tests.hs b/Hledger/Cli/Tests.hs index 6bb971436..c40b18073 100644 --- a/Hledger/Cli/Tests.hs +++ b/Hledger/Cli/Tests.hs @@ -109,7 +109,7 @@ tests = TestList [ let (opts,args) `gives` es = do l <- samplejournalwithopts opts args t <- getCurrentLocalTime - showBalanceReport opts (balanceReport opts (optsToFilterSpec opts args t) l) `is` unlines es + balanceReportAsText opts (balanceReport opts (optsToFilterSpec opts args t) l) `is` unlines es in TestList [ @@ -245,7 +245,7 @@ tests = TestList [ ," c:d " ]) >>= either error return let j' = journalCanonicaliseAmounts $ journalConvertAmountsToCost j -- enable cost basis adjustment - showBalanceReport [] (balanceReport [] nullfilterspec j') `is` + balanceReportAsText [] (balanceReport [] nullfilterspec j') `is` unlines [" $500 a:b" ," $-500 c:d" @@ -260,7 +260,7 @@ tests = TestList [ ," test:a 1" ," test:b" ]) - showBalanceReport [] (balanceReport [] nullfilterspec l) `is` + balanceReportAsText [] (balanceReport [] nullfilterspec l) `is` unlines [" 1 test:a" ," -1 test:b" @@ -458,7 +458,7 @@ tests = TestList [ "register report with no args" ~: do l <- samplejournal - showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" @@ -476,7 +476,7 @@ tests = TestList [ do let opts = [Cleared] l <- readJournalWithOpts opts sample_journal_str - showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines ["2008/06/03 eat & shop expenses:food $1 $1" ," expenses:supplies $1 $2" ," assets:cash $-2 0" @@ -488,7 +488,7 @@ tests = TestList [ do let opts = [UnCleared] l <- readJournalWithOpts opts sample_journal_str - showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines ["2008/01/01 income assets:bank:checking $1 $1" ," income:salary $-1 0" ,"2008/06/01 gift assets:bank:checking $1 $1" @@ -508,19 +508,19 @@ tests = TestList [ ," e 1" ," f" ] - registerdates (showRegisterReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"] + registerdates (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` ["2008/01/01","2008/02/02"] ,"register report with account pattern" ~: do l <- samplejournal - showRegisterReport [] (optsToFilterSpec [] ["cash"] t1) l `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cash"] t1) l) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] ,"register report with account pattern, case insensitive" ~: do l <- samplejournal - showRegisterReport [] (optsToFilterSpec [] ["cAsH"] t1) l `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] ["cAsH"] t1) l) `is` unlines ["2008/06/03 eat & shop assets:cash $-2 $-2" ] @@ -528,7 +528,7 @@ tests = TestList [ do l <- samplejournal let gives displayexpr = - (registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is`) + (registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is`) where opts = [Display displayexpr] "d<[2008/6/2]" `gives` ["2008/01/01","2008/06/01"] "d<=[2008/6/2]" `gives` ["2008/01/01","2008/06/01","2008/06/02"] @@ -541,7 +541,7 @@ tests = TestList [ l <- samplejournal let periodexpr `gives` dates = do l' <- samplejournalwithopts opts [] - registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l') `is` dates + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l') `is` dates where opts = [Period periodexpr] "" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] "2008" `gives` ["2008/01/01","2008/06/01","2008/06/02","2008/06/03","2008/12/31"] @@ -550,7 +550,7 @@ tests = TestList [ "monthly" `gives` ["2008/01/01","2008/06/01","2008/12/01"] "quarterly" `gives` ["2008/01/01","2008/04/01","2008/10/01"] let opts = [Period "yearly"] - showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines ["2008/01/01 - 2008/12/31 assets:bank:saving $1 $1" ," assets:cash $-2 $-1" ," expenses:food $1 0" @@ -560,9 +560,9 @@ tests = TestList [ ," liabilities:debts $1 0" ] let opts = [Period "quarterly"] - registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/10/01"] let opts = [Period "quarterly",Empty] - registerdates (showRegisterReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] + registerdates (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` ["2008/01/01","2008/04/01","2008/07/01","2008/10/01"] ] @@ -570,7 +570,7 @@ tests = TestList [ do l <- samplejournal let opts = [Depth "2"] - showRegisterReport opts (optsToFilterSpec opts [] t1) l `is` unlines + (registerReportAsText opts $ registerReport opts (optsToFilterSpec opts [] t1) l) `is` unlines ["2008/01/01 income income:salary $-1 $-1" ,"2008/06/01 gift income:gifts $-1 $-2" ,"2008/06/03 eat & shop expenses:food $1 $-1" @@ -586,7 +586,7 @@ tests = TestList [ ,"unicode in balance layout" ~: do l <- readJournalWithOpts [] "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - showBalanceReport [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines + balanceReportAsText [] (balanceReport [] (optsToFilterSpec [] [] t1) l) `is` unlines [" -100 актив:наличные" ," 100 расходы:покупки" ,"--------------------" @@ -596,7 +596,7 @@ tests = TestList [ ,"unicode in register layout" ~: do l <- readJournalWithOpts [] "2009/01/01 * медвежья шкура\n расходы:покупки 100\n актив:наличные\n" - showRegisterReport [] (optsToFilterSpec [] [] t1) l `is` unlines + (registerReportAsText [] $ registerReport [] (optsToFilterSpec [] [] t1) l) `is` unlines ["2009/01/01 медвежья шкура расходы:покупки 100 100" ," актив:наличные -100 0"] diff --git a/data/web/style.css b/data/web/style.css index d314ea128..8e5ed18da 100644 --- a/data/web/style.css +++ b/data/web/style.css @@ -25,3 +25,16 @@ body { font-family: "helvetica","arial", "sans serif"; margin:0; } /* for -fweb610 */ #hledgerorglink, #helplink { float:right; margin-left:1em; } + +/* .balancereport { font-size:small; } */ +.balancereport tr { vertical-align:top; } +/* .itemrule td { border-top:thin solid #ddd; } */ +.totalrule td { border-top:thin solid black; } + +.registerreport { font-size:small; } +.registerreport tr { vertical-align:top; } +.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; }