web: ui cleanups, replace balance/register with combo view

This commit is contained in:
Simon Michael 2010-07-27 22:49:45 +00:00
parent 4467af1aa8
commit 0773dde872
7 changed files with 434 additions and 295 deletions

View File

@ -44,7 +44,7 @@ add opts args j
getAndAddTransactions :: Journal -> [Opt] -> [String] -> Day -> IO ()
getAndAddTransactions j opts args defaultDate = do
(t, d) <- getTransaction j opts args defaultDate
j <- journalAddTransaction j t
j <- journalAddTransaction j opts t
getAndAddTransactions j opts args d
-- | Read a transaction from the command line, with history-aware prompting.
@ -134,11 +134,12 @@ askFor prompt def validator = do
-- | Append this transaction to the journal's file. Also, to the journal's
-- transaction list, but we don't bother updating the other fields - this
-- is enough to include new transactions in the history matching.
journalAddTransaction :: Journal -> Transaction -> IO Journal
journalAddTransaction j@Journal{jtxns=ts} t = do
journalAddTransaction :: Journal -> [Opt] -> Transaction -> IO Journal
journalAddTransaction j@Journal{jtxns=ts} opts t = do
appendToJournalFile j $ showTransaction t
putStrLn $ printf "\nAdded transaction to %s:" (filepath j)
putStrLn =<< registerFromString (show t)
when (Debug `elem` opts) $ do
putStrLn $ printf "\nAdded transaction to %s:" (filepath j)
putStrLn =<< registerFromString (show t)
return j{jtxns=ts++[t]}
-- | Append data to the journal's file, ensuring proper separation from

View File

@ -96,9 +96,9 @@ balance report:
-}
module Hledger.Cli.Commands.Balance (
balance
,BalanceReport
BalanceReport
,BalanceReportItem
,balance
,balanceReport
,balanceReportAsText
-- ,tests_Balance

View File

@ -5,8 +5,13 @@ A ledger-compatible @print@ command.
-}
module Hledger.Cli.Commands.Print
where
module Hledger.Cli.Commands.Print (
JournalReport
,JournalReportItem
,print'
,journalReport
,showTransactions
) where
import Hledger.Data
import Hledger.Cli.Options
#if __GLASGOW_HASKELL__ <= 610
@ -15,6 +20,12 @@ import System.IO.UTF8
#endif
-- | A "journal report" is just a list of transactions.
type JournalReport = [JournalReportItem]
-- | The data for a single journal report item, representing one transaction.
type JournalReportItem = Transaction
-- | Print journal transactions in standard format.
print' :: [Opt] -> [String] -> Journal -> IO ()
print' opts args j = do
@ -22,8 +33,11 @@ print' opts args j = do
putStr $ showTransactions (optsToFilterSpec opts args t) j
showTransactions :: FilterSpec -> Journal -> String
showTransactions filterspec j =
concatMap (showTransactionForPrint effective) $ sortBy (comparing tdate) txns
where
effective = EffectiveDate == whichdate filterspec
txns = jtxns $ filterJournalTransactions filterspec j
showTransactions fspec j = journalReportAsText [] fspec $ journalReport [] fspec j
journalReportAsText :: [Opt] -> FilterSpec -> JournalReport -> String -- XXX unlike the others, this one needs fspec not opts
journalReportAsText _ fspec items = concatMap (showTransactionForPrint effective) items
where effective = EffectiveDate == whichdate fspec
journalReport :: [Opt] -> FilterSpec -> Journal -> JournalReport
journalReport _ fspec j = sortBy (comparing tdate) $ jtxns $ filterJournalTransactions fspec j

View File

