web: next ui refinement.. accounts are now a permanent sidebar
This commit is contained in:
parent
41c175ecc8
commit
cf4e1fd722
@ -46,18 +46,18 @@ data HledgerWebApp = HledgerWebApp {
|
|||||||
}
|
}
|
||||||
|
|
||||||
mkYesod "HledgerWebApp" [$parseRoutes|
|
mkYesod "HledgerWebApp" [$parseRoutes|
|
||||||
/ IndexPage GET
|
/ IndexPage GET
|
||||||
/journal JournalPage GET POST
|
/style.css StyleCss GET
|
||||||
/register RegisterPage GET
|
/journalonly JournalOnlyPage GET POST
|
||||||
/balance BalancePage GET
|
/registeronly RegisterOnlyPage GET
|
||||||
/ledger LedgerPage GET
|
/accounts AccountsPage GET
|
||||||
/style.css StyleCss GET
|
/journal AccountsJournalPage GET POST
|
||||||
|
/register AccountsRegisterPage GET POST
|
||||||
|]
|
|]
|
||||||
|
|
||||||
instance Yesod HledgerWebApp where approot = appRoot
|
instance Yesod HledgerWebApp where approot = appRoot
|
||||||
|
|
||||||
-- defaultroute = LedgerPage
|
defaultpage = AccountsJournalPage
|
||||||
defaultroute = JournalPage
|
|
||||||
|
|
||||||
-- | A bundle of useful data passed to templates.
|
-- | A bundle of useful data passed to templates.
|
||||||
data TemplateData = TD {
|
data TemplateData = TD {
|
||||||
@ -106,6 +106,49 @@ server baseurl port opts args j = do
|
|||||||
putValue "hledger" "journal" j
|
putValue "hledger" "journal" j
|
||||||
basicHandler' port Nothing app
|
basicHandler' port Nothing app
|
||||||
|
|
||||||
|
-- | 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
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
-- handlers & templates
|
-- handlers & templates
|
||||||
|
|
||||||
@ -115,21 +158,23 @@ getStyleCss = do
|
|||||||
let dir = appWebdir app
|
let dir = appWebdir app
|
||||||
sendFile "text/css" $ dir </> "style.css"
|
sendFile "text/css" $ dir </> "style.css"
|
||||||
|
|
||||||
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
getIndexPage :: Handler HledgerWebApp ()
|
getIndexPage :: Handler HledgerWebApp ()
|
||||||
getIndexPage = redirect RedirectTemporary defaultroute
|
getIndexPage = redirect RedirectTemporary defaultpage
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
-- | A basic journal view, like hledger print, with editing.
|
-- | A basic journal view, like hledger print, with editing.
|
||||||
getJournalPage :: Handler HledgerWebApp RepHtml
|
getJournalOnlyPage :: Handler HledgerWebApp RepHtml
|
||||||
getJournalPage = do
|
getJournalOnlyPage = do
|
||||||
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
|
(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}
|
||||||
editform' = editform td $ jtext j
|
editform' = editform td $ jtext j
|
||||||
txns = journalReportAsHtml opts td $ journalReport opts fspec j
|
txns = journalReportAsHtml opts td $ journalReport opts fspec j
|
||||||
hamletToRepHtml $ pageLayout td [$hamlet|
|
hamletToRepHtml $ pageLayout td [$hamlet|
|
||||||
%div.journal
|
%div.journal
|
||||||
^journalScripts^
|
^scripts^
|
||||||
%div.nav2
|
%div.nav2
|
||||||
%a#addformlink!href!onclick="return addformToggle()" add one transaction
|
%a#addformlink!href!onclick="return addformToggle()" add one transaction
|
||||||
\ | $
|
\ | $
|
||||||
@ -254,21 +299,38 @@ editform _ content = [$hamlet|
|
|||||||
where
|
where
|
||||||
formathelp = helplink "file-format" "file format help"
|
formathelp = helplink "file-format" "file format help"
|
||||||
|
|
||||||
journalScripts = [$hamlet|
|
scripts = [$hamlet|
|
||||||
<script type="text/javascript">
|
<script type="text/javascript">
|
||||||
|
|
||||||
|
function filterformToggle() {
|
||||||
|
f = document.getElementById('filterform');
|
||||||
|
flink = document.getElementById('filterformlink');
|
||||||
|
if (f.style.display == 'none') {
|
||||||
|
flink.style['font-weight'] = 'bold';
|
||||||
|
f.style.display = 'block';
|
||||||
|
} else {
|
||||||
|
flink.style['font-weight'] = 'normal';
|
||||||
|
f.style.display = 'none';
|
||||||
|
}
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
|
||||||
function addformToggle() {
|
function addformToggle() {
|
||||||
a = document.getElementById('addform');
|
a = document.getElementById('addform');
|
||||||
e = document.getElementById('editform');
|
e = document.getElementById('editform');
|
||||||
t = document.getElementById('transactions');
|
t = document.getElementById('transactions');
|
||||||
alink = document.getElementById('addformlink');
|
alink = document.getElementById('addformlink');
|
||||||
elink = document.getElementById('editformlink');
|
elink = document.getElementById('editformlink');
|
||||||
|
jlink = document.getElementById('journallink');
|
||||||
|
rlink = document.getElementById('registerlink');
|
||||||
if (a.style.display == 'none') {
|
if (a.style.display == 'none') {
|
||||||
alink.style['font-weight'] = 'bold';
|
alink.style['font-weight'] = 'bold';
|
||||||
elink.style['font-weight'] = 'normal';
|
elink.style['font-weight'] = 'normal';
|
||||||
|
jlink.style['font-weight'] = 'normal';
|
||||||
|
rlink.style['font-weight'] = 'normal';
|
||||||
a.style.display = 'block';
|
a.style.display = 'block';
|
||||||
e.style.display = 'none';
|
e.style.display = 'none';
|
||||||
t.style.display = 'block';
|
t.style.display = 'none';
|
||||||
} else {
|
} else {
|
||||||
alink.style['font-weight'] = 'normal';
|
alink.style['font-weight'] = 'normal';
|
||||||
elink.style['font-weight'] = 'normal';
|
elink.style['font-weight'] = 'normal';
|
||||||
@ -285,9 +347,13 @@ journalScripts = [$hamlet|
|
|||||||
t = document.getElementById('transactions');
|
t = document.getElementById('transactions');
|
||||||
alink = document.getElementById('addformlink');
|
alink = document.getElementById('addformlink');
|
||||||
elink = document.getElementById('editformlink');
|
elink = document.getElementById('editformlink');
|
||||||
|
jlink = document.getElementById('journallink');
|
||||||
|
rlink = document.getElementById('registerlink');
|
||||||
if (e.style.display == 'none') {
|
if (e.style.display == 'none') {
|
||||||
alink.style['font-weight'] = 'normal';
|
alink.style['font-weight'] = 'normal';
|
||||||
elink.style['font-weight'] = 'bold';
|
elink.style['font-weight'] = 'bold';
|
||||||
|
jlink.style['font-weight'] = 'normal';
|
||||||
|
rlink.style['font-weight'] = 'normal';
|
||||||
a.style.display = 'none';
|
a.style.display = 'none';
|
||||||
e.style.display = 'block';
|
e.style.display = 'block';
|
||||||
t.style.display = 'none';
|
t.style.display = 'none';
|
||||||
@ -304,8 +370,8 @@ journalScripts = [$hamlet|
|
|||||||
</script>
|
</script>
|
||||||
|]
|
|]
|
||||||
|
|
||||||
postJournalPage :: Handler HledgerWebApp RepPlain
|
postJournalOnlyPage :: Handler HledgerWebApp RepPlain
|
||||||
postJournalPage = do
|
postJournalOnlyPage = do
|
||||||
edit <- runFormPost' $ maybeStringInput "edit"
|
edit <- runFormPost' $ maybeStringInput "edit"
|
||||||
if isJust edit then postEditForm else postAddForm
|
if isJust edit then postEditForm else postAddForm
|
||||||
|
|
||||||
@ -356,14 +422,14 @@ postAddForm = do
|
|||||||
Left errs -> do
|
Left errs -> do
|
||||||
-- save current form values in session
|
-- save current form values in session
|
||||||
setMessage $ string $ intercalate "; " errs
|
setMessage $ string $ intercalate "; " errs
|
||||||
redirect RedirectTemporary JournalPage
|
redirect RedirectTemporary AccountsRegisterPage
|
||||||
|
|
||||||
Right t -> do
|
Right t -> do
|
||||||
let t' = txnTieKnot t -- XXX move into balanceTransaction
|
let t' = txnTieKnot t -- XXX move into balanceTransaction
|
||||||
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
|
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
|
||||||
liftIO $ journalAddTransaction j opts t'
|
liftIO $ journalAddTransaction j opts t'
|
||||||
setMessage $ string $ printf "Added transaction:\n%s" (show t')
|
setMessage $ string $ printf "Added transaction:\n%s" (show t')
|
||||||
redirect RedirectTemporary JournalPage
|
redirect RedirectTemporary AccountsRegisterPage
|
||||||
|
|
||||||
-- | Handle a journal edit form post.
|
-- | Handle a journal edit form post.
|
||||||
postEditForm :: Handler HledgerWebApp RepPlain
|
postEditForm :: Handler HledgerWebApp RepPlain
|
||||||
@ -376,7 +442,7 @@ postEditForm = do
|
|||||||
Left errs -> do
|
Left errs -> do
|
||||||
-- XXX should save current form values in session
|
-- XXX should save current form values in session
|
||||||
setMessage $ string errs
|
setMessage $ string errs
|
||||||
redirect RedirectTemporary JournalPage
|
redirect RedirectTemporary AccountsJournalPage
|
||||||
|
|
||||||
Right t' -> do
|
Right t' -> do
|
||||||
-- try to avoid unnecessary backups or saving invalid data
|
-- try to avoid unnecessary backups or saving invalid data
|
||||||
@ -390,55 +456,33 @@ postEditForm = do
|
|||||||
if not changed
|
if not changed
|
||||||
then do
|
then do
|
||||||
setMessage $ string $ "No change"
|
setMessage $ string $ "No change"
|
||||||
redirect RedirectTemporary JournalPage
|
redirect RedirectTemporary AccountsJournalPage
|
||||||
else do
|
else do
|
||||||
jE <- liftIO $ journalFromPathAndString Nothing f tnew
|
jE <- liftIO $ journalFromPathAndString Nothing f tnew
|
||||||
either
|
either
|
||||||
(\e -> do
|
(\e -> do
|
||||||
setMessage $ string e
|
setMessage $ string e
|
||||||
redirect RedirectTemporary JournalPage)
|
redirect RedirectTemporary AccountsJournalPage)
|
||||||
(const $ do
|
(const $ do
|
||||||
liftIO $ writeFileWithBackup f tnew
|
liftIO $ writeFileWithBackup f tnew
|
||||||
setMessage $ string $ printf "Saved journal %s\n" (show f)
|
setMessage $ string $ printf "Saved journal %s\n" (show f)
|
||||||
redirect RedirectTemporary JournalPage)
|
redirect RedirectTemporary AccountsJournalPage)
|
||||||
jE
|
jE
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
-- | A combined accounts and postings view, like hledger balance + hledger register.
|
-- | A simple accounts and balances view like hledger balance.
|
||||||
getLedgerPage :: Handler HledgerWebApp RepHtml
|
getAccountsPage :: Handler HledgerWebApp RepHtml
|
||||||
getLedgerPage = do
|
getAccountsPage = 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 = if null a && null p && not showpostingsbydefault
|
|
||||||
then nulltemplate
|
|
||||||
else 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^
|
|
||||||
|]
|
|
||||||
showpostingsbydefault = False
|
|
||||||
|
|
||||||
----------------------------------------------------------------------
|
|
||||||
|
|
||||||
-- | An accounts and balances view, like hledger balance.
|
|
||||||
getBalancePage :: Handler HledgerWebApp RepHtml
|
|
||||||
getBalancePage = do
|
|
||||||
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
|
(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}
|
||||||
hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j
|
hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j
|
||||||
|
|
||||||
-- | Render a balance report as HTML.
|
-- | Render a balance report as HTML.
|
||||||
balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet HledgerWebAppRoute
|
balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet HledgerWebAppRoute
|
||||||
balanceReportAsHtml _ td (items,total) = [$hamlet|
|
balanceReportAsHtml _ td@TD{here=here,a=a,p=p} (items,total) = [$hamlet|
|
||||||
%table.balancereport
|
%table.balancereport
|
||||||
|
^allaccts^
|
||||||
$forall items i
|
$forall items i
|
||||||
^itemAsHtml' i^
|
^itemAsHtml' i^
|
||||||
%tr.totalrule
|
%tr.totalrule
|
||||||
@ -448,6 +492,39 @@ balanceReportAsHtml _ td (items,total) = [$hamlet|
|
|||||||
%td!align=right $mixedAmountAsHtml.total$
|
%td!align=right $mixedAmountAsHtml.total$
|
||||||
|]
|
|]
|
||||||
where
|
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' = itemAsHtml td
|
||||||
itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet HledgerWebAppRoute
|
itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet HledgerWebAppRoute
|
||||||
itemAsHtml TD{a=a,p=p} (acct, adisplay, adepth, abal) = [$hamlet|
|
itemAsHtml TD{a=a,p=p} (acct, adisplay, adepth, abal) = [$hamlet|
|
||||||
@ -457,19 +534,26 @@ balanceReportAsHtml _ td (items,total) = [$hamlet|
|
|||||||
%a!href=$aurl$ $adisplay$
|
%a!href=$aurl$ $adisplay$
|
||||||
%td.balance!align=right $mixedAmountAsHtml.abal$
|
%td.balance!align=right $mixedAmountAsHtml.abal$
|
||||||
|] where
|
|] where
|
||||||
current = if not (null a) && containsRegex a acct then "current" else ""
|
current = "" -- if not (null a) && containsRegex a acct then "current" else ""
|
||||||
indent = preEscapedString $ concat $ replicate (2 * adepth) " "
|
indent = preEscapedString $ concat $ replicate (2 * (adepth + if allacctslink then 1 else 0)) " "
|
||||||
aurl = printf "../ledger?a=%s%s" (accountMatchingRegex acct) p' :: String
|
aurl = printf ".?a=%s%s" (accountNameToAccountRegex acct) p' :: String
|
||||||
p' = if null p then "" else printf "&p=%s" p
|
p' = if null p then "" else printf "&p=%s" p
|
||||||
|
|
||||||
accountMatchingRegex :: String -> String
|
accountNameToAccountRegex :: String -> String
|
||||||
accountMatchingRegex = printf "^%s(:|$)"
|
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 postings view, like hledger register.
|
-- | A simple postings view like hledger register.
|
||||||
getRegisterPage :: Handler HledgerWebApp RepHtml
|
getRegisterOnlyPage :: Handler HledgerWebApp RepHtml
|
||||||
getRegisterPage = do
|
getRegisterOnlyPage = do
|
||||||
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
|
(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}
|
||||||
hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j
|
hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j
|
||||||
@ -498,10 +582,9 @@ registerReportAsHtml _ td items = [$hamlet|
|
|||||||
(firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de)
|
(firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de)
|
||||||
Nothing -> ("", "", "")
|
Nothing -> ("", "", "")
|
||||||
acct = paccount posting
|
acct = paccount posting
|
||||||
aurl = printf "../ledger?a=%s%s" (accountMatchingRegex acct) p' :: String
|
aurl = printf ".?a=%s%s" (accountNameToAccountRegex acct) p' :: String
|
||||||
p' = if null p then "" else printf "&p=%s" p
|
p' = if null p then "" else printf "&p=%s" p
|
||||||
|
|
||||||
--mixedAmountAsHtml = intercalate ", " . lines . show
|
|
||||||
mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $ show b
|
mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $ show b
|
||||||
where addclass = printf "<span class=\"%s\">%s</span>" c
|
where addclass = printf "<span class=\"%s\">%s</span>" c
|
||||||
c = case isNegativeMixedAmount b of Just True -> "negative amount"
|
c = case isNegativeMixedAmount b of Just True -> "negative amount"
|
||||||
@ -522,49 +605,66 @@ getEditPage = do
|
|||||||
|
|
||||||
----------------------------------------------------------------------
|
----------------------------------------------------------------------
|
||||||
|
|
||||||
-- | Gather all the stuff we want for a typical hledger web request handler.
|
-- | A combined accounts and journal view.
|
||||||
getHandlerParameters :: Handler HledgerWebApp
|
getAccountsJournalPage :: Handler HledgerWebApp RepHtml
|
||||||
(String, String, [Opt], FilterSpec, Journal, Maybe (Html ()), HledgerWebAppRoute)
|
getAccountsJournalPage = do
|
||||||
getHandlerParameters = do
|
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
|
||||||
Just here <- getCurrentRoute
|
app <- getYesod
|
||||||
(a, p, opts, fspec) <- getReportParameters
|
t <- liftIO $ getCurrentLocalTime
|
||||||
(j, err) <- getLatestJournal opts
|
let args = appArgs app
|
||||||
msg <- getMessage' err
|
fspec' = optsToFilterSpec opts args t
|
||||||
return (a, p, opts, fspec, j, msg, here)
|
br = balanceReportAsHtml opts td $ balanceReport opts fspec j
|
||||||
where
|
jr = journalReportAsHtml opts td $ journalReport opts fspec j
|
||||||
-- | Get current report parameters for this request.
|
td = mktd{here=here, title="hledger", msg=msg, a=a, p=p}
|
||||||
getReportParameters :: Handler HledgerWebApp (String, String, [Opt], FilterSpec)
|
editform' = editform td $ jtext j
|
||||||
getReportParameters = do
|
hamletToRepHtml $ pageLayout td [$hamlet|
|
||||||
app <- getYesod
|
^scripts^
|
||||||
t <- liftIO $ getCurrentLocalTime
|
%div.ledger
|
||||||
a <- fromMaybe "" <$> lookupGetParam "a"
|
%div.accounts!style=float:left; ^br^
|
||||||
p <- fromMaybe "" <$> lookupGetParam "p"
|
^navlinks.td^
|
||||||
let opts = appOpts app ++ [Period p]
|
^addform^
|
||||||
args = appArgs app ++ [a]
|
^editform'^
|
||||||
fspec = optsToFilterSpec opts args t
|
%div#transactions.journal
|
||||||
return (a, p, opts, fspec)
|
^filterform.td^
|
||||||
|
^jr^
|
||||||
|
|]
|
||||||
|
|
||||||
-- | Update our copy of the journal if the file changed. If there is an
|
postAccountsJournalPage :: Handler HledgerWebApp RepPlain
|
||||||
-- error while reloading, keep the old one and return the error, and set a
|
postAccountsJournalPage = postJournalOnlyPage
|
||||||
-- 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
|
|
||||||
|
|
||||||
|
-- | 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 :: TemplateData -> Hamlet HledgerWebAppRoute -> Hamlet HledgerWebAppRoute
|
||||||
pageLayout td@TD{title=title, msg=msg} content = [$hamlet|
|
pageLayout td@TD{title=title, msg=msg} content = [$hamlet|
|
||||||
!!!
|
!!!
|
||||||
@ -575,40 +675,39 @@ pageLayout td@TD{title=title, msg=msg} content = [$hamlet|
|
|||||||
%link!rel=stylesheet!type=text/css!href=@StyleCss@!media=all
|
%link!rel=stylesheet!type=text/css!href=@StyleCss@!media=all
|
||||||
%body
|
%body
|
||||||
^navbar.td^
|
^navbar.td^
|
||||||
#messages $m$
|
|
||||||
#content
|
#content
|
||||||
|
#messages $m$
|
||||||
^content^
|
^content^
|
||||||
|]
|
|]
|
||||||
where m = fromMaybe (string "") msg
|
where m = fromMaybe (string "") msg
|
||||||
metacontent = "text/html; charset=utf-8"
|
metacontent = "text/html; charset=utf-8"
|
||||||
|
|
||||||
navbar :: TemplateData -> Hamlet HledgerWebAppRoute
|
navbar :: TemplateData -> Hamlet HledgerWebAppRoute
|
||||||
navbar td = [$hamlet|
|
navbar _ = [$hamlet|
|
||||||
#navbar
|
#navbar
|
||||||
%a.toprightlink!href=$hledgerurl$ hledger $version$
|
%a.toprightlink!href=$hledgerurl$ hledger $version$
|
||||||
\ $
|
\ $
|
||||||
%a.toprightlink!href=$manualurl$!target=hledgerhelp manual
|
%a.toprightlink!href=$manualurl$!target=hledgerhelp manual
|
||||||
\ $
|
\ $
|
||||||
^navlinks.td^
|
|
||||||
^filterform.td^
|
|
||||||
|]
|
|]
|
||||||
|
|
||||||
navlinks :: TemplateData -> Hamlet HledgerWebAppRoute
|
navlinks :: TemplateData -> Hamlet HledgerWebAppRoute
|
||||||
navlinks td = [$hamlet|
|
navlinks td = [$hamlet|
|
||||||
#navlinks
|
#navlinks
|
||||||
^journallink^ $
|
^accountsjournallink^
|
||||||
| ^ledgerlink^ $
|
\ | $
|
||||||
|
^accountsregisterlink^
|
||||||
|
\ | $
|
||||||
|
%a#editformlink!href!onclick="return editformToggle()" edit journal
|
||||||
|
\ | $
|
||||||
|
%a#addformlink!href!onclick="return addformToggle()" add transaction
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
journallink = navlink td "journal" JournalPage
|
accountsjournallink = navlink td "journal" AccountsJournalPage
|
||||||
ledgerlink = navlink td "ledger" LedgerPage
|
accountsregisterlink = navlink td "register" AccountsRegisterPage
|
||||||
-- | ^balancelink^ $
|
|
||||||
-- | ^registerlink^ $
|
|
||||||
-- balancelink = navlink td "balance" BalancePage
|
|
||||||
-- registerlink = navlink td "register" RegisterPage
|
|
||||||
|
|
||||||
navlink :: TemplateData -> String -> HledgerWebAppRoute -> Hamlet HledgerWebAppRoute
|
navlink :: TemplateData -> String -> HledgerWebAppRoute -> Hamlet HledgerWebAppRoute
|
||||||
navlink TD{here=here,a=a,p=p} s dest = [$hamlet|%a.$style$!href=@?u@ $s$|]
|
navlink TD{here=here,a=a,p=p} s dest = [$hamlet|%a#$s$link.$style$!href=@?u@ $s$|]
|
||||||
where u = (dest, concat [(if null a then [] else [("a", a)])
|
where u = (dest, concat [(if null a then [] else [("a", a)])
|
||||||
,(if null p then [] else [("p", p)])])
|
,(if null p then [] else [("p", p)])])
|
||||||
style | dest == here = "navlinkcurrent"
|
style | dest == here = "navlinkcurrent"
|
||||||
@ -616,26 +715,30 @@ navlink TD{here=here,a=a,p=p} s dest = [$hamlet|%a.$style$!href=@?u@ $s$|]
|
|||||||
|
|
||||||
filterform :: TemplateData -> Hamlet HledgerWebAppRoute
|
filterform :: TemplateData -> Hamlet HledgerWebAppRoute
|
||||||
filterform TD{here=here,a=a,p=p} = [$hamlet|
|
filterform TD{here=here,a=a,p=p} = [$hamlet|
|
||||||
%form#filterform.$filtering$!method=GET
|
#filterformdiv
|
||||||
%span!style=white-space:nowrap;
|
%form#filterform.form!method=GET!style=display:$visible$;
|
||||||
^filterformlabel^ $
|
%span.$filtering$
|
||||||
%input!name=a!size=30!value=$a$
|
filter by account/description:
|
||||||
^ahelp^ $
|
\ $
|
||||||
in period: $
|
%input!name=a!size=50!value=$a$
|
||||||
%input!name=p!size=30!value=$p$
|
^ahelp^
|
||||||
^phelp^ $
|
\ $
|
||||||
%input!type=submit!value=filter
|
in period:
|
||||||
|
\ $
|
||||||
|
%input!name=p!size=25!value=$p$
|
||||||
|
^phelp^
|
||||||
|
\ $
|
||||||
|
%input!type=submit!value=filter $
|
||||||
|
\ $
|
||||||
|
^stopfiltering^
|
||||||
|]
|
|]
|
||||||
where
|
where
|
||||||
ahelp = helplink "filter-patterns" "?"
|
ahelp = helplink "filter-patterns" "?"
|
||||||
phelp = helplink "period-expressions" "?"
|
phelp = helplink "period-expressions" "?"
|
||||||
(filtering, filterformlabel)
|
(filtering, visible, filterformlabel, stopfiltering)
|
||||||
| null a && null p = ("", [$hamlet|filter by: $|])
|
| null a && null p = ("", defaultdisplay, [$hamlet|%a#filterformlink!href!onclick="return filterformToggle()" filter...|], nulltemplate) -- [$hamlet|filter by $|])
|
||||||
| otherwise = ("filtering", [$hamlet|
|
| otherwise = ("filtering", defaultdisplay, [$hamlet|filtering...|], [$hamlet|%a#stopfilterlink!href=@here@ stop filtering|])
|
||||||
%a#stopfilterlink!href=@here@ stop filtering
|
defaultdisplay = "none"
|
||||||
\ $
|
|
||||||
by $
|
|
||||||
|])
|
|
||||||
|
|
||||||
helplink :: String -> String -> Hamlet HledgerWebAppRoute
|
helplink :: String -> String -> Hamlet HledgerWebAppRoute
|
||||||
helplink topic label = [$hamlet|%a!href=$u$!target=hledgerhelp $label$|]
|
helplink topic label = [$hamlet|%a!href=$u$!target=hledgerhelp $label$|]
|
||||||
|
|||||||
@ -14,21 +14,28 @@ pre { font-family:courier,"courier new",monospace; }
|
|||||||
.journalreport { font-size:small; }
|
.journalreport { font-size:small; }
|
||||||
.balancereport { font-size:small; }
|
.balancereport { font-size:small; }
|
||||||
.registerreport { font-size:small; }
|
.registerreport { font-size:small; }
|
||||||
|
#showmoreaccounts { font-size:small; }
|
||||||
|
/* #addformlink { font-size:small; } */
|
||||||
|
/* #editformlink { font-size:small; } */
|
||||||
|
|
||||||
body { margin:0; }
|
body { margin:0; }
|
||||||
#navbar { padding:0px 6px; }
|
#navbar { padding:0px 6px; }
|
||||||
/* #navbar { padding:4px; background-color:#eeeeee; border-bottom:2px solid #dddddd; } */
|
/* #navbar { padding:4px; background-color:#eee; border-bottom:2px solid #ddd; } */
|
||||||
#navlinks { display:inline; }
|
|
||||||
.navlink { }
|
|
||||||
.navlinkcurrent { font-weight:bold; }
|
|
||||||
#filterform { display:inline; margin-left:1em; padding:4px; }
|
|
||||||
.filtering { background-color:#ddd; font-weight:bold; }
|
|
||||||
.form { margin:1em; }
|
|
||||||
.toprightlink { margin-left:1em; float:right; }
|
.toprightlink { margin-left:1em; float:right; }
|
||||||
#messages { color:red; background-color:#ffeeee; margin:0.5em;}
|
#messages { color:red; background-color:#ffeeee; margin:0.5em;}
|
||||||
.help { font-style: italic; }
|
.help { font-style: italic; }
|
||||||
.helprow td { padding-bottom:8px; }
|
.helprow td { padding-bottom:8px; }
|
||||||
#content { margin:1em; }
|
#content { margin:1em; }
|
||||||
|
#navlinks { margin-bottom:1em; }
|
||||||
|
.navlink { }
|
||||||
|
.navlinkcurrent { font-weight:bold; }
|
||||||
|
.form { margin:1em; }
|
||||||
|
|
||||||
|
#filterformdiv { margin:0 0 1em 0; white-space:nowrap; }
|
||||||
|
#filterform { margin:0; }
|
||||||
|
#filterform span { padding:4px; }
|
||||||
|
#stopfilterlink { font-weight:bold; }
|
||||||
|
.filtering { background-color:#ddd; }
|
||||||
|
|
||||||
.current { font-weight:bold; background-color:#ddd; }
|
.current { font-weight:bold; background-color:#ddd; }
|
||||||
.description { padding-left:1em; }
|
.description { padding-left:1em; }
|
||||||
@ -42,13 +49,15 @@ body { margin:0; }
|
|||||||
/* .even { background-color:#e8f8e8; } */
|
/* .even { background-color:#e8f8e8; } */
|
||||||
/* .even { background-color:#f0fff0; } */
|
/* .even { background-color:#f0fff0; } */
|
||||||
|
|
||||||
table.journalreport { margin-top:1em; }
|
table.journalreport { }
|
||||||
.journalreport td { border-top:thin solid #ddd; }
|
.journalreport td { border-top:thin solid #eee; }
|
||||||
.journalreport pre { margin-top:0; }
|
.journalreport pre { margin-top:0; }
|
||||||
|
|
||||||
.ledger .accounts {padding-right:1em; margin-right:1em; border-right:thin solid #ddd;}
|
.ledger .accounts {padding-right:1em; margin-right:1em; border-right:thin solid #eee;}
|
||||||
.ledger .register { }
|
.ledger .register { }
|
||||||
|
|
||||||
|
div.accounts { padding-bottom: 10em; }
|
||||||
|
|
||||||
.balancereport tr { vertical-align:top; }
|
.balancereport tr { vertical-align:top; }
|
||||||
table.balancereport { border-spacing:0; }
|
table.balancereport { border-spacing:0; }
|
||||||
.ledger .balancereport td { padding:0; }
|
.ledger .balancereport td { padding:0; }
|
||||||
@ -59,10 +68,10 @@ table.registerreport { border-spacing:0; }
|
|||||||
.registerreport td { padding-bottom:0.2em; }
|
.registerreport td { padding-bottom:0.2em; }
|
||||||
.registerreport .date { white-space:nowrap; }
|
.registerreport .date { white-space:nowrap; }
|
||||||
.firstposting td { }
|
.firstposting td { }
|
||||||
.registerreport .even { background-color:#f0f0f0; }
|
.registerreport .odd { background-color:#f0f0f0; }
|
||||||
|
|
||||||
#addform input.textinput { background-color:#eee; padding:4px; }
|
#addform input.textinput { background-color:#eee; padding:4px; }
|
||||||
#addform table { }
|
#addform table { }
|
||||||
#addform #addbuttonrow { text-align:right; }
|
#addform #addbuttonrow { text-align:right; }
|
||||||
#editform { width:95%; }
|
/* #editform { width:95%; } */
|
||||||
#editform textarea { width:100%; background-color:#eee; padding:4px; }
|
#editform textarea { width:100%; background-color:#eee; padding:4px; }
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user