refactor: try to organise handler support code better

This commit is contained in:
Simon Michael 2012-11-20 02:51:38 +00:00
parent 26a37bf3df
commit ad88df99fa
3 changed files with 284 additions and 279 deletions

View File

@ -1,13 +1,23 @@
-- | Common page components.
-- | Common page components and rendering helpers.
module Handler.Common where
import Import
import Data.List (sort, nub)
import Data.List
import Data.Maybe
import Data.Text(pack)
import Data.Time.Calendar
import System.FilePath (takeFileName)
#if BLAZE_HTML_0_5
import Text.Blaze.Internal (preEscapedString)
#else
import Text.Blaze (preEscapedString)
#endif
import Text.Printf
import Handler.Utils
import Hledger.Utils
import Hledger.Data
import Hledger.Query
import Hledger.Reports
@ -15,6 +25,9 @@ import Hledger.Cli.Options
import Hledger.Web.Options
-------------------------------------------------------------------------------
-- Page components
-- | Global toolbar/heading area.
topbar :: ViewData -> HtmlUrl AppRoute
topbar VD{..} = [hamlet|
@ -251,6 +264,270 @@ journalselect journalfiles = [hamlet|
<option value=#{fst f}>#{fst f}
|]
-- | Link to a topic in the manual.
helplink :: String -> String -> HtmlUrl AppRoute
helplink topic label = [hamlet|
<a href=#{u} target=hledgerhelp>#{label}
|]
where u = manualurl ++ if null topic then "" else '#':topic
nulltemplate :: HtmlUrl AppRoute
nulltemplate = [hamlet||]
----------------------------------------------------------------------
-- hledger report renderers
-- | Render an "AccountsReport" as html.
accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> HtmlUrl AppRoute
accountsReportAsHtml _ vd@VD{..} (items',total) =
[hamlet|
<div#accountsheading>
<a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
<div#accounts>
<table.balancereport>
<tr>
<td.add colspan=3>
<br>
<a#addformlink href="#" onclick="return addformToggle(event)" title="Add a new transaction to the journal">Add a transaction..
<tr.item :allaccts:.inacct>
<td.journal colspan=3>
<br>
<a href=@{JournalR} title="Show all transactions in journal format">Journal
<span.hoverlinks>
&nbsp;
<a href=@{JournalEntriesR} title="Show journal entries">entries
&nbsp;
<a#editformlink href="#" onclick="return editformToggle(event)" title="Edit the journal">
edit
<tr>
<td colspan=3>
<br>
Accounts
$forall i <- items
^{itemAsHtml vd i}
<tr.totalrule>
<td colspan=3>
<tr>
<td>
<td.balance align=right>#{mixedAmountAsHtml total}
<td>
|]
where
l = ledgerFromJournal Any j
inacctmatcher = inAccountQuery qopts
allaccts = isNothing inacctmatcher
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
itemAsHtml :: ViewData -> AccountsReportItem -> HtmlUrl AppRoute
itemAsHtml _ (acct, adisplay, aindent, abal) = [hamlet|
<tr.item.#{inacctclass}>
<td.account.#{depthclass}>
#{indent}
<a href="@?{acctquery}" title="Show transactions in this account, including subaccounts">#{adisplay}
<span.hoverlinks>
$if hassubs
&nbsp;
<a href="@?{acctonlyquery}" title="Show transactions in this account only">only
<!--
&nbsp;
<a href="@?{acctsonlyquery}" title="Focus on this account and sub-accounts and hide others">-others -->
<td.balance align=right>#{mixedAmountAsHtml abal}
|]
where
hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
-- <td.numpostings align=right title="#{numpostings} transactions in this account">(#{numpostings})
-- numpostings = maybe 0 (length.apostings) $ ledgerAccount l acct
depthclass = "depth"++show aindent
inacctclass = case inacctmatcher of
Just m' -> if m' `matchesAccount` acct then "inacct" else "notinacct"
Nothing -> "" :: String
indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) "&nbsp;"
acctquery = (RegisterR, [("q", pack $ accountQuery acct)])
acctonlyquery = (RegisterR, [("q", pack $ accountOnlyQuery acct)])
accountQuery :: AccountName -> String
accountQuery a = "inacct:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
accountOnlyQuery :: AccountName -> String
accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
accountUrl r a = (r, [("q", pack $ accountQuery a)])
-- | Render an "EntriesReport" as html for the journal entries view.
entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> HtmlUrl AppRoute
entriesReportAsHtml _ vd items = [hamlet|
<table.journalreport>
$forall i <- numbered items
^{itemAsHtml vd i}
|]
where
itemAsHtml :: ViewData -> (Int, EntriesReportItem) -> HtmlUrl AppRoute
itemAsHtml _ (n, t) = [hamlet|
<tr.item.#{evenodd}>
<td.transaction>
<pre>#{txn}
|]
where
evenodd = if even n then "even" else "odd" :: String
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
-- | Render a "TransactionsReport" as html for the formatted journal view.
journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
journalTransactionsReportAsHtml _ vd (_,items) = [hamlet|
<table.journalreport>
<tr.headings>
<th.date align=left>Date
<th.description align=left>Description
<th.account align=left>Accounts
<th.amount align=right>Amount
$forall i <- numberTransactionsReportItems items
^{itemAsHtml vd i}
|]
where
-- .#{datetransition}
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
itemAsHtml VD{..} (n, _, _, _, (t, _, split, _, amt, _)) = [hamlet|
<tr.item.#{evenodd}.#{firstposting}>
<td.date>#{date}
<td.description colspan=2 title="#{show t}">#{elideRight 60 desc}
<td.amount align=right>
$if showamt
#{mixedAmountAsHtml amt}
$forall p' <- tpostings t
<tr.item.#{evenodd}.posting>
<td.date>
<td.description>
<td.account>&nbsp;<a href="@?{accountUrl here $ paccount p'}" title="Show transactions in #{paccount p'}">#{elideRight 40 $ paccount p'}
<td.amount align=right>#{mixedAmountAsHtml $ pamount p'}
|]
where
evenodd = if even n then "even" else "odd" :: String
-- datetransition | newm = "newmonth"
-- | newd = "newday"
-- | otherwise = "" :: String
(firstposting, date, desc) = (False, show $ tdate t, tdescription t)
-- acctquery = (here, [("q", pack $ accountQuery acct)])
showamt = not split || not (isZeroMixedAmount amt)
-- Generate html for an account register, including a balance chart and transaction list.
registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
registerReportHtml opts vd r@(_,items) = [hamlet|
^{registerChartHtml items}
^{registerItemsHtml opts vd r}
|]
-- Generate html for a transaction list from an "TransactionsReport".
registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
registerItemsHtml _ vd (balancelabel,items) = [hamlet|
<table.registerreport>
<tr.headings>
<th.date align=left>Date
<th.description align=left>Description
<th.account align=left>To/From Account
<!-- \ #
<a#all-postings-toggle-link.togglelink href="#" title="Toggle all split postings">[+] -->
<th.amount align=right>Amount
<th.balance align=right>#{balancelabel}
$forall i <- numberTransactionsReportItems items
^{itemAsHtml vd i}
|]
where
-- inacct = inAccount qopts
-- filtering = m /= Any
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
itemAsHtml VD{..} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [hamlet|
<tr.item.#{evenodd}.#{firstposting}.#{datetransition}>
<td.date>#{date}
<td.description title="#{show t}">#{elideRight 30 desc}
<td.account title="#{show t}">
<a>
#{elideRight 40 acct}
&nbsp;
<a.postings-toggle-link.togglelink href="#" title="Toggle all postings">
[+]
<td.amount align=right>
$if showamt
#{mixedAmountAsHtml amt}
<td.balance align=right>#{mixedAmountAsHtml bal}
$forall p' <- tpostings t
<tr.item.#{evenodd}.posting style=#{postingsdisplaystyle}>
<td.date>
<td.description>
<td.account>&nbsp;<a href="@?{accountUrl here $ paccount p'}" title="Show transactions in #{paccount p'}">#{elideRight 40 $ paccount p'}
<td.amount align=right>#{mixedAmountAsHtml $ pamount p'}
<td.balance align=right>
|]
where
evenodd = if even n then "even" else "odd" :: String
datetransition | newm = "newmonth"
| newd = "newday"
| otherwise = "" :: String
(firstposting, date, desc) = (False, show $ tdate t, tdescription t)
-- acctquery = (here, [("q", pack $ accountQuery acct)])
showamt = not split || not (isZeroMixedAmount amt)
postingsdisplaystyle = if showpostings then "" else "display:none;" :: String
-- | Generate javascript/html for a register balance line chart based on
-- the provided "TransactionsReportItem"s.
-- registerChartHtml :: forall t (t1 :: * -> *) t2 t3 t4 t5.
-- Data.Foldable.Foldable t1 =>
-- t1 (Transaction, t2, t3, t4, t5, MixedAmount)
-- -> t -> Text.Blaze.Internal.HtmlM ()
registerChartHtml :: [TransactionsReportItem] -> HtmlUrl AppRoute
registerChartHtml items =
-- have to make sure plot is not called when our container (maincontent)
-- is hidden, eg with add form toggled
[hamlet|
<div#register-chart style="width:600px;height:100px; margin-bottom:1em;">
<script type=text/javascript>
\$(document).ready(function() {
/* render chart with flot, if visible */
var chartdiv = $('#register-chart');
if (chartdiv.is(':visible'))
\$.plot(chartdiv,
[
[
$forall i <- items
[#{dayToJsTimestamp $ triDate i}, #{triBalance i}],
]
],
{
xaxis: {
mode: "time",
timeformat: "%y/%m/%d"
}
}
);
});
|]
-- stringIfLongerThan :: Int -> String -> String
-- stringIfLongerThan n s = if length s > n then s else ""
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
numberTransactionsReportItems [] = []
numberTransactionsReportItems items = number 0 nulldate items
where
number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
number _ _ [] = []
number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):is) = (n+1,newday,newmonth,newyear,i):(number (n+1) d is)
where
newday = d/=prevd
newmonth = dm/=prevdm || dy/=prevdy
newyear = dy/=prevdy
(dy,dm,_) = toGregorian d
(prevdy,prevdm,_) = toGregorian prevd
mixedAmountAsHtml :: MixedAmount -> Html
mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $ showMixedAmount b
where addclass = printf "<span class=\"%s\">%s</span>" (c :: String)
c = case isNegativeMixedAmount b of Just True -> "negative amount"
_ -> "positive amount"

View File

@ -5,7 +5,7 @@ module Handler.Post where
import Import
import Data.Either (lefts,rights)
import Data.List (head, intercalate)
import Data.List (intercalate)
import Data.Text (unpack)
import qualified Data.Text as T (null)
import Text.Hamlet (shamlet)

View File

@ -1,40 +1,32 @@
-- | Web utilities and rendering helpers.
-- | Web handler utilities.
module Handler.Utils where
import Prelude
import Control.Applicative ((<$>))
import Control.Monad.IO.Class (liftIO)
import Data.List
import Data.Maybe
import Data.Text(Text,pack,unpack)
import Data.Text(pack,unpack)
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Format
import System.IO.Storage (putValue, getValue)
import System.Locale (defaultTimeLocale)
#if BLAZE_HTML_0_5
import Text.Blaze.Internal (preEscapedString)
import Text.Blaze.Html (toHtml)
#else
import Text.Blaze (preEscapedString, toHtml)
import Text.Blaze (toHtml)
#endif
import Text.Hamlet -- hiding (hamlet)
import Text.Printf
import Text.Hamlet
import Yesod.Core
-- import Yesod.Json
import Foundation
import Settings
import Hledger hiding (is)
import Hledger.Cli hiding (version)
import Hledger.Web.Options
----------------------------------------------------------------------
-- Utilities
-- | A bundle of data useful for hledger-web request handlers and templates.
data ViewData = VD {
opts :: WebOpts -- ^ the command-line options at startup
@ -128,267 +120,3 @@ dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX re
chomp :: String -> String
chomp = reverse . dropWhile (`elem` "\r\n") . reverse
----------------------------------------------------------------------
-- Rendering helpers
-- | Link to a topic in the manual.
helplink :: String -> String -> HtmlUrl AppRoute
helplink topic label = [hamlet|
<a href=#{u} target=hledgerhelp>#{label}
|]
where u = manualurl ++ if null topic then "" else '#':topic
-- | Render an "AccountsReport" as html.
accountsReportAsHtml :: WebOpts -> ViewData -> AccountsReport -> HtmlUrl AppRoute
accountsReportAsHtml _ vd@VD{..} (items',total) =
[hamlet|
<div#accountsheading>
<a#accounts-toggle-link.togglelink href="#" title="Toggle sidebar">[+]
<div#accounts>
<table.balancereport>
<tr>
<td.add colspan=3>
<br>
<a#addformlink href="#" onclick="return addformToggle(event)" title="Add a new transaction to the journal">Add a transaction..
<tr.item :allaccts:.inacct>
<td.journal colspan=3>
<br>
<a href=@{JournalR} title="Show all transactions in journal format">Journal
<span.hoverlinks>
&nbsp;
<a href=@{JournalEntriesR} title="Show journal entries">entries
&nbsp;
<a#editformlink href="#" onclick="return editformToggle(event)" title="Edit the journal">
edit
<tr>
<td colspan=3>
<br>
Accounts
$forall i <- items
^{itemAsHtml vd i}
<tr.totalrule>
<td colspan=3>
<tr>
<td>
<td.balance align=right>#{mixedAmountAsHtml total}
<td>
|]
where
l = ledgerFromJournal Any j
inacctmatcher = inAccountQuery qopts
allaccts = isNothing inacctmatcher
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
itemAsHtml :: ViewData -> AccountsReportItem -> HtmlUrl AppRoute
itemAsHtml _ (acct, adisplay, aindent, abal) = [hamlet|
<tr.item.#{inacctclass}>
<td.account.#{depthclass}>
#{indent}
<a href="@?{acctquery}" title="Show transactions in this account, including subaccounts">#{adisplay}
<span.hoverlinks>
$if hassubs
&nbsp;
<a href="@?{acctonlyquery}" title="Show transactions in this account only">only
<!--
&nbsp;
<a href="@?{acctsonlyquery}" title="Focus on this account and sub-accounts and hide others">-others -->
<td.balance align=right>#{mixedAmountAsHtml abal}
|]
where
hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
-- <td.numpostings align=right title="#{numpostings} transactions in this account">(#{numpostings})
-- numpostings = maybe 0 (length.apostings) $ ledgerAccount l acct
depthclass = "depth"++show aindent
inacctclass = case inacctmatcher of
Just m' -> if m' `matchesAccount` acct then "inacct" else "notinacct"
Nothing -> "" :: String
indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) "&nbsp;"
acctquery = (RegisterR, [("q", pack $ accountQuery acct)])
acctonlyquery = (RegisterR, [("q", pack $ accountOnlyQuery acct)])
accountQuery :: AccountName -> String
accountQuery a = "inacct:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
accountOnlyQuery :: AccountName -> String
accountOnlyQuery a = "inacctonly:" ++ quoteIfSpaced a -- (accountNameToAccountRegex a)
accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
accountUrl r a = (r, [("q", pack $ accountQuery a)])
-- | Render an "EntriesReport" as html for the journal entries view.
entriesReportAsHtml :: WebOpts -> ViewData -> EntriesReport -> HtmlUrl AppRoute
entriesReportAsHtml _ vd items = [hamlet|
<table.journalreport>
$forall i <- numbered items
^{itemAsHtml vd i}
|]
where
itemAsHtml :: ViewData -> (Int, EntriesReportItem) -> HtmlUrl AppRoute
itemAsHtml _ (n, t) = [hamlet|
<tr.item.#{evenodd}>
<td.transaction>
<pre>#{txn}
|]
where
evenodd = if even n then "even" else "odd" :: String
txn = trimnl $ showTransaction t where trimnl = reverse . dropWhile (=='\n') . reverse
-- | Render a "TransactionsReport" as html for the formatted journal view.
journalTransactionsReportAsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
journalTransactionsReportAsHtml _ vd (_,items) = [hamlet|
<table.journalreport>
<tr.headings>
<th.date align=left>Date
<th.description align=left>Description
<th.account align=left>Accounts
<th.amount align=right>Amount
$forall i <- numberTransactionsReportItems items
^{itemAsHtml vd i}
|]
where
-- .#{datetransition}
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
itemAsHtml VD{..} (n, _, _, _, (t, _, split, _, amt, _)) = [hamlet|
<tr.item.#{evenodd}.#{firstposting}>
<td.date>#{date}
<td.description colspan=2 title="#{show t}">#{elideRight 60 desc}
<td.amount align=right>
$if showamt
#{mixedAmountAsHtml amt}
$forall p' <- tpostings t
<tr.item.#{evenodd}.posting>
<td.date>
<td.description>
<td.account>&nbsp;<a href="@?{accountUrl here $ paccount p'}" title="Show transactions in #{paccount p'}">#{elideRight 40 $ paccount p'}
<td.amount align=right>#{mixedAmountAsHtml $ pamount p'}
|]
where
evenodd = if even n then "even" else "odd" :: String
-- datetransition | newm = "newmonth"
-- | newd = "newday"
-- | otherwise = "" :: String
(firstposting, date, desc) = (False, show $ tdate t, tdescription t)
-- acctquery = (here, [("q", pack $ accountQuery acct)])
showamt = not split || not (isZeroMixedAmount amt)
-- Generate html for an account register, including a balance chart and transaction list.
registerReportHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
registerReportHtml opts vd r@(_,items) = [hamlet|
^{registerChartHtml items}
^{registerItemsHtml opts vd r}
|]
-- Generate html for a transaction list from an "TransactionsReport".
registerItemsHtml :: WebOpts -> ViewData -> TransactionsReport -> HtmlUrl AppRoute
registerItemsHtml _ vd (balancelabel,items) = [hamlet|
<table.registerreport>
<tr.headings>
<th.date align=left>Date
<th.description align=left>Description
<th.account align=left>To/From Account
<!-- \ #
<a#all-postings-toggle-link.togglelink href="#" title="Toggle all split postings">[+] -->
<th.amount align=right>Amount
<th.balance align=right>#{balancelabel}
$forall i <- numberTransactionsReportItems items
^{itemAsHtml vd i}
|]
where
-- inacct = inAccount qopts
-- filtering = m /= Any
itemAsHtml :: ViewData -> (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
itemAsHtml VD{..} (n, newd, newm, _, (t, _, split, acct, amt, bal)) = [hamlet|
<tr.item.#{evenodd}.#{firstposting}.#{datetransition}>
<td.date>#{date}
<td.description title="#{show t}">#{elideRight 30 desc}
<td.account title="#{show t}">
<a>
#{elideRight 40 acct}
&nbsp;
<a.postings-toggle-link.togglelink href="#" title="Toggle all postings">
[+]
<td.amount align=right>
$if showamt
#{mixedAmountAsHtml amt}
<td.balance align=right>#{mixedAmountAsHtml bal}
$forall p' <- tpostings t
<tr.item.#{evenodd}.posting style=#{postingsdisplaystyle}>
<td.date>
<td.description>
<td.account>&nbsp;<a href="@?{accountUrl here $ paccount p'}" title="Show transactions in #{paccount p'}">#{elideRight 40 $ paccount p'}
<td.amount align=right>#{mixedAmountAsHtml $ pamount p'}
<td.balance align=right>
|]
where
evenodd = if even n then "even" else "odd" :: String
datetransition | newm = "newmonth"
| newd = "newday"
| otherwise = "" :: String
(firstposting, date, desc) = (False, show $ tdate t, tdescription t)
-- acctquery = (here, [("q", pack $ accountQuery acct)])
showamt = not split || not (isZeroMixedAmount amt)
postingsdisplaystyle = if showpostings then "" else "display:none;" :: String
-- | Generate javascript/html for a register balance line chart based on
-- the provided "TransactionsReportItem"s.
-- registerChartHtml :: forall t (t1 :: * -> *) t2 t3 t4 t5.
-- Data.Foldable.Foldable t1 =>
-- t1 (Transaction, t2, t3, t4, t5, MixedAmount)
-- -> t -> Text.Blaze.Internal.HtmlM ()
registerChartHtml :: [TransactionsReportItem] -> HtmlUrl AppRoute
registerChartHtml items =
-- have to make sure plot is not called when our container (maincontent)
-- is hidden, eg with add form toggled
[hamlet|
<div#register-chart style="width:600px;height:100px; margin-bottom:1em;">
<script type=text/javascript>
\$(document).ready(function() {
/* render chart with flot, if visible */
var chartdiv = $('#register-chart');
if (chartdiv.is(':visible'))
\$.plot(chartdiv,
[
[
$forall i <- items
[#{dayToJsTimestamp $ triDate i}, #{triBalance i}],
]
],
{
xaxis: {
mode: "time",
timeformat: "%y/%m/%d"
}
}
);
});
|]
-- stringIfLongerThan :: Int -> String -> String
-- stringIfLongerThan n s = if length s > n then s else ""
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
numberTransactionsReportItems [] = []
numberTransactionsReportItems items = number 0 nulldate items
where
number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)]
number _ _ [] = []
number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):is) = (n+1,newday,newmonth,newyear,i):(number (n+1) d is)
where
newday = d/=prevd
newmonth = dm/=prevdm || dy/=prevdy
newyear = dy/=prevdy
(dy,dm,_) = toGregorian d
(prevdy,prevdm,_) = toGregorian prevd
mixedAmountAsHtml :: MixedAmount -> Html
mixedAmountAsHtml b = preEscapedString $ addclass $ intercalate "<br>" $ lines $ showMixedAmount b
where addclass = printf "<span class=\"%s\">%s</span>" (c :: String)
c = case isNegativeMixedAmount b of Just True -> "negative amount"
_ -> "positive amount"