web: refactor: use RecordWildCards to reduce verbosity
This commit is contained in:
parent
47b1142d49
commit
0ebdbff17e
@ -48,7 +48,7 @@ getRootR = redirect RedirectTemporary defaultroute where defaultroute = Register
|
|||||||
-- | The formatted journal view, with sidebar.
|
-- | The formatted journal view, with sidebar.
|
||||||
getJournalR :: Handler RepHtml
|
getJournalR :: Handler RepHtml
|
||||||
getJournalR = do
|
getJournalR = do
|
||||||
vd@VD{opts=opts,qopts=qopts,m=m,j=j} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
let sidecontent = sidebar vd
|
let sidecontent = sidebar vd
|
||||||
-- XXX like registerReportAsHtml
|
-- XXX like registerReportAsHtml
|
||||||
inacct = inAccount qopts
|
inacct = inAccount qopts
|
||||||
@ -122,7 +122,7 @@ getJournalEditR = do
|
|||||||
-- | The raw journal view, with sidebar.
|
-- | The raw journal view, with sidebar.
|
||||||
getJournalRawR :: Handler RepHtml
|
getJournalRawR :: Handler RepHtml
|
||||||
getJournalRawR = do
|
getJournalRawR = do
|
||||||
vd@VD{opts=opts,m=m,j=j} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
let
|
let
|
||||||
sidecontent = sidebar vd
|
sidecontent = sidebar vd
|
||||||
title = "Journal entries" ++ if m /= MatchAny then ", filtered" else "" :: String
|
title = "Journal entries" ++ if m /= MatchAny then ", filtered" else "" :: String
|
||||||
@ -147,7 +147,7 @@ getJournalRawR = do
|
|||||||
-- | The raw journal view, no sidebar.
|
-- | The raw journal view, no sidebar.
|
||||||
getJournalOnlyR :: Handler RepHtml
|
getJournalOnlyR :: Handler RepHtml
|
||||||
getJournalOnlyR = do
|
getJournalOnlyR = do
|
||||||
vd@VD{opts=opts,m=m,j=j} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "hledger-web journal only"
|
setTitle "hledger-web journal only"
|
||||||
addHamlet $ rawJournalReportAsHtml opts vd $ journalReport opts nullfilterspec $ filterJournalTransactions2 m j
|
addHamlet $ rawJournalReportAsHtml opts vd $ journalReport opts nullfilterspec $ filterJournalTransactions2 m j
|
||||||
@ -157,7 +157,7 @@ getJournalOnlyR = do
|
|||||||
-- | The main journal/account register view, with accounts sidebar.
|
-- | The main journal/account register view, with accounts sidebar.
|
||||||
getRegisterR :: Handler RepHtml
|
getRegisterR :: Handler RepHtml
|
||||||
getRegisterR = do
|
getRegisterR = do
|
||||||
vd@VD{opts=opts,qopts=qopts,m=m,j=j} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
let sidecontent = sidebar vd
|
let sidecontent = sidebar vd
|
||||||
-- injournal = isNothing inacct
|
-- injournal = isNothing inacct
|
||||||
filtering = m /= MatchAny
|
filtering = m /= MatchAny
|
||||||
@ -187,7 +187,7 @@ getRegisterR = do
|
|||||||
-- | The register view, no sidebar.
|
-- | The register view, no sidebar.
|
||||||
getRegisterOnlyR :: Handler RepHtml
|
getRegisterOnlyR :: Handler RepHtml
|
||||||
getRegisterOnlyR = do
|
getRegisterOnlyR = do
|
||||||
vd@VD{opts=opts,qopts=qopts,m=m,j=j} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "hledger-web register only"
|
setTitle "hledger-web register only"
|
||||||
addHamlet $
|
addHamlet $
|
||||||
@ -200,7 +200,7 @@ getRegisterOnlyR = do
|
|||||||
-- of accounts as json if the Accept header specifies json.
|
-- of accounts as json if the Accept header specifies json.
|
||||||
getAccountsR :: Handler RepHtmlJson
|
getAccountsR :: Handler RepHtmlJson
|
||||||
getAccountsR = do
|
getAccountsR = do
|
||||||
vd@VD{opts=opts,m=m,am=am,j=j} <- getViewData
|
vd@VD{..} <- getViewData
|
||||||
let j' = filterJournalPostings2 m j
|
let j' = filterJournalPostings2 m j
|
||||||
html = do
|
html = do
|
||||||
setTitle "hledger-web accounts"
|
setTitle "hledger-web accounts"
|
||||||
@ -211,7 +211,7 @@ getAccountsR = do
|
|||||||
-- | A json-only version of "getAccountsR", does not require the special Accept header.
|
-- | A json-only version of "getAccountsR", does not require the special Accept header.
|
||||||
getAccountsJsonR :: Handler RepJson
|
getAccountsJsonR :: Handler RepJson
|
||||||
getAccountsJsonR = do
|
getAccountsJsonR = do
|
||||||
VD{m=m,j=j} <- getViewData
|
VD{..} <- getViewData
|
||||||
let j' = filterJournalPostings2 m j
|
let j' = filterJournalPostings2 m j
|
||||||
jsonToRepJson $ jsonMap [("accounts", toJSON $ journalAccountNames j')]
|
jsonToRepJson $ jsonMap [("accounts", toJSON $ journalAccountNames j')]
|
||||||
|
|
||||||
@ -220,11 +220,11 @@ getAccountsJsonR = do
|
|||||||
|
|
||||||
-- | Render the sidebar used on most views.
|
-- | Render the sidebar used on most views.
|
||||||
sidebar :: ViewData -> Hamlet AppRoute
|
sidebar :: ViewData -> Hamlet AppRoute
|
||||||
sidebar vd@VD{opts=opts,am=am,j=j} = balanceReportAsHtml opts vd $ balanceReport2 opts am j
|
sidebar vd@VD{..} = balanceReportAsHtml opts vd $ balanceReport2 opts am j
|
||||||
|
|
||||||
-- | Render a "BalanceReport" as HTML.
|
-- | Render a "BalanceReport" as HTML.
|
||||||
balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute
|
balanceReportAsHtml :: [Opt] -> ViewData -> BalanceReport -> Hamlet AppRoute
|
||||||
balanceReportAsHtml _ vd@VD{qopts=qopts,j=j} (items',total) =
|
balanceReportAsHtml _ vd@VD{..} (items',total) =
|
||||||
[$hamlet|
|
[$hamlet|
|
||||||
<div#accountsheading
|
<div#accountsheading
|
||||||
<a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
|
<a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
|
||||||
@ -336,7 +336,7 @@ formattedJournalReportAsHtml _ vd (_,items) = [$hamlet|
|
|||||||
where
|
where
|
||||||
-- .#{datetransition}
|
-- .#{datetransition}
|
||||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, AccountRegisterReportItem) -> Hamlet AppRoute
|
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, AccountRegisterReportItem) -> Hamlet AppRoute
|
||||||
itemAsHtml VD{here=here} (n, _, _, _, (t, _, split, _, amt, _)) = [$hamlet|
|
itemAsHtml VD{..} (n, _, _, _, (t, _, split, _, amt, _)) = [$hamlet|
|
||||||
<tr.item.#{evenodd}.#{firstposting}
|
<tr.item.#{evenodd}.#{firstposting}
|
||||||
<td.date>#{date}
|
<td.date>#{date}
|
||||||
<td.description colspan=2 title="#{show t}">#{elideRight 60 desc}
|
<td.description colspan=2 title="#{show t}">#{elideRight 60 desc}
|
||||||
@ -386,7 +386,7 @@ registerItemsHtml _ vd (balancelabel,items) = [$hamlet|
|
|||||||
-- inacct = inAccount qopts
|
-- inacct = inAccount qopts
|
||||||
-- filtering = m /= MatchAny
|
-- filtering = m /= MatchAny
|
||||||
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, AccountRegisterReportItem) -> Hamlet AppRoute
|
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, AccountRegisterReportItem) -> Hamlet AppRoute
|
||||||
itemAsHtml VD{here=here,p=p} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [$hamlet|
|
itemAsHtml VD{..} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [$hamlet|
|
||||||
<tr.item.#{evenodd}.#{firstposting}.#{datetransition}
|
<tr.item.#{evenodd}.#{firstposting}.#{datetransition}
|
||||||
<td.date>#{date}
|
<td.date>#{date}
|
||||||
<td.description title="#{show t}">#{elideRight 30 desc}
|
<td.description title="#{show t}">#{elideRight 30 desc}
|
||||||
@ -492,7 +492,7 @@ handlePost = do
|
|||||||
-- | Handle a post from the transaction add form.
|
-- | Handle a post from the transaction add form.
|
||||||
handleAdd :: Handler RepPlain
|
handleAdd :: Handler RepPlain
|
||||||
handleAdd = do
|
handleAdd = do
|
||||||
VD{j=j,today=today} <- getViewData
|
VD{..} <- getViewData
|
||||||
-- get form input values. M means a Maybe value.
|
-- get form input values. M means a Maybe value.
|
||||||
(dateM, descM, acct1M, amt1M, acct2M, amt2M, journalM) <- runFormPost'
|
(dateM, descM, acct1M, amt1M, acct2M, amt2M, journalM) <- runFormPost'
|
||||||
$ (,,,,,,)
|
$ (,,,,,,)
|
||||||
@ -549,7 +549,7 @@ handleAdd = do
|
|||||||
-- | Handle a post from the journal edit form.
|
-- | Handle a post from the journal edit form.
|
||||||
handleEdit :: Handler RepPlain
|
handleEdit :: Handler RepPlain
|
||||||
handleEdit = do
|
handleEdit = do
|
||||||
VD{j=j} <- getViewData
|
VD{..} <- getViewData
|
||||||
-- get form input values, or validation errors.
|
-- get form input values, or validation errors.
|
||||||
-- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
|
-- getRequest >>= liftIO (reqRequestBody req) >>= mtrace
|
||||||
(textM, journalM) <- runFormPost'
|
(textM, journalM) <- runFormPost'
|
||||||
@ -617,7 +617,7 @@ handleImport = do
|
|||||||
|
|
||||||
-- | Global toolbar/heading area.
|
-- | Global toolbar/heading area.
|
||||||
topbar :: ViewData -> Hamlet AppRoute
|
topbar :: ViewData -> Hamlet AppRoute
|
||||||
topbar VD{j=j,msg=msg} = [$hamlet|
|
topbar VD{..} = [$hamlet|
|
||||||
<div#topbar
|
<div#topbar
|
||||||
<a.topleftlink href=#{hledgerorgurl} title="More about hledger"
|
<a.topleftlink href=#{hledgerorgurl} title="More about hledger"
|
||||||
hledger-web
|
hledger-web
|
||||||
@ -633,7 +633,7 @@ $maybe m <- msg
|
|||||||
|
|
||||||
-- | Navigation link, preserving parameters and possibly highlighted.
|
-- | Navigation link, preserving parameters and possibly highlighted.
|
||||||
navlink :: ViewData -> String -> AppRoute -> String -> Hamlet AppRoute
|
navlink :: ViewData -> String -> AppRoute -> String -> Hamlet AppRoute
|
||||||
navlink VD{here=here,q=q} s dest title = [$hamlet|
|
navlink VD{..} s dest title = [$hamlet|
|
||||||
<a##{s}link.#{style} href=@?{u} title="#{title}">#{s}
|
<a##{s}link.#{style} href=@?{u} title="#{title}">#{s}
|
||||||
|]
|
|]
|
||||||
where u = (dest, if null q then [] else [("q", pack q)])
|
where u = (dest, if null q then [] else [("q", pack q)])
|
||||||
@ -658,7 +658,7 @@ helplink topic label = [$hamlet|
|
|||||||
|
|
||||||
-- | Search form for entering custom queries to filter journal data.
|
-- | Search form for entering custom queries to filter journal data.
|
||||||
searchform :: ViewData -> Hamlet AppRoute
|
searchform :: ViewData -> Hamlet AppRoute
|
||||||
searchform VD{here=here,q=q} = [$hamlet|
|
searchform VD{..} = [$hamlet|
|
||||||
<div#searchformdiv
|
<div#searchformdiv
|
||||||
<form#searchform.form method=GET
|
<form#searchform.form method=GET
|
||||||
<table
|
<table
|
||||||
@ -699,7 +699,7 @@ searchform VD{here=here,q=q} = [$hamlet|
|
|||||||
|
|
||||||
-- | Add transaction form.
|
-- | Add transaction form.
|
||||||
addform :: ViewData -> Hamlet AppRoute
|
addform :: ViewData -> Hamlet AppRoute
|
||||||
addform vd@VD{qopts=qopts} = [$hamlet|
|
addform vd@VD{..} = [$hamlet|
|
||||||
<script type=text/javascript>
|
<script type=text/javascript>
|
||||||
$(document).ready(function() {
|
$(document).ready(function() {
|
||||||
/* dhtmlxcombo setup */
|
/* dhtmlxcombo setup */
|
||||||
@ -749,7 +749,7 @@ addform vd@VD{qopts=qopts} = [$hamlet|
|
|||||||
<input type=hidden name=action value=add
|
<input type=hidden name=action value=add
|
||||||
<input type=submit name=submit value="add transaction"
|
<input type=submit name=submit value="add transaction"
|
||||||
$if manyfiles
|
$if manyfiles
|
||||||
\ to: ^{journalselect $ files $ j vd}
|
\ to: ^{journalselect $ files j}
|
||||||
\ or #
|
\ or #
|
||||||
<a href onclick="return addformToggle(event)">cancel
|
<a href onclick="return addformToggle(event)">cancel
|
||||||
|]
|
|]
|
||||||
@ -758,9 +758,9 @@ addform vd@VD{qopts=qopts} = [$hamlet|
|
|||||||
datehelp = "eg: 2010/7/20" :: String
|
datehelp = "eg: 2010/7/20" :: String
|
||||||
deschelp = "eg: supermarket (optional)" :: String
|
deschelp = "eg: supermarket (optional)" :: String
|
||||||
date = "today" :: String
|
date = "today" :: String
|
||||||
descriptions = sort $ nub $ map tdescription $ jtxns $ j vd
|
descriptions = sort $ nub $ map tdescription $ jtxns j
|
||||||
manyfiles = (length $ files $ j vd) > 1
|
manyfiles = (length $ files j) > 1
|
||||||
postingfields VD{j=j} n = [$hamlet|
|
postingfields VD{..} n = [$hamlet|
|
||||||
<tr#postingrow
|
<tr#postingrow
|
||||||
<td align=right>#{acctlabel}:
|
<td align=right>#{acctlabel}:
|
||||||
<td
|
<td
|
||||||
@ -802,7 +802,7 @@ addform vd@VD{qopts=qopts} = [$hamlet|
|
|||||||
|
|
||||||
-- | Edit journal form.
|
-- | Edit journal form.
|
||||||
editform :: ViewData -> Hamlet AppRoute
|
editform :: ViewData -> Hamlet AppRoute
|
||||||
editform VD{j=j} = [$hamlet|
|
editform VD{..} = [$hamlet|
|
||||||
<form#editform method=POST style=display:none;
|
<form#editform method=POST style=display:none;
|
||||||
<table.form
|
<table.form
|
||||||
$if manyfiles
|
$if manyfiles
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user