From ee36b529e7c91b1be25cf93f69d79fc6fea8484a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jakub=20Z=C3=A1rybnick=C3=BD?= Date: Sun, 10 Jun 2018 01:39:05 +0200 Subject: [PATCH] web: Extract html into external files --- hledger-web/src/Handler/Common.hs | 2 +- hledger-web/src/Handler/JournalR.hs | 57 ++--------- hledger-web/src/Handler/RegisterR.hs | 141 ++++---------------------- hledger-web/templates/chart.hamlet | 59 +++++++++++ hledger-web/templates/journal.hamlet | 32 ++++++ hledger-web/templates/register.hamlet | 32 ++++++ 6 files changed, 156 insertions(+), 167 deletions(-) create mode 100644 hledger-web/templates/chart.hamlet create mode 100644 hledger-web/templates/journal.hamlet create mode 100644 hledger-web/templates/register.hamlet diff --git a/hledger-web/src/Handler/Common.hs b/hledger-web/src/Handler/Common.hs index dda64e166..d3c49e3f8 100644 --- a/hledger-web/src/Handler/Common.hs +++ b/hledger-web/src/Handler/Common.hs @@ -98,7 +98,7 @@ $forall t <- ts #{t}
|] where - ts = T.lines . T.pack $ showMixedAmountWithoutPrice b + ts = lines (showMixedAmountWithoutPrice b) c = case isNegativeMixedAmount b of Just True -> "negative amount" :: Text _ -> "positive amount" diff --git a/hledger-web/src/Handler/JournalR.hs b/hledger-web/src/Handler/JournalR.hs index 8fa4650bd..5eba56978 100644 --- a/hledger-web/src/Handler/JournalR.hs +++ b/hledger-web/src/Handler/JournalR.hs @@ -1,6 +1,10 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes, NamedFieldPuns #-} -- | /journal handlers. +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + module Handler.JournalR where import Import @@ -19,55 +23,14 @@ getJournalR :: Handler Html getJournalR = do VD{j, m, opts, qopts} <- getViewData -- XXX like registerReportAsHtml + let title = case inAccount qopts of Nothing -> "General Journal" Just (a, inclsubs) -> "Transactions in " <> a <> if inclsubs then "" else " (excluding subaccounts)" title' = title <> if m /= Any then ", filtered" else "" - maincontent = transactionsReportAsHtml $ journalTransactionsReport (reportopts_ $ cliopts_ opts) j m + acctlink a = (RegisterR, [("q", accountQuery a)]) + (_, items) = journalTransactionsReport (reportopts_ $ cliopts_ opts) j m + defaultLayout $ do setTitle "journal - hledger-web" - toWidget [hamlet| -
-

#{title'} - - Add a transaction -
- ^{maincontent} - |] - --- | Render a "TransactionsReport" as html for the formatted journal view. -transactionsReportAsHtml :: (w, [TransactionsReportItem]) -> HtmlUrl AppRoute -transactionsReportAsHtml (_,items) = [hamlet| - - - - - - - -
- Date - Description - Account - Amount - $forall i <- items - ^{transactionReportItem i} - |] - -transactionReportItem :: TransactionsReportItem -> HtmlUrl AppRoute -transactionReportItem (torig, _, split, _, amt, _) = [hamlet| -
#{date} - #{textElideRight 60 desc} - - $if showamt - \^{mixedAmountAsHtml amt} -$forall p' <- tpostings torig -
- - -   - #{elideAccountName 40 $ paccount p'} - ^{mixedAmountAsHtml $ pamount p'} -|] - where - acctlink a = (RegisterR, [("q", accountQuery a)]) - (date, desc) = (show $ tdate torig, tdescription torig) - showamt = not split || not (isZeroMixedAmount amt) - + $(widgetFile "journal") diff --git a/hledger-web/src/Handler/RegisterR.hs b/hledger-web/src/Handler/RegisterR.hs index 64314fda9..02b9ed732 100644 --- a/hledger-web/src/Handler/RegisterR.hs +++ b/hledger-web/src/Handler/RegisterR.hs @@ -1,6 +1,11 @@ -{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, QuasiQuotes, NamedFieldPuns #-} -- | /register handlers. +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} + module Handler.RegisterR where import Import @@ -9,6 +14,7 @@ import Data.Time import Data.List (intersperse) import qualified Data.Text as T import Safe (headMay) +import Text.Hamlet (hamletFile) import Handler.Common (mixedAmountAsHtml, numberTransactionsReportItems) @@ -20,132 +26,29 @@ import Hledger.Web.WebOptions getRegisterR :: Handler Html getRegisterR = do VD{j, m, opts, qopts} <- getViewData - let title = a <> s1 <> s2 - where - (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts - s1 = if inclsubs then "" else " (excluding subaccounts)" - s2 = if m /= Any then ", filtered" else "" + let (a,inclsubs) = fromMaybe ("all accounts",True) $ inAccount qopts + s1 = if inclsubs then "" else " (excluding subaccounts)" + s2 = if m /= Any then ", filtered" else "" + header = a <> s1 <> s2 + + let r@(balancelabel,items) = accountTransactionsReport (reportopts_ $ cliopts_ opts) j m $ fromMaybe Any $ inAccountQuery qopts + balancelabel' = if isJust (inAccount qopts) then balancelabel else "Total" + evenodd x = if even x then "even" else "odd" :: Text + datetransition newm newd + | newm = "newmonth" + | newd = "newday" + | otherwise = "" :: Text + defaultLayout $ do setTitle "register - hledger-web" - _ <- toWidget [hamlet|

#{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. -registerReportHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute -registerReportHtml qopts r = [hamlet| -
- ^{registerChartHtml $ transactionsReportByCommodity r} - ^{registerItemsHtml qopts r} -|] - --- | Generate html for a transaction list from an "TransactionsReport". -registerItemsHtml :: [QueryOpt] -> TransactionsReport -> HtmlUrl AppRoute -registerItemsHtml qopts (balancelabel,items) = [hamlet| -
- -

- Date - - Description - To/From Account(s) - Amount Out/In - #{balancelabel'} - $forall i <- numberTransactionsReportItems items - ^{itemAsHtml i} - |] - where - insomeacct = isJust $ inAccount qopts - balancelabel' = if insomeacct then balancelabel else "Total" - - itemAsHtml :: (Int, Bool, Bool, TransactionsReportItem) -> HtmlUrl AppRoute - itemAsHtml (n, newd, newm, (torig, tacct, split, acct, amt, bal)) = [hamlet| -
- #{date} - #{textElideRight 30 desc} - #{elideRight 40 acct} - - $if showamt - \^{mixedAmountAsHtml amt} - ^{mixedAmountAsHtml bal} -|] - where - evenodd = if even n then "even" else "odd" :: Text - datetransition | newm = "newmonth" - | newd = "newday" - | otherwise = "" :: Text - (firstposting, date, desc) = (False, show $ tdate tacct, tdescription tacct) - showamt = not split || not (isZeroMixedAmount amt) + $(widgetFile "register") -- | Generate javascript/html for a register balance line chart based on -- the provided "TransactionsReportItem"s. registerChartHtml :: [(CommoditySymbol, (String, [TransactionsReportItem]))] -> HtmlUrl AppRoute -registerChartHtml percommoditytxnreports = +registerChartHtml percommoditytxnreports = $(hamletFile "templates/chart.hamlet") -- have to make sure plot is not called when our container (maincontent) -- is hidden, eg with add form toggled - [hamlet| -