slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

web: Simplify hledgerLayout into defaultLayout

Browse Source
This commit is contained in:
Jakub Zárybnický 2018-06-09 17:23:18 +02:00
parent 9beec88727
commit 0e7b713a80
6 changed files with 173 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
hledger-web/src/Foundation.hs
View File

@ -9,8 +9,10 @@ import Data.IORef (IORef, readIORef, writeIORef)
import Data.List (isPrefixOf) import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day) import Data.Time.Calendar (Day)
import Network.HTTP.Conduit (Manager) import Network.HTTP.Conduit (Manager)
import System.FilePath (takeFileName)
import Text.Blaze (Markup) import Text.Blaze (Markup)
import Text.Blaze.Html.Renderer.String (renderHtml) import Text.Blaze.Html.Renderer.String (renderHtml)
import Text.Hamlet (hamletFile) import Text.Hamlet (hamletFile)
@ -19,6 +21,7 @@ import Yesod.Static
import Yesod.Default.Config import Yesod.Default.Config
import Handler.AddForm import Handler.AddForm
import Handler.Common (balanceReportAsHtml)
import Settings.StaticFiles import Settings.StaticFiles
import Settings (widgetFile, Extra (..)) import Settings (widgetFile, Extra (..))
#ifndef DEVELOPMENT #ifndef DEVELOPMENT
@ -28,7 +31,7 @@ import Yesod.Default.Util (addStaticContentExternal)
#endif #endif
import Hledger import Hledger
import Hledger.Cli import Hledger.Cli (CliOpts(..), journalReloadIfChanged)
import Hledger.Web.WebOptions import Hledger.Web.WebOptions
-- | The site argument for your application. This can be a good place to -- | The site argument for your application. This can be a good place to
@ -78,50 +81,63 @@ type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget)
-- Please see the documentation for the Yesod typeclass. There are a number -- Please see the documentation for the Yesod typeclass. There are a number
-- of settings which can be configured by overriding methods here. -- of settings which can be configured by overriding methods here.
instance Yesod App where instance Yesod App where
approot = ApprootMaster $ appRoot . settings approot = ApprootMaster $ appRoot . settings
-- don't use session data -- don't use session data
makeSessionBackend _ = return Nothing makeSessionBackend _ = return Nothing
defaultLayout widget = do defaultLayout widget = do
master <- getYesod master <- getYesod
lastmsg <- getMessage lastmsg <- getMessage
VD{j, opts} <- getViewData VD{am, here, j, opts, q, qopts, showsidebar} <- getViewData
-- We break up the default layout into two components: let journalcurrent = if here == JournalR then "inacct" else "" :: Text
-- default-layout is the contents of the body tag, and ropts = reportopts_ (cliopts_ opts)
-- default-layout-wrapper is the entire page. Since the final -- flip the default for items with zero amounts, show them by default
-- value passed to hamletToRepHtml cannot be a widget, this allows ropts' = ropts { empty_ = not (empty_ ropts) }
-- you to use normal widget features in default-layout. accounts = balanceReportAsHtml RegisterR j qopts $ balanceReport ropts' am j
pc <- widgetToPageContent $ do
addStylesheet $ StaticR css_bootstrap_min_css
addStylesheet $ StaticR css_bootstrap_datepicker_standalone_min_css
-- load these things early, in HEAD:
toWidgetHead [hamlet|
<script type="text/javascript" src="@{StaticR js_jquery_min_js}">
<script type="text/javascript" src="@{StaticR js_typeahead_bundle_min_js}">
|]
addScript $ StaticR js_bootstrap_min_js
addScript $ StaticR js_bootstrap_datepicker_min_js
addScript $ StaticR js_jquery_url_js
addScript $ StaticR js_jquery_cookie_js
addScript $ StaticR js_jquery_hotkeys_js
addScript $ StaticR js_jquery_flot_min_js
addScript $ StaticR js_jquery_flot_time_min_js
addScript $ StaticR js_jquery_flot_tooltip_min_js
toWidget [hamlet| \<!--[if lte IE 8]> <script type="text/javascript" src="@{StaticR js_excanvas_min_js}"></script> <![endif]--> |]
addStylesheet $ StaticR hledger_css
addScript $ StaticR hledger_js
$(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") topShowmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
topShowsm = if showsidebar then "col-sm-4" else "" :: Text
sideShowmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
sideShowsm = if showsidebar then "col-sm-4" else "" :: Text
mainShowmd = if showsidebar then "col-md-8" else "col-md-12" :: Text
mainShowsm = if showsidebar then "col-sm-8" else "col-sm-12" :: Text
-- We break up the default layout into two components:
-- default-layout is the contents of the body tag, and
-- default-layout-wrapper is the entire page. Since the final
-- value passed to hamletToRepHtml cannot be a widget, this allows
-- you to use normal widget features in default-layout.
pc <- widgetToPageContent $ do
addStylesheet $ StaticR css_bootstrap_min_css
addStylesheet $ StaticR css_bootstrap_datepicker_standalone_min_css
-- load these things early, in HEAD:
toWidgetHead [hamlet|
<script type="text/javascript" src="@{StaticR js_jquery_min_js}">
<script type="text/javascript" src="@{StaticR js_typeahead_bundle_min_js}">
|]
addScript $ StaticR js_bootstrap_min_js
addScript $ StaticR js_bootstrap_datepicker_min_js
addScript $ StaticR js_jquery_url_js
addScript $ StaticR js_jquery_cookie_js
addScript $ StaticR js_jquery_hotkeys_js
addScript $ StaticR js_jquery_flot_min_js
addScript $ StaticR js_jquery_flot_time_min_js
addScript $ StaticR js_jquery_flot_tooltip_min_js
toWidget [hamlet| \<!--[if lte IE 8]> <script type="text/javascript" src="@{StaticR js_excanvas_min_js}"></script> <![endif]--> |]
addStylesheet $ StaticR hledger_css
addScript $ StaticR hledger_js
$(widgetFile "default-layout")
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
#ifndef DEVELOPMENT #ifndef DEVELOPMENT
-- This function creates static content files in the static folder -- This function creates static content files in the static folder
-- and names them based on a hash of their content. This allows -- and names them based on a hash of their content. This allows
-- expiration dates to be set far in the future without worry of -- expiration dates to be set far in the future without worry of
-- users receiving stale content. -- users receiving stale content.
addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute []) addStaticContent = addStaticContentExternal minifym base64md5 Settings.staticDir (StaticR . flip StaticRoute [])
#endif #endif
-- This instance is required to use forms. You can modify renderMessage to -- This instance is required to use forms. You can modify renderMessage to