@ -6,9 +6,9 @@ A ledger-compatible @register@ command.
-}
module Hledger.Cli.Commands.Register (
register
,RegisterReport
RegisterReport
,RegisterReportItem
,register
,registerReport
,registerReportAsText
,showPostingWithBalanceForVty

View File

@ -19,6 +19,7 @@ import Hledger.Cli.Commands.Print
import Hledger.Cli.Commands.Register
import Hledger.Cli.Options hiding (value)
import Hledger.Cli.Utils
import Hledger.Cli.Version (version)
import Hledger.Data
import Hledger.Read (journalFromPathAndString)
import Hledger.Read.Journal (someamount)
@ -47,14 +48,17 @@ data HledgerWebApp = HledgerWebApp {
mkYesod "HledgerWebApp" [$parseRoutes|
/ IndexPage GET
/journal JournalPage GET POST
/edit EditPage GET POST
/register RegisterPage GET
/balance BalancePage GET
/ledger LedgerPage GET
/style.css StyleCss GET
|]
instance Yesod HledgerWebApp where approot = appRoot
-- defaultroute = LedgerPage
defaultroute = JournalPage
-- | A bundle of useful data passed to templates.
data TemplateData = TD {
here :: HledgerWebAppRoute -- ^ the current page's route
@ -62,18 +66,14 @@ data TemplateData = TD {
,msg :: Maybe (Html ()) -- ^ transient message
,a :: String -- ^ a (filter pattern) parameter
,p :: String -- ^ p (period expression) parameter
,content :: Html () -- ^ html for the content area
,contentplain :: String -- ^ or plain text content
}
td = TD {
mktd = TD {
here = IndexPage
,title = "hledger"
,msg = Nothing
,a = ""
,p = ""
,content = nulltemplate id
,contentplain = ""
}
-- | The web command.
@ -104,9 +104,10 @@ server baseurl port opts args j = do
}
withStore "hledger" $ do
putValue "hledger" "journal" j
basicHandler port app
basicHandler' port Nothing app
-- handlers
----------------------------------------------------------------------
-- handlers & templates
getStyleCss :: Handler HledgerWebApp ()
getStyleCss = do
@ -115,158 +116,107 @@ getStyleCss = do
sendFile "text/css" $ dir </> "style.css"
getIndexPage :: Handler HledgerWebApp ()
getIndexPage = redirect RedirectTemporary BalancePage
getIndexPage = redirect RedirectTemporary defaultroute
-- | Gather all the stuff we want for a typical hledger web request handler.
getHandlerParameters :: Handler HledgerWebApp
(String, String, [Opt], FilterSpec, Journal, Maybe (Html ()), HledgerWebAppRoute)
getHandlerParameters = do
Just here <- getCurrentRoute
(a, p, opts, fspec) <- getReportParameters
(j, err) <- getLatestJournal opts
msg <- getMessage' err
return (a, p, opts, fspec, j, msg, here)
where
-- | Get current report parameters for this request.
getReportParameters :: Handler HledgerWebApp (String, String, [Opt], FilterSpec)
getReportParameters = do
app <- getYesod
t <- liftIO $ getCurrentLocalTime
a <- fromMaybe "" <$> lookupGetParam "a"
p <- fromMaybe "" <$> lookupGetParam "p"
let opts = appOpts app ++ [Period p]
args = appArgs app ++ [a]
fspec = optsToFilterSpec opts args t
return (a, p, opts, fspec)
-- | Update our copy of the journal if the file changed. If there is an
-- error while reloading, keep the old one and return the error, and set a
-- ui message.
getLatestJournal :: [Opt] -> Handler HledgerWebApp (Journal, Maybe String)
getLatestJournal opts = do
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
if not changed
then return (j,Nothing)
else case jE of
Right j' -> do liftIO $ putValue "hledger" "journal" j'
return (j',Nothing)
Left e -> do setMessage $ string "error while reading" {- ++ ": " ++ e-}
return (j, Just e)
-- | Helper to work around a yesod feature (can't set and get a message in the same request.)
getMessage' :: Maybe String -> Handler HledgerWebApp (Maybe (Html ()))
getMessage' newmsgstr = do
oldmsg <- getMessage
return $ maybe oldmsg (Just . string) newmsgstr
-- renderLatestJournalWith :: ([Opt] -> FilterSpec -> Journal -> Html ()) -> Handler HledgerWebApp RepHtml
-- renderLatestJournalWith reportHtml = do
-- (a, p, opts, fspec, j, msg, here) <- getHandlerParameters
-- let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=reportHtml opts fspec j}
-- hamletToRepHtml $ pageLayout td'
----------------------------------------------------------------------
-- | A basic journal view, like hledger print, with editing.
getJournalPage :: Handler HledgerWebApp RepHtml
getJournalPage = do
(a, p, _, fspec, j, msg, here) <- getHandlerParameters
let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=
stringToPre $ showTransactions fspec j
}
hamletToRepHtml $ pageLayout td'
getBalancePage :: Handler HledgerWebApp RepHtml
getBalancePage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
let td' = td{here=here, title="hledger", msg=msg, a=a, p=p, content=
balanceReportAsHtml opts td' $ balanceReport opts fspec j
}
hamletToRepHtml $ pageLayout td'
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p}
editform' = editform td $ jtext j
txns = journalReportAsHtml opts td $ journalReport opts fspec j
hamletToRepHtml $ pageLayout td [$hamlet|
%div.journal
^journalScripts^
%div.nav2
%a#addformlink!href!onclick="return addformToggle()" add one transaction
\ | $
%a#editformlink!href!onclick="return editformToggle()" edit the whole journal
^addform^
^editform'^
#transactions ^txns^
|]
-- | Render a balance report as HTML.
balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Html ()
balanceReportAsHtml _ td (items,total) = [$hamlet|
%table.balancereport
$forall items i
%tr.itemrule
%td!colspan=2
-- | Render a journal report as HTML.
journalReportAsHtml :: [Opt] -> TemplateData -> JournalReport -> Hamlet HledgerWebAppRoute
journalReportAsHtml _ td items = [$hamlet|
%table.journalreport
$forall number.items i
^itemAsHtml' i^
%tr.totalrule
%td!colspan=2
%tr
%td
%td!align=right $mixedAmountAsHtml.total$
|] id
|]
where
number = zip [1..]
itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet String
itemAsHtml TD{p=p} (a, adisplay, adepth, abal) = [$hamlet|
%tr.item
%td.account
$indent$
%a!href=$aurl$ $adisplay$
%td.balance!align=right $mixedAmountAsHtml.abal$
itemAsHtml :: TemplateData -> (Int, JournalReportItem) -> Hamlet HledgerWebAppRoute
itemAsHtml _ (n, t) = [$hamlet|
%tr.item.$evenodd$
%td.transaction
%pre $txn$
|] where
indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
aurl = printf "../register?a=^%s%s" a p' :: String
p' = if null p then "" else printf "&p=%s" p
evenodd = if even n then "even" else "odd"
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
--mixedAmountAsHtml = intercalate ", " . lines . show
mixedAmountAsHtml = preEscapedString . intercalate "<br>" . lines . show
journalScripts = [$hamlet|
<script type="text/javascript">
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'
function addformToggle() {
a = document.getElementById('addform');
e = document.getElementById('editform');
t = document.getElementById('transactions');
alink = document.getElementById('addformlink');
elink = document.getElementById('editformlink');
if (a.style.display == 'none') {
alink.style['font-weight'] = 'bold';
elink.style['font-weight'] = 'normal';
a.style.display = 'block';
e.style.display = 'none';
t.style.display = 'block';
} else {
alink.style['font-weight'] = 'normal';
elink.style['font-weight'] = 'normal';
a.style.display = 'none';
e.style.display = 'none';
t.style.display = 'block';
}
return false;
}
-- | 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
function editformToggle() {
a = document.getElementById('addform');
e = document.getElementById('editform');
t = document.getElementById('transactions');
alink = document.getElementById('addformlink');
elink = document.getElementById('editformlink');
if (e.style.display == 'none') {
alink.style['font-weight'] = 'normal';
elink.style['font-weight'] = 'bold';
a.style.display = 'none';
e.style.display = 'block';
t.style.display = 'none';
} else {
alink.style['font-weight'] = 'normal';
elink.style['font-weight'] = 'normal';
a.style.display = 'none';
e.style.display = 'none';
t.style.display = 'block';
}
return false;
}
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'
</script>
|]
postJournalPage :: Handler HledgerWebApp RepPlain
postJournalPage = do
edit <- runFormPost' $ maybeStringInput "edit"
if isJust edit then postEditForm else postAddForm
-- | Handle a journal add form post.
postAddForm :: Handler HledgerWebApp RepPlain
postAddForm = do
(_, _, opts, _, _, _, _) <- getHandlerParameters
today <- liftIO getCurrentDay
-- get form input values. M means a Maybe value.
(dateM, descM, acct1M, amt1M, acct2M, amt2M) <- runFormPost'
@ -315,12 +265,13 @@ postJournalPage = do
Right t -> do
let t' = txnTieKnot t -- XXX move into balanceTransaction
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
liftIO $ journalAddTransaction j t'
liftIO $ journalAddTransaction j opts t'
setMessage $ string $ printf "Added transaction:\n%s" (show t')
redirect RedirectTemporary JournalPage
postEditPage :: Handler HledgerWebApp RepPlain
postEditPage = do
-- | Handle a journal edit form post.
postEditForm :: Handler HledgerWebApp RepPlain
postEditForm = do
-- get form input values, or basic validation errors. E means an Either value.
textM <- runFormPost' $ maybeStringInput "text"
let textE = maybe (Left "No value provided") Right textM
@ -343,134 +294,23 @@ postEditPage = do
if not changed
then do
setMessage $ string $ "No change"
redirect RedirectTemporary EditPage
redirect RedirectTemporary JournalPage
else do
jE <- liftIO $ journalFromPathAndString Nothing f tnew
either
(\e -> do
setMessage $ string e
redirect RedirectTemporary EditPage)
redirect RedirectTemporary JournalPage)
(const $ do
liftIO $ writeFileWithBackup f tnew
setMessage $ string $ printf "Saved journal %s\n" (show f)
redirect RedirectTemporary JournalPage)
jE
-- templates
nulltemplate = [$hamlet||]
stringToPre :: String -> Html ()
stringToPre s = [$hamlet|%pre $s$|] id
pageLayout :: TemplateData -> Hamlet HledgerWebAppRoute
pageLayout td@TD{here=here, title=title, msg=msg, content=content} = [$hamlet|
!!!
%html
%head
%title $title$
%meta!http-equiv=Content-Type!content=$metacontent$
%link!rel=stylesheet!type=text/css!href=@stylesheet@!media=all
%body
^navbar.td^
#messages $m$
^addform'.here^
#content
$content$
|]
where m = fromMaybe (string "") msg
addform' JournalPage = addform
addform' _ = nulltemplate
stylesheet = StyleCss
metacontent = "text/html; charset=utf-8"
navbar :: TemplateData -> Hamlet HledgerWebAppRoute
navbar td = [$hamlet|
#navbar
%a.toprightlink!href=$hledgerurl$ hledger.org
\ $
%a.toprightlink!href=$manualurl$ manual
\ $
^navlinks.td^
^searchform.td^
|]
navlinks :: TemplateData -> Hamlet HledgerWebAppRoute
navlinks TD{here=here,a=a,p=p} = [$hamlet|
#navlinks
^journallink^ $
(^editlink^) $
| ^balancelink^ $
| ^registerlink^ $
|]
where
journallink = navlink here "journal" JournalPage
editlink = navlink here "edit" EditPage
registerlink = navlink here "register" RegisterPage
balancelink = navlink here "balance" BalancePage
navlink here s dest = [$hamlet|%a.$style$!href=@?u@ $s$|]
where u = (dest, concat [(if null a then [] else [("a", a)])
,(if null p then [] else [("p", p)])])
style | here == dest = "navlinkcurrent"
| otherwise = "navlink"
searchform :: TemplateData -> Hamlet HledgerWebAppRoute
searchform TD{here=here,a=a,p=p} = [$hamlet|
%form#searchform!method=GET
^resetlink^ $
%span!style=white-space:nowrap;
filter by: $
%input!name=a!size=30!value=$a$
^ahelp^ $
in period: $
%input!name=p!size=30!value=$p$
^phelp^ $
%input!type=submit!value=filter
|]
where
ahelp = helplink "filter-patterns" "?"
phelp = helplink "period-expressions" "?"
resetlink
| null a && null p = nulltemplate
| otherwise = [$hamlet|%span#resetlink!style=font-weight:bold; $
%a!href=@here@ stop filtering|]
helplink topic label = [$hamlet|%a!href=$u$ $label$|]
where u = manualurl ++ if null topic then "" else '#':topic
editform :: TemplateData -> Hamlet HledgerWebAppRoute
editform TD{contentplain=t} = [$hamlet|
%form!method=POST
%table.form#editform!cellpadding=0!cellspacing=0!border=0
%tr.formheading
%td!colspan=2
%span!style=float:right; ^formhelp^
%span#formheading Edit journal:
%tr
%td!colspan=2
%textarea!name=text!rows=30!cols=80
$t$
%tr#addbuttonrow
%td
%a!href=@JournalPage@ cancel
%td!align=right
%input!type=submit!value=$submitlabel$
%tr.helprow
%td
%td!align=right
#help Are you sure ? All previous data will be replaced
|]
where
submitlabel = "save journal"
formhelp = helplink "file-format" "file format help"
addform :: Hamlet HledgerWebAppRoute
addform = [$hamlet|
%form!method=POST
%table.form#addform!cellpadding=0!cellspacing=0!border=0
%tr.formheading
%td!colspan=4
%span#formheading Add a transaction:
%form#addform!method=POST!style=display:none;
%table.form!cellpadding=0!cellspacing=0!border=0
%tr
%td!colspan=4
%table!cellpadding=0!cellspacing=0!border=0
@ -486,21 +326,21 @@ addform = [$hamlet|
%tr.helprow
%td
%td
#help $datehelp$ ^datehelplink^ $
.help $datehelp$ ^datehelplink^ $
%td
%td
#help $deschelp$
.help $deschelp$
^transactionfields1^
^transactionfields2^
%tr#addbuttonrow
%td!colspan=4
%input!type=submit!value=$addlabel$
%input!type=hidden!name=add!value=1
%input!type=submit!name=submit!value="add transaction"
|]
where
datehelplink = helplink "dates" "..."
datehelp = "eg: 7/20, 2010/1/1, "
deschelp = "eg: supermarket (optional)"
addlabel = "add transaction"
date = "today"
desc = ""
transactionfields1 = transactionfields 1
@ -517,10 +357,10 @@ transactionfields n = [$hamlet|
%tr.helprow
%td
%td
#help $accthelp$
.help $accthelp$
%td
%td
#help $amthelp$
.help $amthelp$
|]
where
label | n == 1 = "To account"
@ -542,3 +382,255 @@ transactionfields n = [$hamlet|
acctvar = numbered "accountname"
amtvar = numbered "amount"
editform :: TemplateData -> String -> Hamlet HledgerWebAppRoute
editform _ content = [$hamlet|
%form#editform!method=POST!style=display:none;
%table.form#editform!cellpadding=0!cellspacing=0!border=0
%tr
%td!colspan=2
%textarea!name=text!rows=30!cols=80
$content$
%tr#addbuttonrow
%td
%span.help ^formathelp^
%td!align=right
%span.help Are you sure ? Your journal will be overwritten. $
%input!type=hidden!name=edit!value=1
%input!type=submit!name=submit!value="save journal"
\ or $
%a!href!onclick="return editformToggle()" cancel
|]
where
formathelp = helplink "file-format" "file format help"
----------------------------------------------------------------------
-- | A combined accounts and postings view, like hledger balance + hledger register.
getLedgerPage :: Handler HledgerWebApp RepHtml
getLedgerPage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
-- in this view, balance report is filtered only by period, not account/description filters
app <- getYesod
t <- liftIO $ getCurrentLocalTime
let args = appArgs app
fspec' = optsToFilterSpec opts args t
br = balanceReportAsHtml opts td $ balanceReport opts fspec' j
rr = registerReportAsHtml opts td $ registerReport opts fspec j
td = mktd{here=here, title="hledger", msg=msg, a=a, p=p}
hamletToRepHtml $ pageLayout td [$hamlet|
%div.ledger
%div.accounts!style=float:left; ^br^
%div.register ^rr^
|]
----------------------------------------------------------------------
-- | An accounts and balances view, like hledger balance.
getBalancePage :: Handler HledgerWebApp RepHtml
getBalancePage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p}
hamletToRepHtml $ pageLayout td $ balanceReportAsHtml opts td $ balanceReport opts fspec j
-- | Render a balance report as HTML.
balanceReportAsHtml :: [Opt] -> TemplateData -> BalanceReport -> Hamlet HledgerWebAppRoute
balanceReportAsHtml _ td (items,total) = [$hamlet|
%table.balancereport
$forall items i
^itemAsHtml' i^
%tr.totalrule
%td!colspan=2
%tr
%td
%td!align=right $mixedAmountAsHtml.total$
|]
where
itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> BalanceReportItem -> Hamlet HledgerWebAppRoute
itemAsHtml TD{a=a,p=p} (acct, adisplay, adepth, abal) = [$hamlet|
%tr.item.$current$
%td.account
$indent$
%a!href=$aurl$ $adisplay$
%td.balance!align=right $mixedAmountAsHtml.abal$
|] where
current = if not (null a) && containsRegex a acct then "current" else ""
indent = preEscapedString $ concat $ replicate (2 * adepth) "&nbsp;"
aurl = printf "../ledger?a=^%s%s" acct p' :: String
p' = if null p then "" else printf "&p=%s" p
----------------------------------------------------------------------
-- | A postings view, like hledger register.
getRegisterPage :: Handler HledgerWebApp RepHtml
getRegisterPage = do
(a, p, opts, fspec, j, msg, here) <- getHandlerParameters
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p}
hamletToRepHtml $ pageLayout td $ registerReportAsHtml opts td $ registerReport opts fspec j
-- | Render a register report as HTML.
registerReportAsHtml :: [Opt] -> TemplateData -> RegisterReport -> Hamlet HledgerWebAppRoute
registerReportAsHtml _ td items = [$hamlet|
%table.registerreport
$forall number.items i
^itemAsHtml' i^
|]
where
number = zip [1..]
itemAsHtml' = itemAsHtml td
itemAsHtml :: TemplateData -> (Int, RegisterReportItem) -> Hamlet HledgerWebAppRoute
itemAsHtml TD{p=p} (n, (ds, posting, b)) = [$hamlet|
%tr.item.$evenodd$.$firstposting$
%td.date $date$
%td.description $desc$
%td.account
%a!href=$aurl$ $acct$
%td.amount!align=right $mixedAmountAsHtml.pamount.posting$
%td.balance!align=right $mixedAmountAsHtml.b$
|] where
evenodd = if even n then "even" else "odd"
(firstposting, date, desc) = case ds of Just (da, de) -> ("firstposting", show da, de)
Nothing -> ("", "", "")
acct = paccount posting
aurl = printf "../ledger?a=^%s%s" acct p' :: String
p' = if null p then "" else printf "&p=%s" p
--mixedAmountAsHtml = intercalate ", " . lines . show
mixedAmountAsHtml = preEscapedString . intercalate "<br>" . lines . show
----------------------------------------------------------------------
-- | A standalone journal edit form page.
getEditPage :: Handler HledgerWebApp RepHtml
getEditPage = do
(a, p, _, _, _, msg, here) <- getHandlerParameters
-- reload journal's text without parsing, if changed
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
changed <- liftIO $ journalFileIsNewer j
s <- liftIO $ if changed then readFile (filepath j) else return (jtext j) -- XXX readFile may throw an error
let td = mktd{here=here, title="hledger", msg=msg, a=a, p=p}
hamletToRepHtml $ pageLayout td $ editform td s
----------------------------------------------------------------------
-- | Gather all the stuff we want for a typical hledger web request handler.
getHandlerParameters :: Handler HledgerWebApp
(String, String, [Opt], FilterSpec, Journal, Maybe (Html ()), HledgerWebAppRoute)
getHandlerParameters = do
Just here <- getCurrentRoute
(a, p, opts, fspec) <- getReportParameters
(j, err) <- getLatestJournal opts
msg <- getMessage' err
return (a, p, opts, fspec, j, msg, here)
where
-- | Get current report parameters for this request.
getReportParameters :: Handler HledgerWebApp (String, String, [Opt], FilterSpec)
getReportParameters = do
app <- getYesod
t <- liftIO $ getCurrentLocalTime
a <- fromMaybe "" <$> lookupGetParam "a"
p <- fromMaybe "" <$> lookupGetParam "p"
let opts = appOpts app ++ [Period p]
args = appArgs app ++ [a]
fspec = optsToFilterSpec opts args t
return (a, p, opts, fspec)
-- | Update our copy of the journal if the file changed. If there is an
-- error while reloading, keep the old one and return the error, and set a
-- ui message.
getLatestJournal :: [Opt] -> Handler HledgerWebApp (Journal, Maybe String)
getLatestJournal opts = do
j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
if not changed
then return (j,Nothing)
else case jE of
Right j' -> do liftIO $ putValue "hledger" "journal" j'
return (j',Nothing)
Left e -> do setMessage $ string "error while reading" {- ++ ": " ++ e-}
return (j, Just e)
-- | Helper to work around a yesod feature (can't set and get a message in the same request.)
getMessage' :: Maybe String -> Handler HledgerWebApp (Maybe (Html ()))
getMessage' newmsgstr = do
oldmsg <- getMessage
return $ maybe oldmsg (Just . string) newmsgstr
pageLayout :: TemplateData -> Hamlet HledgerWebAppRoute -> Hamlet HledgerWebAppRoute
pageLayout td@TD{title=title, msg=msg} content = [$hamlet|
!!!
%html
%head
%title $title$
%meta!http-equiv=Content-Type!content=$metacontent$
%link!rel=stylesheet!type=text/css!href=@StyleCss@!media=all
%body
^navbar.td^
#messages $m$
#content
^content^
|]
where m = fromMaybe (string "") msg
metacontent = "text/html; charset=utf-8"
navbar :: TemplateData -> Hamlet HledgerWebAppRoute
navbar td = [$hamlet|
#navbar
%a.toprightlink!href=$hledgerurl$ hledger $version$
\ $
%a.toprightlink!href=$manualurl$ manual
\ $
^navlinks.td^
^filterform.td^
|]
navlinks :: TemplateData -> Hamlet HledgerWebAppRoute
navlinks td = [$hamlet|
#navlinks
^journallink^ $
| ^ledgerlink^ $
|]
where
journallink = navlink td "journal" JournalPage
ledgerlink = navlink td "ledger" LedgerPage
-- | ^balancelink^ $
-- | ^registerlink^ $
-- balancelink = navlink td "balance" BalancePage
-- registerlink = navlink td "register" RegisterPage
navlink :: TemplateData -> String -> HledgerWebAppRoute -> Hamlet HledgerWebAppRoute
navlink TD{here=here,a=a,p=p} s dest = [$hamlet|%a.$style$!href=@?u@ $s$|]
where u = (dest, concat [(if null a then [] else [("a", a)])
,(if null p then [] else [("p", p)])])
style | dest == here = "navlinkcurrent"
| otherwise = "navlink"
filterform :: TemplateData -> Hamlet HledgerWebAppRoute
filterform TD{here=here,a=a,p=p} = [$hamlet|
%form#filterform.$filtering$!method=GET
%span!style=white-space:nowrap;
^filterformlabel^ $
%input!name=a!size=30!value=$a$
^ahelp^ $
in period: $
%input!name=p!size=30!value=$p$
^phelp^ $
%input!type=submit!value=filter
|]
where
ahelp = helplink "filter-patterns" "?"
phelp = helplink "period-expressions" "?"
(filtering, filterformlabel)
| null a && null p = ("", [$hamlet|filter by: $|])
| otherwise = ("filtering", [$hamlet|
%a#stopfilterlink!href=@here@ stop filtering
\ $
by $
|])
helplink :: String -> String -> Hamlet HledgerWebAppRoute
helplink topic label = [$hamlet|%a!href=$u$!target=hledgerhelp $label$|]
where u = manualurl ++ if null topic then "" else '#':topic
nulltemplate = [$hamlet||]

View File

@ -1,12 +1,19 @@
/* hledger web ui stylesheet */
body { font-family: "helvetica","arial", "sans serif"; margin:0; }
#navbar { background-color:#eeeeee; border-bottom:2px solid #dddddd; padding:4px 4px 6px 4px; }
/* font families */
body { font-family:helvetica,arial,"sans serif"; }
/* pre { font-family:monospace,courier,"courier new"; } */
#editform textarea { font-family:courier,"courier new",monospace; }
body { margin:0; }
#navbar { /* background-color:#eeeeee; */ /* border-bottom:2px solid #dddddd; */ padding:4px 4px 6px 4px; }
#navlinks { display:inline; }
.navlink { }
.navlinkcurrent { font-weight:bold; }
#searchform { font-size:small; display:inline; margin-left:1em; }
#resetlink { font-size:small; }
.nav2 { font-size:small; }
#filterform { font-size:small; display:inline; margin-left:1em; }
.filtering { background-color:#eee; font-weight:bold; }
#stopfilterlink { font-size:small; }
.toprightlink { font-size:small; margin-left:1em; float:right; }
#messages { color:red; background-color:#ffeeee; margin:0.5em;}
.form { margin:1em; font-size:small; }
@ -16,25 +23,50 @@ body { font-family: "helvetica","arial", "sans serif"; margin:0; }
#addform #postingrow { }
#addform #addbuttonrow { text-align:right; }
#editform { width:95%; }
#editform textarea { background-color:#eeeeee; font-family:monospace; font-size:medium; width:100%; }
#editform textarea { /* background-color:#eeeeee; */ width:100%; }
#content { margin:1em; }
.formheading td { padding-bottom:8px; }
#formheading { font-size:medium; font-weight:bold; }
.helprow td { padding-bottom:8px; }
#help {font-style: italic; font-size:smaller; }
.help {font-style: italic; font-size:smaller; }
/* for -fweb610 */
#hledgerorglink, #helplink { float:right; margin-left:1em; }
/* #hledgerorglink, #helplink { float:right; margin-left:1em; } */
/* .balancereport { font-size:small; } */
.current { font-weight:bold; background-color:#eee; }
.description { padding-left:1em; }
.account { white-space:nowrap; padding-left:1em; }
.amount { white-space:nowrap; padding-left:1em; }
.balance { white-space:nowrap; padding-left:1em; }
/* don't let fields get too small in emptyish reports */
.description { width:4em; }
.account, .amount, .balance { width:2em; }
/* .odd { background-color:#e8e8e8; } */
/* .even { background-color:#e8f8e8; } */
/* .even { background-color:#f0fff0; } */
.journalreport { font-size:small; }
table.journalreport { margin-top:1em; }
.journalreport td { border-top:thin solid #ddd; }
.journalreport pre { margin-top:0; }
.ledger .accounts {padding-right:1em; margin-right:1em; border-right:thin solid #ddd;}
.ledger .register {}
.balancereport { font-size:small; }
.balancereport tr { vertical-align:top; }
table.balancereport { border-spacing:0; }
.ledger .balancereport td { padding:0; }
/* .itemrule td { border-top:thin solid #ddd; } */
.totalrule td { border-top:thin solid black; }
table.registerreport { border-spacing:0; }
.registerreport { font-size:small; }
.registerreport tr { vertical-align:top; }
.registerreport td { padding-bottom:0.2em; }
/* .registerreport td { margin-left:0em; margin-right:0; } */
.registerreport .date { white-space:nowrap; }
/* .registerreport .description { font-size:small; } */
.registerreport .account { white-space:nowrap; }
.registerreport .amount { white-space:nowrap; }
.registerreport .balance { white-space:nowrap; }
/* .firstposting { background-color:#eee; } */
.registerreport .even { background-color:#f0f0f0; }

View File

@ -104,7 +104,7 @@ ensureJournalFile f = do
emptyJournal :: IO String
emptyJournal = do
d <- getCurrentDay
return $ printf "; journal created %s; see http://hledger.org/MANUAL.html#journal-file\n\n" (show d)
return $ printf "; journal created %s by hledger\n\n" (show d)
-- | Read a Journal from this string, using the specified data format or
-- trying all known formats, or give an error string.