55 lines
2.2 KiB
Haskell
55 lines
2.2 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 "/"
|
|
escapeRegex = T.pack . concatMap escape . T.unpack
|
|
escape c
|
|
| c `elem` (".[$^()|*+?{\\" :: [Char]) = ['\\', c]
|
|
| otherwise = [c]
|
|
-- XXX:is there no way to escape quotes in queries
|
|
addTagQuery name value = (JournalR, [("q", qparam <> " \"tag:" <> escapeRegex name <> (if T.null value then "" else "=" <> escapeRegex value) <> "\"")])
|
|
addCodeQuery code = (JournalR, [("q", qparam <> " \"code:" <> escapeRegex code <> "\"")])
|
|
|
|
defaultLayout $ do
|
|
setTitle "päiväkirja - hledger-web"
|
|
$(widgetFile "journal")
|