diff --git a/Hledger/Cli/Commands/Web.hs b/Hledger/Cli/Commands/Web.hs index 111da2e4c..e633bf96f 100644 --- a/Hledger/Cli/Commands/Web.hs +++ b/Hledger/Cli/Commands/Web.hs @@ -8,7 +8,7 @@ where import Control.Concurrent (forkIO, threadDelay) import Control.Applicative ((<$>), (<*>)) import Data.Either -import System.FilePath (()) +import System.FilePath ((), takeFileName) import System.IO.Storage (withStore, putValue, getValue) import Text.ParserCombinators.Parsec (parse) import Yesod @@ -64,8 +64,9 @@ data TemplateData = TD { here :: HledgerWebAppRoute -- ^ the current page's route ,title :: String -- ^ page's title ,msg :: Maybe (Html ()) -- ^ transient message - ,a :: String -- ^ a (filter pattern) parameter + ,a :: String -- ^ a (acct/desc filter pattern) parameter ,p :: String -- ^ p (period expression) parameter + ,j :: Journal -- ^ the current journal } mktd = TD { @@ -74,6 +75,7 @@ mktd = TD { ,msg = Nothing ,a = "" ,p = "" + ,j = nulljournal } -- | The web command. @@ -165,11 +167,150 @@ getIndexPage = redirect RedirectTemporary defaultpage ---------------------------------------------------------------------- +-- | A combined accounts and journal view. +getAccountsJournalPage :: Handler HledgerWebApp RepHtml +getAccountsJournalPage = do + (a, p, opts, fspec, j, msg, here) <- getHandlerParameters + -- app <- getYesod + -- t <- liftIO $ getCurrentLocalTime + let -- args = appArgs app + -- fspec' = optsToFilterSpec opts args t + br = balanceReportAsHtml opts td $ balanceReport opts fspec j + jr = journalReportAsHtml opts td $ journalReport opts fspec j + td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} + editform' = editform td $ jtext j + hamletToRepHtml $ pageLayout td [$hamlet| +^scripts^ +%div.ledger + %div.accounts!style=float:left; ^br^ + ^navlinks.td^ + ^addform^ + ^editform'^ + %div#transactions.journal + ^filterform.td^ + ^jr^ +|] + +postAccountsJournalPage :: Handler HledgerWebApp RepPlain +postAccountsJournalPage = postJournalOnlyPage + +---------------------------------------------------------------------- + +-- | A combined accounts and register view. +getAccountsRegisterPage :: Handler HledgerWebApp RepHtml +getAccountsRegisterPage = do + (a, p, opts, fspec, j, msg, here) <- getHandlerParameters + -- app <- getYesod + -- t <- liftIO $ getCurrentLocalTime + let -- args = appArgs app + -- opts' = Empty:opts + -- 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, j=j} + editform' = editform td $ jtext j + hamletToRepHtml $ pageLayout td [$hamlet| +^scripts^ +%div.ledger + %div.accounts!style=float:left; ^br^ + ^navlinks.td^ + ^addform^ + ^editform'^ + %div#transactions.register + ^filterform.td^ + ^rr^ +|] + +postAccountsRegisterPage :: Handler HledgerWebApp RepPlain +postAccountsRegisterPage = postJournalOnlyPage + +---------------------------------------------------------------------- + +-- | A simple accounts and balances view like hledger balance. +getAccountsPage :: Handler HledgerWebApp RepHtml +getAccountsPage = do + (a, p, opts, fspec, j, msg, here) <- getHandlerParameters + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} + hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j + +-- | Render a balance report as HTML. +balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet HledgerWebAppRoute +balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [$hamlet| +%table.balancereport + ^allaccts^ + $forall items i + ^itemAsHtml' i^ + %tr.totalrule + %td!colspan=2 + %tr + %td + %td!align=right $mixedAmountAsHtml.total$ +|] + where + filtering = not $ null a && null p + showmore = if filtering then [$hamlet| +^showmore'^ +\ | $ +%a!href=@here@ show all +|] else nulltemplate + showmore' = case (filtering, items) of + -- cunning parent account logic + (True, ((acct, _, _, _):_)) -> + let a' = if isAccountRegex a then a else acct + a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a' + parenturl = (here, [("a",a''), ("p",p)]) + in [$hamlet| + \ | $ + %a!href=@?parenturl@ show more ↑ + |] + _ -> nulltemplate + allacctslink = True + allaccts = if allacctslink + then -- [$hamlet|%tr.$current$ + -- %td + -- %a!href=@?u@ all accounts + -- %td + [$hamlet| +accounts +\ $ +%span#showmoreaccounts ^showmore^ +
+
+|] + else nulltemplate + -- where u = (here, [("a",".*"),("p",p)]) + -- current = "" -- if a == ".*" then "current" else "" + itemAsHtml' = itemAsHtml td + itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet HledgerWebAppRoute + itemAsHtml TD{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 + if allacctslink then 1 else 0)) " " + aurl = printf ".?a=%s%s" (accountNameToAccountRegex acct) p' :: String + p' = if null p then "" else printf "&p=%s" p + +accountNameToAccountRegex :: String -> String +accountNameToAccountRegex "" = "" +accountNameToAccountRegex a = printf "^%s(:|$)" a + +accountRegexToAccountName :: String -> String +accountRegexToAccountName = gsubRegexPR "^\\^(.*?)\\(:\\|\\$\\)$" "\\1" + +isAccountRegex :: String -> Bool +isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:(" + +---------------------------------------------------------------------- + -- | A basic journal view, like hledger print, with editing. getJournalOnlyPage :: Handler HledgerWebApp RepHtml getJournalOnlyPage = do (a, p, opts, fspec, j, msg, here) <- getHandlerParameters - let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} editform' = editform td $ jtext j txns = journalReportAsHtml opts td $ journalReport opts fspec j hamletToRepHtml $ pageLayout td [$hamlet| @@ -222,7 +363,7 @@ addform = [$hamlet| %tr.helprow %td %td - .help $datehelp$ ^datehelplink^ $ + .help $datehelp$ $ %td %td .help $deschelp$ @@ -234,7 +375,7 @@ addform = [$hamlet| %input!type=submit!name=submit!value="add transaction" |] where - datehelplink = helplink "dates" "..." + -- datehelplink = helplink "dates" "..." datehelp = "eg: 7/20, 2010/1/1, " deschelp = "eg: supermarket (optional)" date = "today" @@ -471,91 +612,11 @@ postEditForm = do ---------------------------------------------------------------------- --- | A simple accounts and balances view like hledger balance. -getAccountsPage :: Handler HledgerWebApp RepHtml -getAccountsPage = 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@TD{here=here,a=a,p=p} (items,total) = [$hamlet| -%table.balancereport - ^allaccts^ - $forall items i - ^itemAsHtml' i^ - %tr.totalrule - %td!colspan=2 - %tr - %td - %td!align=right $mixedAmountAsHtml.total$ -|] - where - filtering = not $ null a && null p - showmore = if filtering then [$hamlet| -^showmore'^ -\ | $ -%a!href=@here@ show all -|] else nulltemplate - showmore' = case (filtering, items) of - -- cunning parent account logic - (True, ((acct, _, _, _):_)) -> - let a' = if isAccountRegex a then a else acct - a'' = accountNameToAccountRegex $ parentAccountName $ accountRegexToAccountName a' - parenturl = (here, [("a",a''), ("p",p)]) - in [$hamlet| - \ | $ - %a!href=@?parenturl@ show more - |] - _ -> nulltemplate - allacctslink = True - allaccts = if allacctslink - then -- [$hamlet|%tr.$current$ - -- %td - -- %a!href=@?u@ all accounts - -- %td - [$hamlet| -accounts -\ $ -%span#showmoreaccounts ^showmore^ -
-
-|] - else nulltemplate - where u = (here, [("a",".*"),("p",p)]) - current = "" -- if a == ".*" then "current" else "" - 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 + if allacctslink then 1 else 0)) " " - aurl = printf ".?a=%s%s" (accountNameToAccountRegex acct) p' :: String - p' = if null p then "" else printf "&p=%s" p - -accountNameToAccountRegex :: String -> String -accountNameToAccountRegex "" = "" -accountNameToAccountRegex a = printf "^%s(:|$)" a - -accountRegexToAccountName :: String -> String -accountRegexToAccountName = gsubRegexPR "^\\^(.*?)\\(:\\|\\$\\)$" "\\1" - -isAccountRegex :: String -> Bool -isAccountRegex s = take 1 s == "^" && (take 5 $ reverse s) == ")$|:(" - ----------------------------------------------------------------------- - -- | A simple postings view like hledger register. getRegisterOnlyPage :: Handler HledgerWebApp RepHtml getRegisterOnlyPage = do (a, p, opts, fspec, j, msg, here) <- getHandlerParameters - let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j -- | Render a register report as HTML. @@ -596,74 +657,15 @@ mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "
" $ lines $ getEditPage :: Handler HledgerWebApp RepHtml getEditPage = do (a, p, _, _, _, msg, here) <- getHandlerParameters - -- reload journal's text without parsing, if changed + -- reload journal's text without parsing, if changed -- XXX are we doing this right ? 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} + let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p, j=j} hamletToRepHtml $ pageLayout td $ editform td s ---------------------------------------------------------------------- --- | A combined accounts and journal view. -getAccountsJournalPage :: Handler HledgerWebApp RepHtml -getAccountsJournalPage = do - (a, p, opts, fspec, j, msg, here) <- getHandlerParameters - app <- getYesod - t <- liftIO $ getCurrentLocalTime - let args = appArgs app - fspec' = optsToFilterSpec opts args t - br = balanceReportAsHtml opts td $ balanceReport opts fspec j - jr = journalReportAsHtml opts td $ journalReport opts fspec j - td = mktd{here=here, title="hledger", msg=msg, a=a, p=p} - editform' = editform td $ jtext j - hamletToRepHtml $ pageLayout td [$hamlet| -^scripts^ -%div.ledger - %div.accounts!style=float:left; ^br^ - ^navlinks.td^ - ^addform^ - ^editform'^ - %div#transactions.journal - ^filterform.td^ - ^jr^ -|] - -postAccountsJournalPage :: Handler HledgerWebApp RepPlain -postAccountsJournalPage = postJournalOnlyPage - ----------------------------------------------------------------------- - --- | A combined accounts and register view. -getAccountsRegisterPage :: Handler HledgerWebApp RepHtml -getAccountsRegisterPage = do - (a, p, opts, fspec, j, msg, here) <- getHandlerParameters - app <- getYesod - t <- liftIO $ getCurrentLocalTime - let args = appArgs app - -- opts' = Empty:opts - -- 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} - editform' = editform td $ jtext j - hamletToRepHtml $ pageLayout td [$hamlet| -^scripts^ -%div.ledger - %div.accounts!style=float:left; ^br^ - ^navlinks.td^ - ^addform^ - ^editform'^ - %div#transactions.register - ^filterform.td^ - ^rr^ -|] - -postAccountsRegisterPage :: Handler HledgerWebApp RepPlain -postAccountsRegisterPage = postJournalOnlyPage - ----------------------------------------------------------------------- - -- | Wrap a template with the standard hledger web ui page layout. pageLayout :: TemplateData -> Hamlet HledgerWebAppRoute -> Hamlet HledgerWebAppRoute pageLayout td@TD{title=title, msg=msg} content = [$hamlet| @@ -675,21 +677,24 @@ pageLayout td@TD{title=title, msg=msg} content = [$hamlet| %link!rel=stylesheet!type=text/css!href=@StyleCss@!media=all %body ^navbar.td^ + #messages $m$ #content - #messages $m$ ^content^ |] where m = fromMaybe (string "") msg metacontent = "text/html; charset=utf-8" navbar :: TemplateData -> Hamlet HledgerWebAppRoute -navbar _ = [$hamlet| +navbar TD{j=j} = [$hamlet| #navbar - %a.toprightlink!href=$hledgerurl$ hledger $version$ - \ $ + %a.topleftlink!href=$hledgerurl$ + hledger +
+ $version$ %a.toprightlink!href=$manualurl$!target=hledgerhelp manual - \ $ + %h1 $journaltitle$ |] + where journaltitle = printf "%s" (takeFileName $ filepath j) :: String navlinks :: TemplateData -> Hamlet HledgerWebAppRoute navlinks td = [$hamlet| @@ -698,9 +703,9 @@ navlinks td = [$hamlet| \ | $ ^accountsregisterlink^ \ | $ - %a#editformlink!href!onclick="return editformToggle()" edit journal - \ | $ %a#addformlink!href!onclick="return addformToggle()" add transaction + \ | $ + %a#editformlink!href!onclick="return editformToggle()" edit journal |] where accountsjournallink = navlink td "journal" AccountsJournalPage @@ -735,10 +740,10 @@ filterform TD{here=here,a=a,p=p} = [$hamlet| where ahelp = helplink "filter-patterns" "?" phelp = helplink "period-expressions" "?" - (filtering, visible, filterformlabel, stopfiltering) + (filtering, visible, _, stopfiltering) | null a && null p = ("", defaultdisplay, [$hamlet|%a#filterformlink!href!onclick="return filterformToggle()" filter...|], nulltemplate) -- [$hamlet|filter by $|]) | otherwise = ("filtering", defaultdisplay, [$hamlet|filtering...|], [$hamlet|%a#stopfilterlink!href=@here@ stop filtering|]) - defaultdisplay = "none" + defaultdisplay = "block" helplink :: String -> String -> Hamlet HledgerWebAppRoute helplink topic label = [$hamlet|%a!href=$u$!target=hledgerhelp $label$|] diff --git a/data/web/style.css b/data/web/style.css index 607c3adad..58606e677 100644 --- a/data/web/style.css +++ b/data/web/style.css @@ -8,7 +8,9 @@ pre { font-family:courier,"courier new",monospace; } #editform textarea { font-family:courier,"courier new",monospace; font-size:small; } .nav2 { font-size:small; } #filterform { font-size:small; } +.topleftlink { font-size:small; } .toprightlink { font-size:small; } +#journalinfo { font-size:small; } .help { font-size:smaller; } .form { font-size:small; } .journalreport { font-size:small; } @@ -19,9 +21,12 @@ pre { font-family:courier,"courier new",monospace; } /* #editformlink { font-size:small; } */ body { margin:0; } -#navbar { padding:0px 6px; } +#navbar { padding:2px; } +.topleftlink { float:left; margin-right:1em; padding:2px; } +.toprightlink { float:right; margin-left:1em; padding:2px; } +#navbar h1 { display:inline-block; vertical-align:top; margin:0; } +#journalinfo { vertical-align:middle; margin:0; } /* #navbar { padding:4px; background-color:#eee; border-bottom:2px solid #ddd; } */ -.toprightlink { margin-left:1em; float:right; } #messages { color:red; background-color:#ffeeee; margin:0.5em;} .help { font-style: italic; } .helprow td { padding-bottom:8px; } @@ -49,14 +54,14 @@ body { margin:0; } /* .even { background-color:#e8f8e8; } */ /* .even { background-color:#f0fff0; } */ -table.journalreport { } +table.journalreport { border-spacing: 0; } .journalreport td { border-top:thin solid #eee; } .journalreport pre { margin-top:0; } -.ledger .accounts {padding-right:1em; margin-right:1em; border-right:thin solid #eee;} +.ledger .accounts {padding-right:1em; margin-right:1em; border-right:thin solid #eee; } .ledger .register { } -div.accounts { padding-bottom: 10em; } +div.accounts { margin-bottom:5em; } .balancereport tr { vertical-align:top; } table.balancereport { border-spacing:0; }