2
hledger-web/src/Handler/AddR.hs
View File

@ -62,7 +62,7 @@ postAddR = do
Right t -> do Right t -> do
-- 3. all fields look good and form a balanced transaction; append it to the file -- 3. all fields look good and form a balanced transaction; append it to the file
liftIO (appendTransaction journalfile t) liftIO (appendTransaction journalfile t)
setMessage [shamlet|<span>Transaction added.|] setMessage "Transaction added."
redirect JournalR redirect JournalR
where where
bail :: [Text] -> Handler () bail :: [Text] -> Handler ()

194
hledger-web/src/Handler/Common.hs
View File

@ -4,80 +4,17 @@
module Handler.Common where module Handler.Common where
import Import import Data.Semigroup ((<>))
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar (Day, toGregorian) import Data.Time.Calendar (Day, toGregorian)
import System.FilePath (takeFileName)
import Text.Blaze (ToMarkup) import Text.Blaze (ToMarkup)
import Text.Blaze.Internal (preEscapedString) import Text.Blaze.Internal (preEscapedString)
import Text.Printf (printf) import Yesod
import Hledger.Cli.CliOptions import Settings (manualurl)
import Hledger.Data
import Hledger.Query
import Hledger.Reports
import Hledger.Utils
import Hledger.Web.WebOptions
------------------------------------------------------------------------------- import Hledger
-- Common page layout
-- | Standard hledger-web page layout.
#if MIN_VERSION_yesod(1,6,0)
hledgerLayout :: ViewData -> Text -> HtmlUrl AppRoute -> HandlerFor App Html
#else
hledgerLayout :: ViewData -> Text -> HtmlUrl AppRoute -> HandlerT App IO Html
#endif
hledgerLayout vd title content = do
defaultLayout $ do
setTitle $ toHtml $ title <> " - hledger-web"
toWidget [hamlet|
^{topbar vd}
^{sidebar vd}
<div #main-content .col-xs-12 .#{showmd} .#{showsm}>
^{searchform vd}
^{content}
|]
where
showmd = if showsidebar vd then "col-md-8" else "col-md-12" :: Text
showsm = if showsidebar vd then "col-sm-8" else "col-sm-12" :: Text
-- | Global toolbar/heading area.
topbar :: ViewData -> HtmlUrl AppRoute
topbar VD{j, showsidebar} = [hamlet|
<div#spacer .#{showsm} .#{showmd} .col-xs-2>
<h1>
<button .visible-xs .btn .btn-default type="button" data-toggle="offcanvas">
<span .glyphicon .glyphicon-align-left .tgl-icon>
<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
<h1>#{title}
|]
where
title = takeFileName $ journalFilePath j
showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
showsm = if showsidebar then "col-sm-4" else "" :: Text
-- | The sidebar used on most views.
sidebar :: ViewData -> HtmlUrl AppRoute
sidebar vd@VD{am, here, j, opts, showsidebar} =
[hamlet|
<div #sidebar-menu .#{showmd} .#{showsm} .sidebar-offcanvas>
<table .main-menu .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 "" :: Text
ropts = reportopts_ $ cliopts_ opts
-- flip the default for items with zero amounts, show them by default
ropts' = ropts{empty_=not $ empty_ ropts}
accounts = balanceReportAsHtml vd $ balanceReport ropts' am j
showmd = if showsidebar then "col-md-4" else "col-any-0" :: Text
showsm = if showsidebar then "col-sm-4" else "" :: Text
-- -- | Navigation link, preserving parameters and possibly highlighted. -- -- | Navigation link, preserving parameters and possibly highlighted.
-- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute -- navlink :: ViewData -> String -> AppRoute -> String -> HtmlUrl AppRoute
@ -97,67 +34,43 @@ sidebar vd@VD{am, here, j, opts, showsidebar} =
-- <a#importformlink href="#" onclick="return importformToggle(event)" style="display:none;">import transactions -- <a#importformlink href="#" onclick="return importformToggle(event)" style="display:none;">import transactions
-- |] -- |]
-- | Search form for entering custom queries to filter journal data.
searchform :: ViewData -> HtmlUrl AppRoute
searchform VD{q, here} = [hamlet|
<div#searchformdiv .row>
<form#searchform .form-inline method=GET>
<div .form-group .col-md-12 .col-sm-12 .col-xs-12>
<div #searchbar .input-group>
<input .form-control name=q value=#{q} title="Enter hledger search patterns to filter the data below" placeholder="Search">
<div .input-group-btn>
$if not (T.null q)
<a href=@{here} .btn .btn-default title="Clear search terms">
<span .glyphicon .glyphicon-remove-circle>
<button .btn .btn-default type=submit title="Apply search terms">
<span .glyphicon .glyphicon-search>
<button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">?
|]
-- | Link to a topic in the manual. -- | Link to a topic in the manual.
helplink :: Text -> Text -> HtmlUrl AppRoute helplink :: Text -> Text -> HtmlUrl r
helplink topic label = [hamlet| helplink topic label = [hamlet|<a href=#{u} target=hledgerhelp>#{label}|]
<a href=#{u} target=hledgerhelp>#{label} where u = manualurl <> if T.null topic then "" else T.cons '#' topic
|]
where u = manualurl <> if T.null topic then "" else T.cons '#' topic
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- hledger report renderers -- hledger report renderers
-- | Render a "BalanceReport" as html. -- | Render a "BalanceReport" as html.
balanceReportAsHtml :: ViewData -> BalanceReport -> HtmlUrl AppRoute balanceReportAsHtml :: r -> Journal -> [QueryOpt] -> BalanceReport -> HtmlUrl r
balanceReportAsHtml VD{j, qopts} (items, total) = balanceReportAsHtml registerR j qopts (items, total) = [hamlet|
[hamlet| $forall (acct, adisplay, aindent, abal) <- items
$forall i <- items <tr .#{inacctClass acct}>
^{itemAsHtml i} <td .acct>
<tr .total> <div .ff-wrapper>
<td> \#{indent aindent}
<td> <a href="@?{acctLink acct}" .#{inacctClass acct}
#{mixedAmountAsHtml total} title="Show transactions affecting this account and subaccounts">
|] #{adisplay}
where $if hasSubs acct
l = ledgerFromJournal Any j <a href="@?{acctOnlyLink acct}" .only .hidden-sm .hidden-xs
inacctmatcher = inAccountQuery qopts title="Show transactions affecting this account but not subaccounts">only
itemAsHtml :: BalanceReportItem -> HtmlUrl AppRoute <td>
itemAsHtml (acct, adisplay, aindent, abal) = [hamlet| ^{mixedAmountAsHtml abal}
<tr .#{inacctclass}> <tr .total>
<td .acct> <td>
<div .ff-wrapper> <td>
\#{indent} ^{mixedAmountAsHtml total}
<a href="@?{acctquery}" .#{inacctclass} title="Show transactions affecting this account and subaccounts">#{adisplay} |] where
$if hassubs l = ledgerFromJournal Any j
<a href="@?{acctonlyquery}" .only .hidden-sm .hidden-xs title="Show transactions affecting this account but not subaccounts">only inacctClass acct = case inAccountQuery qopts of
<td> Just m' -> if m' `matchesAccount` acct then "inacct" else ""
#{mixedAmountAsHtml abal} Nothing -> "" :: Text
|] hasSubs acct = maybe True (not . null . asubs) (ledgerAccount l acct)
where indent a = preEscapedString $ concat $ replicate (2 + 2 * a) "&nbsp;"
hassubs = not $ maybe False (null.asubs) $ ledgerAccount l acct acctLink acct = (registerR, [("q", accountQuery acct)])
inacctclass = case inacctmatcher of acctOnlyLink acct = (registerR, [("q", accountOnlyQuery acct)])
Just m' -> if m' `matchesAccount` acct then "inacct" else ""
Nothing -> "" :: Text
indent = preEscapedString $ concat $ replicate (2 * (1+aindent)) "&nbsp;"
acctquery = (RegisterR, [("q", accountQuery acct)])
acctonlyquery = (RegisterR, [("q", accountOnlyQuery acct)])
accountQuery :: AccountName -> Text accountQuery :: AccountName -> Text
accountQuery = ("inacct:" <>) . quoteIfSpaced accountQuery = ("inacct:" <>) . quoteIfSpaced
@ -165,28 +78,31 @@ accountQuery = ("inacct:" <>) . quoteIfSpaced
accountOnlyQuery :: AccountName -> Text accountOnlyQuery :: AccountName -> Text
accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced accountOnlyQuery = ("inacctonly:" <>) . quoteIfSpaced
numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)] numberTransactionsReportItems :: [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
numberTransactionsReportItems [] = [] numberTransactionsReportItems [] = []
numberTransactionsReportItems items = number 0 nulldate items numberTransactionsReportItems items = number 0 nulldate items
where where
number :: Int -> Day -> [TransactionsReportItem] -> [(Int,Bool,Bool,Bool,TransactionsReportItem)] number :: Int -> Day -> [TransactionsReportItem] -> [(Int, Bool, Bool, TransactionsReportItem)]
number _ _ [] = [] number _ _ [] = []
number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):rest) = (n+1,newday,newmonth,newyear,i): number (n+1) d rest number n prevd (i@(Transaction{tdate=d},_,_,_,_,_):rest) = (n+1, newday, newmonth, i): number (n+1) d rest
where where
newday = d/=prevd newday = d /= prevd
newmonth = dm/=prevdm || dy/=prevdy newmonth = dm /= prevdm || dy /= prevdy
newyear = dy/=prevdy (dy, dm, _) = toGregorian d
(dy,dm,_) = toGregorian d (prevdy, prevdm, _) = toGregorian prevd
(prevdy,prevdm,_) = toGregorian prevd
mixedAmountAsHtml :: MixedAmount -> Html mixedAmountAsHtml :: MixedAmount -> HtmlUrl a
mixedAmountAsHtml b = preEscapedString $ unlines $ map addclass $ lines $ showMixedAmountWithoutPrice b mixedAmountAsHtml b = [hamlet|
where addclass = printf "<span class=\"%s\">%s</span><br/>" (c :: Text) $forall t <- ts
c = case isNegativeMixedAmount b of <span .#{c}>#{t}
Just True -> "negative amount" <br>
_ -> "positive amount" |] where
ts = T.lines . T.pack $ showMixedAmountWithoutPrice b
c = case isNegativeMixedAmount b of
Just True -> "negative amount" :: Text
_ -> "positive amount"
showErrors :: ToMarkup a => [a] -> Handler () showErrors :: ToMarkup a => [a] -> HandlerFor a ()
showErrors errs = setMessage [shamlet| showErrors errs = setMessage [shamlet|
Errors:<br> Errors:<br>
$forall e<-errs $forall e<-errs

34
hledger-web/src/Handler/JournalR.hs
View File

@ -5,9 +5,7 @@ module Handler.JournalR where
import Import import Import
import Handler.Common import Handler.Common (accountQuery, mixedAmountAsHtml)
(accountQuery, hledgerLayout, mixedAmountAsHtml,
numberTransactionsReportItems)
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
import Hledger.Data import Hledger.Data
@ -19,21 +17,23 @@ import Hledger.Web.WebOptions
-- | The formatted journal view, with sidebar. -- | The formatted journal view, with sidebar.
getJournalR :: Handler Html getJournalR :: Handler Html
getJournalR = do getJournalR = do
vd@VD{j, m, opts, qopts} <- getViewData VD{j, m, opts, qopts} <- getViewData
-- XXX like registerReportAsHtml -- XXX like registerReportAsHtml
let title = case inAccount qopts of let title = case inAccount qopts of
Nothing -> "General Journal" Nothing -> "General Journal"
Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)" Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)"
title' = title <> if m /= Any then ", filtered" else "" title' = title <> if m /= Any then ", filtered" else ""
maincontent = transactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m maincontent = transactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m
hledgerLayout vd "journal" [hamlet| defaultLayout $ do
<div .row> setTitle "journal - hledger-web"
<h2 #contenttitle>#{title'} toWidget [hamlet|
<!-- p>Journal entries record movements of commodities between accounts. --> <div .row>
<a #addformlink role="button" style="cursor:pointer; margin-top:1em;" data-toggle="modal" data-target="#addmodal" title="Add a new transaction to the journal" href="#">Add a transaction <h2 #contenttitle>#{title'}
<div .table-responsive> <!-- p>Journal entries record movements of commodities between accounts. -->
^{maincontent} <a #addformlink role="button" style="cursor:pointer; margin-top:1em;" data-toggle="modal" data-target="#addmodal" title="Add a new transaction to the journal" href="#">Add a transaction
|] <div .table-responsive>
^{maincontent}
|]
-- | Render a "TransactionsReport" as html for the formatted journal view. -- | Render a "TransactionsReport" as html for the formatted journal view.
transactionsReportAsHtml :: (w, [TransactionsReportItem]) -> HtmlUrl AppRoute transactionsReportAsHtml :: (w, [TransactionsReportItem]) -> HtmlUrl AppRoute
@ -45,18 +45,18 @@ transactionsReportAsHtml (_,items) = [hamlet|
<th .description style="text-align:left;">Description <th .description style="text-align:left;">Description
<th .account style="text-align:left;">Account <th .account style="text-align:left;">Account
<th .amount style="text-align:right;">Amount <th .amount style="text-align:right;">Amount
$forall i <- numberTransactionsReportItems items $forall i <- items
^{transactionReportItem i} ^{transactionReportItem i}
|] |]
transactionReportItem :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute transactionReportItem :: TransactionsReportItem -> HtmlUrl AppRoute
transactionReportItem (_, _, _, _, (torig, _, split, _, amt, _)) = [hamlet| transactionReportItem (torig, _, split, _, amt, _) = [hamlet|
<tr .title #transaction-#{tindex torig}> <tr .title #transaction-#{tindex torig}>
<td .date nowrap>#{date} <td .date nowrap>#{date}
<td .description colspan=2>#{textElideRight 60 desc} <td .description colspan=2>#{textElideRight 60 desc}
<td .amount style="text-align:right;"> <td .amount style="text-align:right;">
$if showamt $if showamt
\#{mixedAmountAsHtml amt} \^{mixedAmountAsHtml amt}
$forall p' <- tpostings torig $forall p' <- tpostings torig
<tr .item .posting title="#{show torig}"> <tr .item .posting title="#{show torig}">
<td .nonhead> <td .nonhead>
@ -64,7 +64,7 @@ $forall p' <- tpostings torig
<td .nonhead> <td .nonhead>
&nbsp; &nbsp;
<a href="@?{acctlink (paccount p')}##{tindex torig}" title="#{paccount p'}">#{elideAccountName 40 $ paccount p'} <a href="@?{acctlink (paccount p')}##{tindex torig}" title="#{paccount p'}">#{elideAccountName 40 $ paccount p'}
<td .amount .nonhead style="text-align:right;">#{mixedAmountAsHtml $ pamount p'} <td .amount .nonhead style="text-align:right;">^{mixedAmountAsHtml $ pamount p'}
|] |]
where where
acctlink a = (RegisterR, [("q", accountQuery a)]) acctlink a = (RegisterR, [("q", accountQuery a)])

