mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
web: ui cleanups, replace balance/register with combo view
This commit is contained in:
parent
4467af1aa8
commit
0773dde872
@ -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
|
||||
|
@ -96,9 +96,9 @@ balance report:
|
||||
-}
|
||||
|
||||
module Hledger.Cli.Commands.Balance (
|
||||
balance
|
||||
,BalanceReport
|
||||
BalanceReport
|
||||
,BalanceReportItem
|
||||
,balance
|
||||
,balanceReport
|
||||
,balanceReportAsText
|
||||
-- ,tests_Balance
|
||||
|
@ -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
|
@ -6,9 +6,9 @@ A ledger-compatible @register@ command.
|
||||
-}
|
||||
|
||||
module Hledger.Cli.Commands.Register (
|
||||
register
|
||||
,RegisterReport
|
||||
RegisterReport
|
||||
,RegisterReportItem
|
||||
,register
|
||||
,registerReport
|
||||
,registerReportAsText
|
||||
,showPostingWithBalanceForVty
|
||||
|
@ -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) " "
|
||||
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) " "
|
||||
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||]
|
||||
|
||||
|
@ -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; }
|
||||
|
||||
|
@ -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.
|
||||
|
Loading…
Reference in New Issue
Block a user