hledger-web 0.19 → 0.19.1
raw patch · 12 files changed
+1044/−1034 lines, 12 filesdep ~hledgerdep ~yesod
Dependency ranges changed: hledger, yesod
Files
- Application.hs +6/−3
- Handler/Common.hs +533/−0
- Handler/Handlers.hs +0/−976
- Handler/JournalEditR.hs +21/−0
- Handler/JournalEntriesR.hs +45/−0
- Handler/JournalR.hs +52/−0
- Handler/Post.hs +156/−0
- Handler/RegisterR.hs +49/−0
- Handler/RootR.hs +8/−0
- Handler/Utils.hs +122/−0
- config/routes +4/−0
- hledger-web.cabal +48/−55
Application.hs view
@@ -14,10 +14,13 @@ -- Import all relevant handler modules here. -- Don't forget to add new modules to your cabal file!--- import Handler.Home-import Handler.Handlers+import Handler.RootR+import Handler.JournalR+import Handler.JournalEditR+import Handler.JournalEntriesR+import Handler.RegisterR -import Hledger.Web.Options+import Hledger.Web.Options (defwebopts) -- This line actually creates our YesodDispatch instance. It is the second half -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
+ Handler/Common.hs view
@@ -0,0 +1,533 @@+-- | Common page components and rendering helpers.++module Handler.Common where++import Import++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 Hledger.Utils+import Hledger.Data+import Hledger.Query+import Hledger.Reports+import Hledger.Cli.Options+import Hledger.Web.Options++import Handler.Utils++-------------------------------------------------------------------------------+-- Page components++-- | Global toolbar/heading area.+topbar :: ViewData -> HtmlUrl AppRoute+topbar VD{..} = [hamlet|+<div#topbar>+ <a.topleftlink href=#{hledgerorgurl} title="More about hledger">+ hledger-web+ <br />+ #{version}+ <a.toprightlink href=#{manualurl} target=hledgerhelp title="User manual">manual+ <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{..} = accountsReportAsHtml opts vd $ accountsReport (reportopts_ $ cliopts_ opts) 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>+ <tr>+ <td>+ Search:+ \ #+ <td>+ <input name=q size=70 value=#{q}>+ <input type=submit value="Search">+ $if filtering+ \ #+ <span.showall>+ <a href=@{here}>clear search+ \ #+ <a#search-help-link href="#" title="Toggle search help">help+ <tr>+ <td>+ <td>+ <div#search-help.help style="display:none;">+ Leave blank to see journal (all transactions), or click account links to see transactions under that account.+ <br>+ Transactions/postings may additionally be filtered by:+ <br>+ acct:REGEXP (target account), #+ desc:REGEXP (description), #+ date:PERIODEXP (date), #+ edate:PERIODEXP (effective date), #+ <br>+ status:BOOL (cleared status), #+ real:BOOL (real/virtual-ness), #+ empty:BOOL (posting amount = 0).+ <br>+ not: to negate, enclose space-containing patterns in quotes, multiple filters are AND'ed.+|]+ where+ filtering = not $ null q++-- | Add transaction form.+addform :: ViewData -> HtmlUrl AppRoute+addform vd@VD{..} = [hamlet|+<script type=text/javascript>+ \$(document).ready(function() {+ /* dhtmlxcombo setup */+ window.dhx_globalImgPath="../static/";+ var desccombo = new dhtmlXCombo("description");+ var acct1combo = new dhtmlXCombo("account1");+ var acct2combo = new dhtmlXCombo("account2");+ desccombo.enableFilteringMode(true);+ acct1combo.enableFilteringMode(true);+ acct2combo.enableFilteringMode(true);+ desccombo.setSize(300);+ acct1combo.setSize(300);+ acct2combo.setSize(300);+ /* desccombo.enableOptionAutoHeight(true, 20); */+ /* desccombo.setOptionHeight(200); */+ });++<form#addform method=POST style=display:none;>+ <h2#contenttitle>#{title}+ <table.form>+ <tr>+ <td colspan=4>+ <table>+ <tr#descriptionrow>+ <td>+ Date:+ <td>+ <input.textinput size=15 name=date value=#{date}>+ <td style=padding-left:1em;>+ Description:+ <td>+ <select id=description name=description>+ <option>+ $forall d <- descriptions+ <option value=#{d}>#{d}+ <tr.helprow>+ <td>+ <td>+ <span.help>#{datehelp} #+ <td>+ <td>+ <span.help>#{deschelp}+ ^{postingfields vd 1}+ ^{postingfields vd 2}+ <tr#addbuttonrow>+ <td colspan=4>+ <input type=hidden name=action value=add>+ <input type=submit name=submit value="add transaction">+ $if manyfiles+ \ to: ^{journalselect $ files j}+ \ or #+ <a href="#" onclick="return addformToggle(event)">cancel+|]+ where+ title = "Add transaction" :: String+ datehelp = "eg: 2010/7/20" :: String+ deschelp = "eg: supermarket (optional)" :: String+ date = "today" :: String+ descriptions = sort $ nub $ map tdescription $ jtxns j+ manyfiles = (length $ files j) > 1+ postingfields :: ViewData -> Int -> HtmlUrl AppRoute+ postingfields _ n = [hamlet|+<tr#postingrow>+ <td align=right>#{acctlabel}:+ <td>+ <select id=#{acctvar} name=#{acctvar}>+ <option>+ $forall a <- acctnames+ <option value=#{a} :shouldselect a:selected>#{a}+ ^{amtfield}+<tr.helprow>+ <td>+ <td>+ <span.help>#{accthelp}+ <td>+ <td>+ <span.help>#{amthelp}+|]+ where+ shouldselect a = n == 2 && maybe False ((a==).fst) (inAccount qopts)+ withnumber = (++ show n)+ acctvar = withnumber "account"+ amtvar = withnumber "amount"+ acctnames = sort $ journalAccountNamesUsed j+ (acctlabel, accthelp, amtfield, amthelp)+ | n == 1 = ("To account"+ ,"eg: expenses:food"+ ,[hamlet|+<td style=padding-left:1em;>+ Amount:+<td>+ <input.textinput size=15 name=#{amtvar} value="">+|]+ ,"eg: $6"+ )+ | otherwise = ("From account" :: String+ ,"eg: assets:bank:checking" :: String+ ,nulltemplate+ ,"" :: String+ )++-- | 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+|]++journalselect :: [(FilePath,String)] -> HtmlUrl AppRoute+journalselect journalfiles = [hamlet|+<select id=journalselect name=journal onchange="editformJournalSelect(event)">+ $forall f <- journalfiles+ <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>+ + <a href=@{JournalEntriesR} title="Show journal entries">entries+ + <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+ + <a href="@?{acctonlyquery}" title="Show transactions in this account only">only+ <!--+ + <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)) " "+ 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> <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}+ + <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> <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},_,_,_,_,_):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 $ showMixedAmount b+ where addclass = printf "<span class=\"%s\">%s</span>" (c :: String)+ c = case isNegativeMixedAmount b of Just True -> "negative amount"+ _ -> "positive amount"+
− Handler/Handlers.hs
@@ -1,976 +0,0 @@-{-# LANGUAGE RecordWildCards #-}-{---hledger-web's request handlers, and helpers.---}--module Handler.Handlers-(- -- * GET handlers- getRootR,- getJournalR,- getJournalEntriesR,- getJournalEditR,- getRegisterR,- -- ** helpers- -- sidebar,- -- accountsReportAsHtml,- -- accountQuery,- -- accountOnlyQuery,- -- accountUrl,- -- entriesReportAsHtml,- -- journalTransactionsReportAsHtml,- -- registerReportHtml,- -- registerItemsHtml,- -- registerChartHtml,- -- stringIfLongerThan,- -- numberTransactionsReportItems,- -- mixedAmountAsHtml,- -- * POST handlers- postJournalR,- postJournalEntriesR,- postJournalEditR,- postRegisterR,- -- * Common page components- -- * Utilities- ViewData(..),- nullviewdata,-)-where--import Prelude-import Control.Applicative ((<$>))-import Control.Monad.IO.Class (liftIO)-import Data.Either (lefts,rights)-import Data.List-import Data.Maybe-import Data.Text(Text,pack,unpack)-import qualified Data.Text (null)-import Data.Time.Calendar-import Data.Time.Clock-import Data.Time.Format-import System.FilePath (takeFileName)-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)-#endif-import Text.Hamlet -- hiding (hamlet)-import Text.Printf-import Yesod.Core--- import Yesod.Json--import Foundation-import Settings--import Hledger hiding (is)-import Hledger.Cli hiding (version)-import Hledger.Web.Options---- routes:--- /static StaticR Static getStatic--- -- /favicon.ico FaviconR GET--- /robots.txt RobotsR GET--- / RootR GET--- /journal JournalR GET POST--- /journal/entries JournalEntriesR GET POST--- /journal/edit JournalEditR GET POST--- /register RegisterR GET POST--- -- /accounts AccountsR GET--- -- /api/accounts AccountsJsonR GET--------------------------------------------------------------------------- GET handlers--getRootR :: Handler RepHtml-getRootR = redirect defaultroute where defaultroute = RegisterR---- | The formatted journal view, with sidebar.-getJournalR :: Handler RepHtml-getJournalR = do- vd@VD{..} <- getViewData- let sidecontent = sidebar vd- -- XXX like registerReportAsHtml- inacct = inAccount qopts- -- injournal = isNothing inacct- filtering = m /= Any- -- showlastcolumn = if injournal && not filtering then False else True- title = case inacct of- Nothing -> "Journal"++s2- Just (a,inclsubs) -> "Transactions in "++a++s1++s2- where s1 = if inclsubs then " (and subaccounts)" else ""- where- s2 = if filtering then ", filtered" else ""- maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m- defaultLayout $ do- setTitle "hledger-web journal"- toWidget [hamlet|-^{topbar vd}-<div#content>- <div#sidebar>- ^{sidecontent}- <div#main.register>- <div#maincontent>- <h2#contenttitle>#{title}- ^{searchform vd}- ^{maincontent}- ^{addform vd}- ^{editform vd}- ^{importform}-|]---- | The journal entries view, with sidebar.-getJournalEntriesR :: Handler RepHtml-getJournalEntriesR = do- vd@VD{..} <- getViewData- let- sidecontent = sidebar vd- title = "Journal entries" ++ if m /= Any then ", filtered" else "" :: String- maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) Any $ filterJournalTransactions m j- defaultLayout $ do- setTitle "hledger-web journal"- toWidget [hamlet|-^{topbar vd}-<div#content>- <div#sidebar>- ^{sidecontent}- <div#main.journal>- <div#maincontent>- <h2#contenttitle>#{title}- ^{searchform vd}- ^{maincontent}- ^{addform vd}- ^{editform vd}- ^{importform}-|]---- | The journal editform, no sidebar.-getJournalEditR :: Handler RepHtml-getJournalEditR = do- vd <- getViewData- defaultLayout $ do- setTitle "hledger-web journal edit form"- toWidget $ editform vd---- -- | The journal entries view, no sidebar.--- getJournalOnlyR :: Handler RepHtml--- getJournalOnlyR = do--- vd@VD{..} <- getViewData--- defaultLayout $ do--- setTitle "hledger-web journal only"--- toWidget $ entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) nullfilterspec $ filterJournalTransactions2 m j---- | The main journal/account register view, with accounts sidebar.-getRegisterR :: Handler RepHtml-getRegisterR = do- vd@VD{..} <- getViewData- let sidecontent = sidebar vd- -- injournal = isNothing inacct- filtering = m /= Any- title = "Transactions in "++a++s1++s2- where- (a,inclsubs) = fromMaybe ("all accounts",False) $ inAccount qopts- s1 = if inclsubs then " (and subaccounts)" else ""- s2 = if filtering then ", filtered" else ""- maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts- defaultLayout $ do- setTitle "hledger-web register"- toWidget [hamlet|-^{topbar vd}-<div#content>- <div#sidebar>- ^{sidecontent}- <div#main.register>- <div#maincontent>- <h2#contenttitle>#{title}- ^{searchform vd}- ^{maincontent}- ^{addform vd}- ^{editform vd}- ^{importform}-|]---- -- | The register view, no sidebar.--- getRegisterOnlyR :: Handler RepHtml--- getRegisterOnlyR = do--- vd@VD{..} <- getViewData--- defaultLayout $ do--- setTitle "hledger-web register only"--- toWidget $--- case inAccountQuery qopts of Just m' -> registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m m'--- Nothing -> registerReportHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m--{---- | A simple accounts view. This one is json-capable, returning the chart--- of accounts as json if the Accept header specifies json.-getAccountsR :: Handler RepHtmlJson-getAccountsR = do- vd@VD{..} <- getViewData- let j' = filterJournalPostings2 m j- html = do- setTitle "hledger-web accounts"- toWidget $ accountsReportAsHtml opts vd $ accountsReport2 (reportopts_ $ cliopts_ opts) am j'- json = jsonMap [("accounts", toJSON $ journalAccountNames j')]- defaultLayoutJson html json---- | A json-only version of "getAccountsR", does not require the special Accept header.-getAccountsJsonR :: Handler RepJson-getAccountsJsonR = do- VD{..} <- getViewData- let j' = filterJournalPostings2 m j- jsonToRepJson $ jsonMap [("accounts", toJSON $ journalAccountNames j')]--}---- helpers---- | Render the sidebar used on most views.-sidebar :: ViewData -> HtmlUrl AppRoute-sidebar vd@VD{..} = accountsReportAsHtml opts vd $ accountsReport (reportopts_ $ cliopts_ opts) am j---- | 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>- - <a href=@{JournalEntriesR} title="Show journal entries">entries- - <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- - <a href="@?{acctonlyquery}" title="Show transactions in this account only">only- <!--- - <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)) " "- 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> <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}- - <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> <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"------------------------------------------------------------------------------------ POST handlers--postJournalR :: Handler RepHtml-postJournalR = handlePost--postJournalEntriesR :: Handler RepHtml-postJournalEntriesR = handlePost--postJournalEditR :: Handler RepHtml-postJournalEditR = handlePost--postRegisterR :: Handler RepHtml-postRegisterR = handlePost---- | Handle a post from any of the edit forms.-handlePost :: Handler RepHtml-handlePost = do- action <- lookupPostParam "action"- case action of Just "add" -> handleAdd- Just "edit" -> handleEdit- Just "import" -> handleImport- _ -> invalidArgs [pack "invalid action"]---- | Handle a post from the transaction add form.-handleAdd :: Handler RepHtml-handleAdd = do- VD{..} <- getViewData- -- get form input values. M means a Maybe value.- dateM <- lookupPostParam "date"- descM <- lookupPostParam "description"- acct1M <- lookupPostParam "account1"- amt1M <- lookupPostParam "amount1"- acct2M <- lookupPostParam "account2"- amt2M <- lookupPostParam "amount2"- journalM <- lookupPostParam "journal"- -- supply defaults and parse date and amounts, or get errors.- let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . unpack) dateM- descE = Right $ maybe "" unpack descM- maybeNonNull = maybe Nothing (\t -> if Data.Text.null t then Nothing else Just t)- acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M- acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M- amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amount . unpack) amt1M- amt2E = maybe (Right missingmixedamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amount . unpack) amt2M- journalE = maybe (Right $ journalFilePath j)- (\f -> let f' = unpack f in- if f' `elem` journalFilePaths j- then Right f'- else Left $ "unrecognised journal file path: " ++ f'- )- journalM- strEs = [dateE, descE, acct1E, acct2E, journalE]- amtEs = [amt1E, amt2E]- errs = lefts strEs ++ lefts amtEs- [date,desc,acct1,acct2,journalpath] = rights strEs- [amt1,amt2] = rights amtEs- -- if no errors so far, generate a transaction and balance it or get the error.- tE | not $ null errs = Left errs- | otherwise = either (\e -> Left ["unbalanced postings: " ++ (head $ lines e)]) Right- (balanceTransaction Nothing $ nulltransaction { -- imprecise balancing- tdate=parsedate date- ,tdescription=desc- ,tpostings=[- Posting False acct1 amt1 "" RegularPosting [] Nothing- ,Posting False acct2 amt2 "" RegularPosting [] Nothing- ]- })- -- display errors or add transaction- case tE of- Left errs' -> do- -- save current form values in session- -- setMessage $ toHtml $ intercalate "; " errs- setMessage [shamlet|- Errors:<br>- $forall e<-errs'- #{e}<br>- |]- Right t -> do- let t' = txnTieKnot t -- XXX move into balanceTransaction- liftIO $ do ensureJournalFileExists journalpath- appendToJournalFileOrStdout journalpath $ showTransaction t'- -- setMessage $ toHtml $ (printf "Added transaction:\n%s" (show t') :: String)- setMessage [shamlet|<span>Added transaction:<small><pre>#{chomp $ show t'}</pre></small>|]-- redirect (RegisterR, [("add","1")])--chomp :: String -> String-chomp = reverse . dropWhile (`elem` "\r\n") . reverse---- | Handle a post from the journal edit form.-handleEdit :: Handler RepHtml-handleEdit = do- VD{..} <- getViewData- -- get form input values, or validation errors.- -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace- textM <- lookupPostParam "text"- journalM <- lookupPostParam "journal"- let textE = maybe (Left "No value provided") (Right . unpack) textM- journalE = maybe (Right $ journalFilePath j)- (\f -> let f' = unpack f in- if f' `elem` journalFilePaths j- then Right f'- else Left "unrecognised journal file path")- journalM- strEs = [textE, journalE]- errs = lefts strEs- [text,journalpath] = rights strEs- -- display errors or perform edit- if not $ null errs- then do- setMessage $ toHtml (intercalate "; " errs :: String)- redirect JournalR-- else do- -- try to avoid unnecessary backups or saving invalid data- filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath- told <- liftIO $ readFileStrictly journalpath- let tnew = filter (/= '\r') text- changed = tnew /= told || filechanged'- if not changed- then do- setMessage "No change"- redirect JournalR- else do- jE <- liftIO $ readJournal Nothing Nothing (Just journalpath) tnew- either- (\e -> do- setMessage $ toHtml e- redirect JournalR)- (const $ do- liftIO $ writeFileWithBackup journalpath tnew- setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String)- redirect JournalR)- jE---- | Handle a post from the journal import form.-handleImport :: Handler RepHtml-handleImport = do- setMessage "can't handle file upload yet"- redirect JournalR- -- -- get form input values, or basic validation errors. E means an Either value.- -- fileM <- runFormPost $ maybeFileInput "file"- -- let fileE = maybe (Left "No file provided") Right fileM- -- -- display errors or import transactions- -- case fileE of- -- Left errs -> do- -- setMessage errs- -- redirect JournalR-- -- Right s -> do- -- setMessage s- -- redirect JournalR--------------------------------------------------------------------------- Common page components.---- | Global toolbar/heading area.-topbar :: ViewData -> HtmlUrl AppRoute-topbar VD{..} = [hamlet|-<div#topbar>- <a.topleftlink href=#{hledgerorgurl} title="More about hledger">- hledger-web- <br />- #{version}- <a.toprightlink href=#{manualurl} target=hledgerhelp title="User manual">manual- <h1>#{title}-$maybe m' <- msg- <div#message>#{m'}-|]- where- title = takeFileName $ journalFilePath 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--- |]---- | 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---- | 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>- <tr>- <td>- Search:- \ #- <td>- <input name=q size=70 value=#{q}>- <input type=submit value="Search">- $if filtering- \ #- <span.showall>- <a href=@{here}>clear search- \ #- <a#search-help-link href="#" title="Toggle search help">help- <tr>- <td>- <td>- <div#search-help.help style="display:none;">- Leave blank to see journal (all transactions), or click account links to see transactions under that account.- <br>- Transactions/postings may additionally be filtered by:- <br>- acct:REGEXP (target account), #- desc:REGEXP (description), #- date:PERIODEXP (date), #- edate:PERIODEXP (effective date), #- <br>- status:BOOL (cleared status), #- real:BOOL (real/virtual-ness), #- empty:BOOL (posting amount = 0).- <br>- not: to negate, enclose space-containing patterns in quotes, multiple filters are AND'ed.-|]- where- filtering = not $ null q---- | Add transaction form.-addform :: ViewData -> HtmlUrl AppRoute-addform vd@VD{..} = [hamlet|-<script type=text/javascript>- \$(document).ready(function() {- /* dhtmlxcombo setup */- window.dhx_globalImgPath="../static/";- var desccombo = new dhtmlXCombo("description");- var acct1combo = new dhtmlXCombo("account1");- var acct2combo = new dhtmlXCombo("account2");- desccombo.enableFilteringMode(true);- acct1combo.enableFilteringMode(true);- acct2combo.enableFilteringMode(true);- desccombo.setSize(300);- acct1combo.setSize(300);- acct2combo.setSize(300);- /* desccombo.enableOptionAutoHeight(true, 20); */- /* desccombo.setOptionHeight(200); */- });--<form#addform method=POST style=display:none;>- <h2#contenttitle>#{title}- <table.form>- <tr>- <td colspan=4>- <table>- <tr#descriptionrow>- <td>- Date:- <td>- <input.textinput size=15 name=date value=#{date}>- <td style=padding-left:1em;>- Description:- <td>- <select id=description name=description>- <option>- $forall d <- descriptions- <option value=#{d}>#{d}- <tr.helprow>- <td>- <td>- <span.help>#{datehelp} #- <td>- <td>- <span.help>#{deschelp}- ^{postingfields vd 1}- ^{postingfields vd 2}- <tr#addbuttonrow>- <td colspan=4>- <input type=hidden name=action value=add>- <input type=submit name=submit value="add transaction">- $if manyfiles- \ to: ^{journalselect $ files j}- \ or #- <a href="#" onclick="return addformToggle(event)">cancel-|]- where- title = "Add transaction" :: String- datehelp = "eg: 2010/7/20" :: String- deschelp = "eg: supermarket (optional)" :: String- date = "today" :: String- descriptions = sort $ nub $ map tdescription $ jtxns j- manyfiles = (length $ files j) > 1- postingfields :: ViewData -> Int -> HtmlUrl AppRoute- postingfields _ n = [hamlet|-<tr#postingrow>- <td align=right>#{acctlabel}:- <td>- <select id=#{acctvar} name=#{acctvar}>- <option>- $forall a <- acctnames- <option value=#{a} :shouldselect a:selected>#{a}- ^{amtfield}-<tr.helprow>- <td>- <td>- <span.help>#{accthelp}- <td>- <td>- <span.help>#{amthelp}-|]- where- shouldselect a = n == 2 && maybe False ((a==).fst) (inAccount qopts)- withnumber = (++ show n)- acctvar = withnumber "account"- amtvar = withnumber "amount"- acctnames = sort $ journalAccountNamesUsed j- (acctlabel, accthelp, amtfield, amthelp)- | n == 1 = ("To account"- ,"eg: expenses:food"- ,[hamlet|-<td style=padding-left:1em;>- Amount:-<td>- <input.textinput size=15 name=#{amtvar} value="">-|]- ,"eg: $6"- )- | otherwise = ("From account" :: String- ,"eg: assets:bank:checking" :: String- ,nulltemplate- ,"" :: String- )---- | 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-|]--journalselect :: [(FilePath,String)] -> HtmlUrl AppRoute-journalselect journalfiles = [hamlet|-<select id=journalselect name=journal onchange="editformJournalSelect(event)">- $forall f <- journalfiles- <option value=#{fst f}>#{fst f}-|]--nulltemplate :: HtmlUrl AppRoute-nulltemplate = [hamlet||]--------------------------------------------------------------------------- Utilities---- | A bundle of data useful for hledger-web request handlers and templates.-data ViewData = VD {- opts :: WebOpts -- ^ the command-line options at startup- ,here :: AppRoute -- ^ the current route- ,msg :: Maybe Html -- ^ the current UI message if any, possibly from the current request- ,today :: Day -- ^ today's date (for queries containing relative dates)- ,j :: Journal -- ^ the up-to-date parsed unfiltered journal- ,q :: String -- ^ the current q parameter, the main query expression- ,m :: Query -- ^ a query parsed from the q parameter- ,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter- ,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)- ,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr- ,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable- }---- | Make a default ViewData, using day 0 as today's date.-nullviewdata :: ViewData-nullviewdata = viewdataWithDateAndParams nulldate "" "" ""---- | Make a ViewData using the given date and request parameters, and defaults elsewhere.-viewdataWithDateAndParams :: Day -> String -> String -> String -> ViewData-viewdataWithDateAndParams d q a p =- let (querymatcher,queryopts) = parseQuery d q- (acctsmatcher,acctsopts) = parseQuery d a- in VD {- opts = defwebopts- ,j = nulljournal- ,here = RootR- ,msg = Nothing- ,today = d- ,q = q- ,m = querymatcher- ,qopts = queryopts- ,am = acctsmatcher- ,aopts = acctsopts- ,showpostings = p == "1"- }---- | Gather data used by handlers and templates in the current request.-getViewData :: Handler ViewData-getViewData = do- app <- getYesod- let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app- (j, err) <- getCurrentJournal $ copts{reportopts_=ropts{no_elide_=True}}- msg <- getMessageOr err- Just here <- getCurrentRoute- today <- liftIO getCurrentDay- q <- getParameterOrNull "q"- a <- getParameterOrNull "a"- p <- getParameterOrNull "p"- return (viewdataWithDateAndParams today q a p){- opts=opts- ,msg=msg- ,here=here- ,today=today- ,j=j- }- where- -- | Update our copy of the journal if the file changed. If there is an- -- error while reloading, keep the old one and return the error, and set a- -- ui message.- getCurrentJournal :: CliOpts -> Handler (Journal, Maybe String)- getCurrentJournal opts = do- j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"- (jE, changed) <- liftIO $ journalReloadIfChanged opts j- if not changed- then return (j,Nothing)- else case jE of- Right j' -> do liftIO $ putValue "hledger" "journal" j'- return (j',Nothing)- Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}- return (j, Just e)-- -- | Get the named request parameter, or the empty string if not present.- getParameterOrNull :: String -> Handler String- getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p)---- | Get the message set by the last request, or the newer message provided, if any.-getMessageOr :: Maybe String -> Handler (Maybe Html)-getMessageOr mnewmsg = do- oldmsg <- getMessage- return $ maybe oldmsg (Just . toHtml) mnewmsg--numbered :: [a] -> [(Int,a)]-numbered = zip [1..]--dayToJsTimestamp :: Day -> Integer-dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000- where t = UTCTime d (secondsToDiffTime 0)
+ Handler/JournalEditR.hs view
@@ -0,0 +1,21 @@+-- | /journal/edit handlers.++module Handler.JournalEditR where++import Import++import Handler.Common+import Handler.Post+import Handler.Utils+++-- | The journal editform, no sidebar.+getJournalEditR :: Handler RepHtml+getJournalEditR = do+ vd <- getViewData+ defaultLayout $ do+ setTitle "hledger-web journal edit form"+ toWidget $ editform vd++postJournalEditR :: Handler RepHtml+postJournalEditR = handlePost
+ Handler/JournalEntriesR.hs view
@@ -0,0 +1,45 @@+-- | /journal/entries handlers.++module Handler.JournalEntriesR where++import Import++import Handler.Common+import Handler.Post+import Handler.Utils++import Hledger.Data+import Hledger.Query+import Hledger.Reports+import Hledger.Cli.Options+import Hledger.Web.Options+++-- | The journal entries view, with sidebar.+getJournalEntriesR :: Handler RepHtml+getJournalEntriesR = do+ vd@VD{..} <- getViewData+ let+ sidecontent = sidebar vd+ title = "Journal entries" ++ if m /= Any then ", filtered" else "" :: String+ maincontent = entriesReportAsHtml opts vd $ entriesReport (reportopts_ $ cliopts_ opts) Any $ filterJournalTransactions m j+ defaultLayout $ do+ setTitle "hledger-web journal"+ toWidget [hamlet|+^{topbar vd}+<div#content>+ <div#sidebar>+ ^{sidecontent}+ <div#main.journal>+ <div#maincontent>+ <h2#contenttitle>#{title}+ ^{searchform vd}+ ^{maincontent}+ ^{addform vd}+ ^{editform vd}+ ^{importform}+|]++postJournalEntriesR :: Handler RepHtml+postJournalEntriesR = handlePost+
+ Handler/JournalR.hs view
@@ -0,0 +1,52 @@+-- | /journal handlers.++module Handler.JournalR where++import Import++import Handler.Common+import Handler.Post+import Handler.Utils++import Hledger.Query+import Hledger.Reports+import Hledger.Cli.Options+import Hledger.Web.Options++-- | The formatted journal view, with sidebar.+getJournalR :: Handler RepHtml+getJournalR = do+ vd@VD{..} <- getViewData+ let sidecontent = sidebar vd+ -- XXX like registerReportAsHtml+ inacct = inAccount qopts+ -- injournal = isNothing inacct+ filtering = m /= Any+ -- showlastcolumn = if injournal && not filtering then False else True+ title = case inacct of+ Nothing -> "Journal"++s2+ Just (a,inclsubs) -> "Transactions in "++a++s1++s2+ where s1 = if inclsubs then " (and subaccounts)" else ""+ where+ s2 = if filtering then ", filtered" else ""+ maincontent = journalTransactionsReportAsHtml opts vd $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m+ defaultLayout $ do+ setTitle "hledger-web journal"+ toWidget [hamlet|+^{topbar vd}+<div#content>+ <div#sidebar>+ ^{sidecontent}+ <div#main.register>+ <div#maincontent>+ <h2#contenttitle>#{title}+ ^{searchform vd}+ ^{maincontent}+ ^{addform vd}+ ^{editform vd}+ ^{importform}+|]++postJournalR :: Handler RepHtml+postJournalR = handlePost+
+ Handler/Post.hs view
@@ -0,0 +1,156 @@+-- | POST helpers.++module Handler.Post where++import Import++import Data.Either (lefts,rights)+import Data.List (intercalate)+import qualified Data.List as L (head) -- qualified keeps dev & prod builds warning-free+import Data.Text (unpack)+import qualified Data.Text as T (null)+import Text.Hamlet (shamlet)+import Text.Printf (printf)++import Handler.Utils+import Hledger.Utils+import Hledger.Data+import Hledger.Read+import Hledger.Cli+++-- | Handle a post from any of the edit forms.+handlePost :: Handler RepHtml+handlePost = do+ action <- lookupPostParam "action"+ case action of Just "add" -> handleAdd+ Just "edit" -> handleEdit+ Just "import" -> handleImport+ _ -> invalidArgs ["invalid action"]++-- | Handle a post from the transaction add form.+handleAdd :: Handler RepHtml+handleAdd = do+ VD{..} <- getViewData+ -- get form input values. M means a Maybe value.+ dateM <- lookupPostParam "date"+ descM <- lookupPostParam "description"+ acct1M <- lookupPostParam "account1"+ amt1M <- lookupPostParam "amount1"+ acct2M <- lookupPostParam "account2"+ amt2M <- lookupPostParam "amount2"+ journalM <- lookupPostParam "journal"+ -- supply defaults and parse date and amounts, or get errors.+ let dateE = maybe (Left "date required") (either (\e -> Left $ showDateParseError e) Right . fixSmartDateStrEither today . unpack) dateM+ descE = Right $ maybe "" unpack descM+ maybeNonNull = maybe Nothing (\t -> if T.null t then Nothing else Just t)+ acct1E = maybe (Left "to account required") (Right . unpack) $ maybeNonNull acct1M+ acct2E = maybe (Left "from account required") (Right . unpack) $ maybeNonNull acct2M+ amt1E = maybe (Left "amount required") (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt1M+ amt2E = maybe (Right missingamt) (either (const $ Left "could not parse amount") Right . parseWithCtx nullctx amountp . unpack) amt2M+ journalE = maybe (Right $ journalFilePath j)+ (\f -> let f' = unpack f in+ if f' `elem` journalFilePaths j+ then Right f'+ else Left $ "unrecognised journal file path: " ++ f'+ )+ journalM+ strEs = [dateE, descE, acct1E, acct2E, journalE]+ amtEs = [amt1E, amt2E]+ errs = lefts strEs ++ lefts amtEs+ [date,desc,acct1,acct2,journalpath] = rights strEs+ [amt1,amt2] = rights amtEs+ -- if no errors so far, generate a transaction and balance it or get the error.+ tE | not $ null errs = Left errs+ | otherwise = either (\e -> Left ["unbalanced postings: " ++ (L.head $ lines e)]) Right+ (balanceTransaction Nothing $ nulltransaction { -- imprecise balancing+ tdate=parsedate date+ ,tdescription=desc+ ,tpostings=[+ Posting False acct1 (mixed amt1) "" RegularPosting [] Nothing+ ,Posting False acct2 (mixed amt2) "" RegularPosting [] Nothing+ ]+ })+ -- display errors or add transaction+ case tE of+ Left errs' -> do+ -- save current form values in session+ -- setMessage $ toHtml $ intercalate "; " errs+ setMessage [shamlet|+ Errors:<br>+ $forall e<-errs'+ #{e}<br>+ |]+ Right t -> do+ let t' = txnTieKnot t -- XXX move into balanceTransaction+ liftIO $ do ensureJournalFileExists journalpath+ appendToJournalFileOrStdout journalpath $ showTransaction t'+ -- setMessage $ toHtml $ (printf "Added transaction:\n%s" (show t') :: String)+ setMessage [shamlet|<span>Added transaction:<small><pre>#{chomp $ show t'}</pre></small>|]++ redirect (RegisterR, [("add","1")])++-- | Handle a post from the journal edit form.+handleEdit :: Handler RepHtml+handleEdit = do+ VD{..} <- getViewData+ -- get form input values, or validation errors.+ -- getRequest >>= liftIO (reqRequestBody req) >>= mtrace+ textM <- lookupPostParam "text"+ journalM <- lookupPostParam "journal"+ let textE = maybe (Left "No value provided") (Right . unpack) textM+ journalE = maybe (Right $ journalFilePath j)+ (\f -> let f' = unpack f in+ if f' `elem` journalFilePaths j+ then Right f'+ else Left "unrecognised journal file path")+ journalM+ strEs = [textE, journalE]+ errs = lefts strEs+ [text,journalpath] = rights strEs+ -- display errors or perform edit+ if not $ null errs+ then do+ setMessage $ toHtml (intercalate "; " errs :: String)+ redirect JournalR++ else do+ -- try to avoid unnecessary backups or saving invalid data+ filechanged' <- liftIO $ journalSpecifiedFileIsNewer j journalpath+ told <- liftIO $ readFileStrictly journalpath+ let tnew = filter (/= '\r') text+ changed = tnew /= told || filechanged'+ if not changed+ then do+ setMessage "No change"+ redirect JournalR+ else do+ jE <- liftIO $ readJournal Nothing Nothing (Just journalpath) tnew+ either+ (\e -> do+ setMessage $ toHtml e+ redirect JournalR)+ (const $ do+ liftIO $ writeFileWithBackup journalpath tnew+ setMessage $ toHtml (printf "Saved journal %s\n" (show journalpath) :: String)+ redirect JournalR)+ jE++-- | Handle a post from the journal import form.+handleImport :: Handler RepHtml+handleImport = do+ setMessage "can't handle file upload yet"+ redirect JournalR+ -- -- get form input values, or basic validation errors. E means an Either value.+ -- fileM <- runFormPost $ maybeFileInput "file"+ -- let fileE = maybe (Left "No file provided") Right fileM+ -- -- display errors or import transactions+ -- case fileE of+ -- Left errs -> do+ -- setMessage errs+ -- redirect JournalR++ -- Right s -> do+ -- setMessage s+ -- redirect JournalR+
+ Handler/RegisterR.hs view
@@ -0,0 +1,49 @@+-- | /register handlers.++module Handler.RegisterR where++import Import++import Data.Maybe++import Handler.Common+import Handler.Post+import Handler.Utils++import Hledger.Query+import Hledger.Reports+import Hledger.Cli.Options+import Hledger.Web.Options++-- | The main journal/account register view, with accounts sidebar.+getRegisterR :: Handler RepHtml+getRegisterR = do+ vd@VD{..} <- getViewData+ let sidecontent = sidebar vd+ -- injournal = isNothing inacct+ filtering = m /= Any+ title = "Transactions in "++a++s1++s2+ where+ (a,inclsubs) = fromMaybe ("all accounts",False) $ inAccount qopts+ s1 = if inclsubs then " (and subaccounts)" else ""+ s2 = if filtering then ", filtered" else ""+ maincontent = registerReportHtml opts vd $ accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts+ defaultLayout $ do+ setTitle "hledger-web register"+ toWidget [hamlet|+^{topbar vd}+<div#content>+ <div#sidebar>+ ^{sidecontent}+ <div#main.register>+ <div#maincontent>+ <h2#contenttitle>#{title}+ ^{searchform vd}+ ^{maincontent}+ ^{addform vd}+ ^{editform vd}+ ^{importform}+|]++postRegisterR :: Handler RepHtml+postRegisterR = handlePost
+ Handler/RootR.hs view
@@ -0,0 +1,8 @@+-- | Site root and misc. handlers.++module Handler.RootR where++import Import++getRootR :: Handler RepHtml+getRootR = redirect defaultroute where defaultroute = RegisterR
+ Handler/Utils.hs view
@@ -0,0 +1,122 @@+-- | Web handler utilities.++module Handler.Utils where++import Prelude+import Control.Applicative ((<$>))+import Control.Monad.IO.Class (liftIO)+import Data.Maybe+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.Html (toHtml)+#else+import Text.Blaze (toHtml)+#endif+import Text.Hamlet+import Yesod.Core++import Foundation++import Hledger hiding (is)+import Hledger.Cli hiding (version)+import Hledger.Web.Options+++-- | A bundle of data useful for hledger-web request handlers and templates.+data ViewData = VD {+ opts :: WebOpts -- ^ the command-line options at startup+ ,here :: AppRoute -- ^ the current route+ ,msg :: Maybe Html -- ^ the current UI message if any, possibly from the current request+ ,today :: Day -- ^ today's date (for queries containing relative dates)+ ,j :: Journal -- ^ the up-to-date parsed unfiltered journal+ ,q :: String -- ^ the current q parameter, the main query expression+ ,m :: Query -- ^ a query parsed from the q parameter+ ,qopts :: [QueryOpt] -- ^ query options parsed from the q parameter+ ,am :: Query -- ^ a query parsed from the accounts sidebar query expr ("a" parameter)+ ,aopts :: [QueryOpt] -- ^ query options parsed from the accounts sidebar query expr+ ,showpostings :: Bool -- ^ current p parameter, 1 or 0 shows/hides all postings where applicable+ }++-- | Make a default ViewData, using day 0 as today's date.+nullviewdata :: ViewData+nullviewdata = viewdataWithDateAndParams nulldate "" "" ""++-- | Make a ViewData using the given date and request parameters, and defaults elsewhere.+viewdataWithDateAndParams :: Day -> String -> String -> String -> ViewData+viewdataWithDateAndParams d q a p =+ let (querymatcher,queryopts) = parseQuery d q+ (acctsmatcher,acctsopts) = parseQuery d a+ in VD {+ opts = defwebopts+ ,j = nulljournal+ ,here = RootR+ ,msg = Nothing+ ,today = d+ ,q = q+ ,m = querymatcher+ ,qopts = queryopts+ ,am = acctsmatcher+ ,aopts = acctsopts+ ,showpostings = p == "1"+ }++-- | Gather data used by handlers and templates in the current request.+getViewData :: Handler ViewData+getViewData = do+ app <- getYesod+ let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app+ (j, err) <- getCurrentJournal $ copts{reportopts_=ropts{no_elide_=True}}+ msg <- getMessageOr err+ Just here <- getCurrentRoute+ today <- liftIO getCurrentDay+ q <- getParameterOrNull "q"+ a <- getParameterOrNull "a"+ p <- getParameterOrNull "p"+ return (viewdataWithDateAndParams today q a p){+ opts=opts+ ,msg=msg+ ,here=here+ ,today=today+ ,j=j+ }+ where+ -- | Update our copy of the journal if the file changed. If there is an+ -- error while reloading, keep the old one and return the error, and set a+ -- ui message.+ getCurrentJournal :: CliOpts -> Handler (Journal, Maybe String)+ getCurrentJournal opts = do+ j <- liftIO $ fromJust `fmap` getValue "hledger" "journal"+ (jE, changed) <- liftIO $ journalReloadIfChanged opts j+ if not changed+ then return (j,Nothing)+ else case jE of+ Right j' -> do liftIO $ putValue "hledger" "journal" j'+ return (j',Nothing)+ Left e -> do setMessage $ "error while reading" {- ++ ": " ++ e-}+ return (j, Just e)++ -- | Get the named request parameter, or the empty string if not present.+ getParameterOrNull :: String -> Handler String+ getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p)++-- | Get the message set by the last request, or the newer message provided, if any.+getMessageOr :: Maybe String -> Handler (Maybe Html)+getMessageOr mnewmsg = do+ oldmsg <- getMessage+ return $ maybe oldmsg (Just . toHtml) mnewmsg++numbered :: [a] -> [(Int,a)]+numbered = zip [1..]++dayToJsTimestamp :: Day -> Integer+dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000 -- XXX read+ where t = UTCTime d (secondsToDiffTime 0)++chomp :: String -> String+chomp = reverse . dropWhile (`elem` "\r\n") . reverse+
config/routes view
@@ -1,10 +1,14 @@ /static StaticR Static getStatic -- /favicon.ico FaviconR GET /robots.txt RobotsR GET+ / RootR GET+ /journal JournalR GET POST /journal/entries JournalEntriesR GET POST /journal/edit JournalEditR GET POST+ /register RegisterR GET POST+ -- /accounts AccountsR GET -- /api/accounts AccountsJsonR GET
hledger-web.cabal view
@@ -1,6 +1,6 @@ name: hledger-web -- also in cpp-options below-version: 0.19+version: 0.19.1 category: Finance synopsis: A web interface for the hledger accounting tool. description: @@ -38,7 +38,7 @@ source-repository head type: darcs- location: http://joyful.com/repos/hledger+ location: http://hub.darcs.net/simon/hledger -- Flag production -- Description: Build fully optimised and with web files embedded (not loaded from ./static/)@@ -71,7 +71,14 @@ Settings Settings.StaticFiles Settings.Development- Handler.Handlers+ Handler.Common+ Handler.JournalEditR+ Handler.JournalEntriesR+ Handler.JournalR+ Handler.Post+ Handler.RegisterR+ Handler.RootR+ Handler.Utils other-modules: Hledger.Web Hledger.Web.Main@@ -83,7 +90,7 @@ -- Buildable: False ghc-options: -Wall -fno-warn-unused-do-bind- cpp-options: -DVERSION="0.19"+ cpp-options: -DVERSION="0.19.1" if flag(dev) || flag(library-only) cpp-options: -DDEVELOPMENT @@ -99,32 +106,33 @@ FlexibleContexts EmptyDataDecls NoMonomorphismRestriction+ RecordWildCards - build-depends: base >= 4 && < 5- -- , yesod-platform >= 1.1 && < 1.2- , yesod >= 1.1 && < 1.2- , yesod-core >= 1.1.2 && < 1.2- , yesod-static >= 1.1 && < 1.2- , yesod-default >= 1.1 && < 1.2- , yesod-form >= 1.1 && < 1.2- , clientsession >= 0.8 && < 0.9- , bytestring >= 0.9 && < 0.11- , text >= 0.11 && < 0.12- , template-haskell- , hamlet >= 1.1 && < 1.2- , shakespeare-css >= 1.0 && < 1.1- , shakespeare-js >= 1.0 && < 1.1- , shakespeare-text >= 1.0 && < 1.1- , hjsmin >= 0.1 && < 0.2- , monad-control >= 0.3 && < 0.4- , wai-extra >= 1.3 && < 1.4- , yaml >= 0.8 && < 0.9- , http-conduit >= 1.8 && < 1.9- , directory >= 1.1 && < 1.3- , warp >= 1.3 && < 1.4- , data-default+ build-depends: base >= 4 && < 5+ -- , yesod-platform >= 1.1 && < 1.2+ , yesod >= 1.1.3 && < 1.2+ , yesod-core >= 1.1.2 && < 1.2+ , yesod-static >= 1.1 && < 1.2+ , yesod-default >= 1.1 && < 1.2+ , yesod-form >= 1.1 && < 1.2+ , clientsession >= 0.8 && < 0.9+ , bytestring >= 0.9 && < 0.11+ , text >= 0.11 && < 0.12+ , template-haskell+ , hamlet >= 1.1 && < 1.2+ , shakespeare-css >= 1.0 && < 1.1+ , shakespeare-js >= 1.0 && < 1.1+ , shakespeare-text >= 1.0 && < 1.1+ , hjsmin >= 0.1 && < 0.2+ , monad-control >= 0.3 && < 0.4+ , wai-extra >= 1.3 && < 1.4+ , yaml >= 0.8 && < 0.9+ , http-conduit >= 1.8 && < 1.9+ , directory >= 1.1 && < 1.3+ , warp >= 1.3 && < 1.4+ , data-default - , hledger == 0.19.1+ , hledger == 0.19.2 , hledger-lib == 0.19.1 , cmdargs >= 0.10 && < 0.11 , directory@@ -154,7 +162,7 @@ executable hledger-web- cpp-options: -DVERSION="0.19"+ cpp-options: -DVERSION="0.19.1" if flag(library-only) Buildable: False@@ -176,6 +184,7 @@ OverloadedStrings MultiParamTypeClasses TypeFamilies+ RecordWildCards hs-source-dirs: . app @@ -187,14 +196,21 @@ Settings Settings.StaticFiles Settings.Development- Handler.Handlers+ Handler.Common+ Handler.JournalEditR+ Handler.JournalEntriesR+ Handler.JournalR+ Handler.Post+ Handler.RegisterR+ Handler.RootR+ Handler.Utils Hledger.Web Hledger.Web.Main Hledger.Web.Options build-depends: hledger-web- , hledger == 0.19.1+ , hledger == 0.19.2 , hledger-lib == 0.19.1 , base >= 4.3 && < 5 , cmdargs >= 0.10 && < 0.11@@ -226,6 +242,7 @@ , yaml , hjsmin >= 0.1 && < 0.2 , http-conduit >= 1.8 && < 1.9+ , data-default if flag(blaze_html_0_5) cpp-options: -DBLAZE_HTML_0_5@@ -236,30 +253,6 @@ build-depends: blaze-html >= 0.4 && < 0.5 - build-depends:- -- base >= 4 && < 5- -- -- , yesod-platform >= 1.1 && < 1.2- -- , yesod >= 1.1 && < 1.2- -- , yesod-core >= 1.1.2 && < 1.2- -- , yesod-static >= 1.1 && < 1.2- -- , yesod-default >= 1.1 && < 1.2- -- , yesod-form >= 1.1 && < 1.2- -- , clientsession >= 0.8 && < 0.9- -- , bytestring >= 0.9 && < 0.11- -- , text >= 0.11 && < 0.12- -- , template-haskell- -- , hamlet >= 1.1 && < 1.2- -- , shakespeare-css >= 1.0 && < 1.1- -- , shakespeare-js >= 1.0 && < 1.1- -- , shakespeare-text >= 1.0 && < 1.1- -- , hjsmin >= 0.1 && < 0.2- -- , monad-control >= 0.3 && < 0.4- -- , wai-extra >= 1.3 && < 1.4- -- , yaml >= 0.8 && < 0.9- -- , http-conduit >= 1.8 && < 1.9- -- , directory >= 1.1 && < 1.3- -- , warp >= 1.3 && < 1.4- data-default test-suite test type: exitcode-stdio-1.0