19
hledger-web/src/Handler/RegisterR.hs
View File

@ -10,7 +10,7 @@ import Data.List (intersperse)
import qualified Data.Text as T import qualified Data.Text as T
import Safe (headMay) import Safe (headMay)
import Handler.Common (hledgerLayout, numberTransactionsReportItems, mixedAmountAsHtml) import Handler.Common (mixedAmountAsHtml, numberTransactionsReportItems)
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -19,15 +19,16 @@ import Hledger.Web.WebOptions
-- | The main journal/account register view, with accounts sidebar. -- | The main journal/account register view, with accounts sidebar.
getRegisterR :: Handler Html getRegisterR :: Handler Html
getRegisterR = do getRegisterR = do
vd@VD{j, m, opts, qopts} <- getViewData VD{j, m, opts, qopts} <- getViewData
let title = a <> s1 <> s2 let title = a <> s1 <> s2
where where
(a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts
s1 = if inclsubs then "" else " (excluding subaccounts)" s1 = if inclsubs then "" else " (excluding subaccounts)"
s2 = if m /= Any then ", filtered" else "" s2 = if m /= Any then ", filtered" else ""
hledgerLayout vd "register" $ do defaultLayout $ do
_ <- [hamlet|<h2 #contenttitle>#{title}|] setTitle "register - hledger-web"
registerReportHtml qopts $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts _ <- toWidget [hamlet|<h2 #contenttitle>#{title}|]
toWidget $ registerReportHtml qopts $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts
-- | Generate html for an account register, including a balance chart and transaction list. -- | Generate html for an account register, including a balance chart and transaction list.
registerReportHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute registerReportHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute
@ -58,8 +59,8 @@ registerItemsHtml qopts (balancelabel,items) = [hamlet|
insomeacct = isJust $ inAccount qopts insomeacct = isJust $ inAccount qopts
balancelabel' = if insomeacct then balancelabel else "Total" balancelabel' = if insomeacct then balancelabel else "Total"
itemAsHtml :: (Int, Bool, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute itemAsHtml :: (Int, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute
itemAsHtml (n, newd, newm, _, (torig, tacct, split, acct, amt, bal)) = [hamlet| itemAsHtml (n, newd, newm, (torig, tacct, split, acct, amt, bal)) = [hamlet|
<tr ##{tindex torig} .item.#{evenodd}.#{firstposting}.#{datetransition} title="#{show torig}" style="vertical-align:top;"> <tr ##{tindex torig} .item.#{evenodd}.#{firstposting}.#{datetransition} title="#{show torig}" style="vertical-align:top;">
<td .date> <td .date>
<a href="@{JournalR}#transaction-#{tindex torig}">#{date} <a href="@{JournalR}#transaction-#{tindex torig}">#{date}
@ -67,8 +68,8 @@ registerItemsHtml qopts (balancelabel,items) = [hamlet|
<td .account>#{elideRight 40 acct} <td .account>#{elideRight 40 acct}
<td .amount style="text-align:right; white-space:nowrap;"> <td .amount style="text-align:right; white-space:nowrap;">
$if showamt $if showamt
\#{mixedAmountAsHtml amt} \^{mixedAmountAsHtml amt}
<td .balance style="text-align:right;">#{mixedAmountAsHtml bal} <td .balance style="text-align:right;">^{mixedAmountAsHtml bal}
|] |]
where where
evenodd = if even n then "even" else "odd" :: Text evenodd = if even n then "even" else "odd" :: Text

36
hledger-web/templates/default-layout.hamlet
View File

@ -1,4 +1,38 @@
$maybe m <- lastmsg $maybe m <- lastmsg
$if not $ isPrefixOf "Errors" (renderHtml m) $if not $ isPrefixOf "Errors" (renderHtml m)
<div #message>#{m} <div #message>#{m}
^{widget}
<div#spacer .col-xs-2.#{topShowsm}.#{topShowmd}>
<h1>
<button .visible-xs.btn.btn-default type="button" data-toggle="offcanvas">
<span .glyphicon.glyphicon-align-left.tgl-icon>
<div#topbar .col-md-8 .col-sm-8 .col-xs-10>
<h1>#{takeFileName (journalFilePath j)}
<div #sidebar-menu .sidebar-offcanvas.#{sideShowmd}.#{sideShowsm}>
<table .main-menu .table>
<tr .#{journalcurrent}>
<td .top .acct>
<a href=@{JournalR} .#{journalcurrent}
title="Show general journal entries, most recent first">
Journal
<td .top>
^{accounts}
<div #main-content .col-xs-12.#{mainShowmd}.#{mainShowsm}>
<div#searchformdiv .row>
<form#searchform .form-inline method=GET>
<div .form-group .col-md-12 .col-sm-12 .col-xs-12>
<div #searchbar .input-group>
<input .form-control name=q value=#{q} placeholder="Search"
title="Enter hledger search patterns to filter the data below">
<div .input-group-btn>
$if not (T.null q)
<a href=@{here} .btn .btn-default title="Clear search terms">
<span .glyphicon .glyphicon-remove-circle>
<button .btn .btn-default type=submit title="Apply search terms">
<span .glyphicon .glyphicon-search>
<button .btn .btn-default type=button data-toggle="modal" data-target="#helpmodal"
title="Show search and general help">?
^{widget}