112 lines
4.0 KiB
Haskell
112 lines
4.0 KiB
Haskell
{-# LANGUAGE CPP, OverloadedStrings, QuasiQuotes, NamedFieldPuns #-}
|
|
-- | Common page components and rendering helpers.
|
|
-- For global page layout, see Application.hs.
|
|
|
|
module Handler.Common where
|
|
|
|
import Data.Semigroup ((<>))
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import Data.Time.Calendar (Day, toGregorian)
|
|
import Text.Blaze (ToMarkup)
|
|
import Text.Blaze.Internal (preEscapedString)
|
|
import Yesod
|
|
|
|
import Settings (manualurl)
|
|
|
|
import Hledger
|
|
|
|
-- -- | Navigation link, preserving parameters and possibly highlighted.
|
|
-- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute
|
|
-- navlink VD{..} s dest title = [hamlet|
|
|
-- <a##{s}link.#{style} href=@?{u'} title="#{title}">#{s}
|
|
-- |]
|
|
-- where u' = (dest, if null q then [] else [("q", pack q)])
|
|
-- style | dest == here = "navlinkcurrent"
|
|
-- | otherwise = "navlink" :: Text
|
|
|
|
-- -- | Links to the various journal editing forms.
|
|
-- editlinks :: HtmlUrl AppRoute
|
|
-- editlinks = [hamlet|
|
|
-- <a#editformlink href="#" onclick="return editformToggle(event)" title="Toggle journal edit form">edit
|
|
-- \ | #
|
|
-- <a#addformlink href="#" onclick="return addformToggle(event)" title="Toggle transaction add form">add
|
|
-- <a#importformlink href="#" onclick="return importformToggle(event)" style="display:none;">import transactions
|
|
-- |]
|
|
|
|
-- | Link to a topic in the manual.
|
|
helplink :: Text -> Text -> HtmlUrl r
|
|
helplink topic label = [hamlet|<a href=#{u} target=hledgerhelp>#{label}|]
|
|
where u = manualurl <> if T.null topic then "" else T.cons '#' topic
|
|
|
|
----------------------------------------------------------------------
|
|
-- hledger report renderers
|
|
|
|
-- | Render a "BalanceReport" as html.
|
|
balanceReportAsHtml :: r -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
|
|
balanceReportAsHtml registerR j qopts (items, total) = [hamlet|
|
|
$forall (acct, adisplay, aindent, abal) <- items
|
|
<tr .#{inacctClass acct}>
|
|
<td .acct>
|
|
<div .ff-wrapper>
|
|
\#{indent aindent}
|
|
<a href="@?{acctLink acct}" .#{inacctClass acct}
|
|
title="Show transactions affecting this account and subaccounts">
|
|
#{adisplay}
|
|
$if hasSubs acct
|
|
<a href="@?{acctOnlyLink acct}" .only .hidden-sm .hidden-xs
|
|
title="Show transactions affecting this account but not subaccounts">only
|
|
<td>
|
|
^{mixedAmountAsHtml abal}
|
|
<tr .total>
|
|
<td>
|
|
<td>
|
|
^{mixedAmountAsHtml total}
|
|
|] where
|
|
l = ledgerFromJournal Any j
|
|
inacctClass acct = case inAccountQuery qopts of
|
|
Just m' -> if m' `matchesAccount` acct then "inacct" else ""
|
|
Nothing -> "" :: Text
|
|
hasSubs acct = maybe True (not . null . asubs) (ledgerAccount l acct)
|
|
indent a = preEscapedString $ concat $ replicate (2 + 2 * a) " "
|
|
acctLink acct = (registerR, [("q", accountQuery acct)])
|
|
acctOnlyLink acct = (registerR, [("q", accountOnlyQuery acct)])
|
|
|
|
accountQuery :: AccountName -> Text
|
|
accountQuery = ("inacct:" <>) . quoteIfSpaced
|
|
|
|
accountOnlyQuery :: AccountName -> Text
|
|
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
|
|
|
|
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
|
|
numberTransactionsReportItems [] = []
|
|
numberTransactionsReportItems items = number 0 nulldate items
|
|
where
|
|
number :: Int -> Day -> [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
|
|
number _ _ [] = []
|
|
number n prevd (i@(t, _, _, _, _, _):rest) = (n+1, newday, newmonth, i): number (n+1) d rest
|
|
where
|
|
d = tdate t
|
|
newday = d /= prevd
|
|
newmonth = dm /= prevdm || dy /= prevdy
|
|
(dy, dm, _) = toGregorian d
|
|
(prevdy, prevdm, _) = toGregorian prevd
|
|
|
|
mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
|
|
mixedAmountAsHtml b = [hamlet|
|
|
$forall t <- ts
|
|
<span .#{c}>#{t}
|
|
<br>
|
|
|] where
|
|
ts = T.lines . T.pack $ showMixedAmountWithoutPrice b
|
|
c = case isNegativeMixedAmount b of
|
|
Just True -> "negative amount" :: Text
|
|
_ -> "positive amount"
|
|
|
|
showErrors :: ToMarkup a => [a] -> HandlerFor m ()
|
|
showErrors errs = setMessage [shamlet|
|
|
Errors:<br>
|
|
$forall e <- errs
|
|
\#{e}<br>
|
|
|]
|