mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 10:47:29 +03:00
009df13baf
The add form has become a modal dialog, and been moved into the default template. This simplifies some things, for now. Eg it's easily accessible from any page.
261 lines
9.1 KiB
Haskell
261 lines
9.1 KiB
Haskell
-- | Common page components and rendering helpers.
|
|
-- For global page layout, see Application.hs.
|
|
|
|
module Handler.Common where
|
|
|
|
import Import
|
|
|
|
import Data.List
|
|
import Data.Text(pack)
|
|
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.Options
|
|
import Hledger.Web.Options
|
|
|
|
-------------------------------------------------------------------------------
|
|
-- Common page layout
|
|
|
|
-- | Standard hledger-web page layout.
|
|
hledgerLayout :: ViewData -> String -> HtmlUrl AppRoute -> HandlerT App IO Html
|
|
hledgerLayout vd title content = do
|
|
defaultLayout $ do
|
|
setTitle $ toHtml $ title ++ " - hledger-web"
|
|
toWidget [hamlet|
|
|
<div#content>
|
|
$if showsidebar vd
|
|
<div#sidebar>
|
|
<div#sidebar-spacer>
|
|
<div#sidebar-body>
|
|
^{sidebar vd}
|
|
$else
|
|
<div#sidebar style="display:none;">
|
|
<div#sidebar-spacer>
|
|
<div#sidebar-body>
|
|
<div#main>
|
|
^{topbar vd}
|
|
<div#maincontent>
|
|
^{searchform vd}
|
|
^{content}
|
|
|]
|
|
|
|
-- | Global toolbar/heading area.
|
|
topbar :: ViewData -> HtmlUrl AppRoute
|
|
topbar VD{..} = [hamlet|
|
|
<nav class="navbar" role="navigation">
|
|
<div#topbar>
|
|
<h1>#{title}
|
|
$maybe m' <- msg
|
|
<div#message>#{m'}
|
|
|]
|
|
where
|
|
title = takeFileName $ journalFilePath j
|
|
|
|
-- | The sidebar used on most views.
|
|
sidebar :: ViewData -> HtmlUrl AppRoute
|
|
sidebar vd@VD{..} =
|
|
[hamlet|
|
|
<a.btn .btn-default role=button href=@{JournalR} title="Go back to top">
|
|
hledger-web
|
|
<br />
|
|
\#{version}
|
|
<p>
|
|
<!--
|
|
<a#sidebartogglebtn role="button" style="cursor:pointer;" onclick="sidebarToggle()" title="Show/hide sidebar">
|
|
<span class="glyphicon glyphicon-expand"></span>
|
|
-->
|
|
<br>
|
|
<div#sidebar-content>
|
|
<p style="margin-top:1em;">
|
|
<a href=@{JournalR} .#{journalcurrent} title="Show general journal entries, most recent first" style="white-space:nowrap;">Journal
|
|
<div#accounts style="margin-top:1em;">
|
|
^{accounts}
|
|
|]
|
|
where
|
|
journalcurrent = if here == JournalR then "current" else "" :: String
|
|
accounts = balanceReportAsHtml opts vd $ balanceReport (reportopts_ $ cliopts_ opts){empty_=True} am j
|
|
|
|
-- -- | 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
|
|
-- |]
|
|
|
|
-- | Search form for entering custom queries to filter journal data.
|
|
searchform :: ViewData -> HtmlUrl AppRoute
|
|
searchform VD{..} = [hamlet|
|
|
<div#searchformdiv>
|
|
<form#searchform.form method=GET>
|
|
<table width="100%">
|
|
<tr>
|
|
<td width="99%" style="position:relative;">
|
|
$if filtering
|
|
<a role=button .btn .close style="position:absolute; right:0; padding-right:.1em; padding-left:.1em; margin-right:.1em; margin-left:.1em; font-size:24px;" href="@{here}" title="Clear search terms">×
|
|
<input .form-control style="font-size:18px; padding-bottom:2px;" name=q value=#{q} title="Enter hledger search patterns to filter the data below">
|
|
<td width="1%" style="white-space:nowrap;">
|
|
<button .btn style="font-size:18px;" type=submit title="Apply search terms">Search
|
|
<button .btn style="font-size:18px;" type=button data-toggle="modal" data-target="#helpmodal" title="Show search and general help">?
|
|
|]
|
|
where
|
|
filtering = not $ null q
|
|
|
|
-- | Edit journal form.
|
|
editform :: ViewData -> HtmlUrl AppRoute
|
|
editform VD{..} = [hamlet|
|
|
<form#editform method=POST style=display:none;>
|
|
<h2#contenttitle>#{title}>
|
|
<table.form>
|
|
$if manyfiles
|
|
<tr>
|
|
<td colspan=2>
|
|
Editing ^{journalselect $ files j}
|
|
<tr>
|
|
<td colspan=2>
|
|
<!-- XXX textarea ids are unquoted journal file paths here, not valid html -->
|
|
$forall f <- files j
|
|
<textarea id=#{fst f}_textarea name=text rows=25 cols=80 style=display:none; disabled=disabled>
|
|
\#{snd f}
|
|
<tr#addbuttonrow>
|
|
<td>
|
|
<span.help>^{formathelp}
|
|
<td align=right>
|
|
<span.help>
|
|
Are you sure ? This will overwrite the journal. #
|
|
<input type=hidden name=action value=edit>
|
|
<input type=submit name=submit value="save journal">
|
|
\ or #
|
|
<a href="#" onclick="return editformToggle(event)">cancel
|
|
|]
|
|
where
|
|
title = "Edit journal" :: String
|
|
manyfiles = length (files j) > 1
|
|
formathelp = helplink "file-format" "file format help"
|
|
|
|
-- | Import journal form.
|
|
importform :: HtmlUrl AppRoute
|
|
importform = [hamlet|
|
|
<form#importform method=POST style=display:none;>
|
|
<table.form>
|
|
<tr>
|
|
<td>
|
|
<input type=file name=file>
|
|
<input type=hidden name=action value=import>
|
|
<input type=submit name=submit value="import from file">
|
|
\ or #
|
|
<a href="#" onclick="return importformToggle(event)">cancel
|
|
|]
|
|
|
|
-- | 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 a "BalanceReport" as html.
|
|
balanceReportAsHtml :: WebOpts -> ViewData -> BalanceReport -> HtmlUrl AppRoute
|
|
balanceReportAsHtml _ vd@VD{..} (items',total) =
|
|
[hamlet|
|
|
<table.balancereport>
|
|
<tr>
|
|
<td>Account
|
|
<td align=right>Balance
|
|
$forall i <- items
|
|
^{itemAsHtml vd i}
|
|
<tr.totalrule>
|
|
<td colspan=2>
|
|
<tr>
|
|
<td>
|
|
<td.balance align=right>#{mixedAmountAsHtml total}
|
|
|]
|
|
where
|
|
l = ledgerFromJournal Any j
|
|
inacctmatcher = inAccountQuery qopts
|
|
items = items' -- maybe items' (\m -> filter (matchesAccount m . \(a,_,_,_)->a) items') showacctmatcher
|
|
itemAsHtml :: ViewData -> BalanceReportItem -> HtmlUrl AppRoute
|
|
itemAsHtml _ ((acct, adisplay, aindent), abal) = [hamlet|
|
|
<tr.item.#{inacctclass}>
|
|
<td.account.#{depthclass}>
|
|
\#{indent}
|
|
<a href="@?{acctquery}" title="Show transactions affecting this account and subaccounts">#{adisplay}
|
|
<span.hoverlinks>
|
|
$if hassubs
|
|
|
|
<a href="@?{acctonlyquery}" title="Show transactions affecting this account but not subaccounts">only
|
|
|
|
<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)) " "
|
|
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)])
|
|
|
|
-- 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},_,_,_,_,_):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 $ addclass $ intercalate "<br>" $ lines $ showMixedAmountWithoutPrice b
|
|
where addclass = printf "<span class=\"%s\">%s</span>" (c :: String)
|
|
c = case isNegativeMixedAmount b of Just True -> "negative amount"
|
|
_ -> "positive amount"
|
|
|