module Handler.Common where
import Import
import qualified Data.Text as T
import Data.Time.Calendar
import System.FilePath (takeFileName)
#if BLAZE_HTML_0_4
import Text.Blaze (preEscapedString)
#else
import Text.Blaze.Internal (preEscapedString)
#endif
import Text.Printf
import Hledger.Utils
import Hledger.Data
import Hledger.Query
import Hledger.Reports
import Hledger.Cli.CliOptions
import Hledger.Web.WebOptions
hledgerLayout :: ViewData -> String -> HtmlUrl AppRoute -> HandlerT App IO Html
hledgerLayout vd title content = do
defaultLayout $ do
setTitle $ toHtml $ title ++ " - hledger-web"
toWidget [hamlet|
^{topbar vd}
^{sidebar vd}
<div #maincontent .colxs12 .#{showmd} .#{showsm}>
^{searchform vd}
^{content}
|]
where
showmd = if showsidebar vd then "col-md-8" else "col-md-12" :: String
showsm = if showsidebar vd then "col-sm-8" else "col-sm-12" :: String
topbar :: ViewData -> HtmlUrl AppRoute
topbar VD{..} = [hamlet|
<div#spacer .#{showsm} .#{showmd} .colxs2>
<h1>
<button .visiblexs .btn .btndefault type="button" datatoggle="offcanvas">
<span .glyphicon .glyphiconalignleft .tglicon>
<div#topbar .colmd8 .colsm8 .colxs10>
<h1>#{title}
|]
where
title = takeFileName $ journalFilePath j
showmd = if showsidebar then "col-md-4" else "col-any-0" :: String
showsm = if showsidebar then "col-sm-4" else "" :: String
sidebar :: ViewData -> HtmlUrl AppRoute
sidebar vd@VD{..} =
[hamlet|
<div #sidebarmenu .#{showmd} .#{showsm} .sidebaroffcanvas>
<table .mainmenu .table>
<tr .#{journalcurrent}>
<td .top .acct>
<a href=@{JournalR} .#{journalcurrent} title="Show general journal entries, most recent first">Journal
<td .top>
^{accounts}
|]
where
journalcurrent = if here == JournalR then "inacct" else "" :: String
accounts = balanceReportAsHtml opts vd $ balanceReport (reportopts_ $ cliopts_ opts){empty_=True} am j
showmd = if showsidebar then "col-md-4" else "col-any-0" :: String
showsm = if showsidebar then "col-sm-4" else "" :: String
searchform :: ViewData -> HtmlUrl AppRoute
searchform VD{..} = [hamlet|
<div#searchformdiv .row>
<form#searchform .forminline method=GET>
<div .formgroup .colmd12 .colsm12 .colxs12>
<div #searchbar .inputgroup>
<input .formcontrol name=q value=#{q} title="Enter hledger search patterns to filter the data below" placeholder="Search">
<div .inputgroupbtn>
$if filtering
<a href=@{here} .btn .btndefault title="Clear search terms">
<span .glyphicon .glyphiconremovecircle>
<button .btn .btndefault type=submit title="Apply search terms">
<span .glyphicon .glyphiconsearch>
<button .btn .btndefault type=button datatoggle="modal" datatarget="#helpmodal" title="Show search and general help">?
|]
where
filtering = not $ null q
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||]
balanceReportAsHtml :: WebOpts -> ViewData -> BalanceReport -> HtmlUrl AppRoute
balanceReportAsHtml _ vd@VD{..} (items',total) =
[hamlet|
$forall i <- items
^{itemAsHtml vd i}
<tr .total>
<td>
<td>
#{mixedAmountAsHtml total}
|]
where
l = ledgerFromJournal Any j
inacctmatcher = inAccountQuery qopts
items = items'
itemAsHtml :: ViewData -> BalanceReportItem -> HtmlUrl AppRoute
itemAsHtml _ (acct, adisplay, aindent, abal) = [hamlet|
<tr .#{inacctclass}>
<td .acct>
<div .ffwrapper>
\#{indent}
<a href="@?{acctquery}" .#{inacctclass} title="Show transactions affecting this account and subaccounts">#{adisplay}
$if hassubs
<a href="@?{acctonlyquery}" .only .hiddensm .hiddenxs title="Show transactions affecting this account but not subaccounts">only
<td>
#{mixedAmountAsHtml abal}
|]
where
hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct
inacctclass = case inacctmatcher of
Just m' -> if m' `matchesAccount` acct then "inacct" else ""
Nothing -> "" :: String
indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) " "
acctquery = (RegisterR, [("q", T.pack $ accountQuery acct)])
acctonlyquery = (RegisterR, [("q", T.pack $ accountOnlyQuery acct)])
accountQuery :: AccountName -> String
accountQuery a = "inacct:" ++ T.unpack (quoteIfSpaced a)
accountOnlyQuery :: AccountName -> String
accountOnlyQuery a = "inacctonly:" ++ T.unpack (quoteIfSpaced a )
accountUrl :: AppRoute -> AccountName -> (AppRoute, [(Text, Text)])
accountUrl r a = (r, [("q", T.pack $ accountQuery a)])
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},_,_,_,_,_):rest) = (n+1,newday,newmonth,newyear,i): number (n+1) d rest
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 $ unlines $ map addclass $ lines $ showMixedAmountWithoutPrice b
where addclass = printf "<span class=\"%s\">%s</span><br/>" (c :: String)
c = case isNegativeMixedAmount b of Just True -> "negative amount"
_ -> "positive amount"