hledger/hledger-web/Hledger/Web/Handler/JournalR.hs

48 lines
1.7 KiB
Haskell

-- | /journal handlers.
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
module Hledger.Web.Handler.JournalR where
import qualified Data.Text as T -- also for journal.hamlet
import qualified Text.URI as URI
import Yesod.Static
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Web.Import
import Hledger.Web.WebOptions
import Hledger.Web.Widget.AddForm (addModal)
import Hledger.Web.Widget.Common
(accountQuery, mixedAmountAsHtml,
transactionFragment, replaceInacct)
-- | The formatted journal view, with sidebar.
getJournalR :: Handler Html
getJournalR = do
checkServerSideUiEnabled
VD{perms, j, q, opts, qparam, qopts, today} <- getViewData
require ViewPermission
let title = case inAccount qopts of
Nothing -> "Kaikki kirjaukset"
Just (a, inclsubs) -> "Tapahtumat tilillä " <> a <> if inclsubs then "" else " (poislukien alatilit)"
title' = title <> if q /= Any then ", suodatettu" else ""
acctlink a = (RegisterR, [("q", replaceInacct qparam $ accountQuery a)])
rspec = (reportspec_ $ cliopts_ opts){_rsQuery = filterQuery (not . queryIsDepth) q}
items = reverse $
styleAmounts (journalCommodityStylesWith HardRounding j) $
entriesReport rspec j
transactionFrag = transactionFragment j
isVisibleTag = not . isHiddenTagName . fst
isPostingTag account tag = not $ tag `elem` journalInheritedAccountTags j account
isAbsoluteURI = maybe False URI.isPathAbsolute . URI.mkURI
documentRoute = DocumentR . flip StaticRoute [] . T.splitOn "/"
defaultLayout $ do
setTitle "päiväkirja - hledger-web"
$(widgetFile "journal")