web: refactor; show journal file name in heading
This commit is contained in:
Simon Michael
parent
cf4e1fd722
commit
bd3d8b1c8d
@ -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^
|
||||
<br />
|
||||
<br />
|
||||
|]
|
||||
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^
|
||||
<br />
|
||||
<br />
|
||||
|]
|
||||
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 "<br>" $ 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^
|
||||
#content
|
||||
#messages $m$
|
||||
#content
|
||||
^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
|
||||
<br />
|
||||
$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$|]
|
||||
|
||||
@ -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; }
|
||||
|
||||
Loading…
Reference in New Issue
Block a user