-- | /journal handlers.

{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

module Hledger.Web.Handler.JournalR where

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 :: Handler Html
getJournalR = do
  Handler ()
checkServerSideUiEnabled
  VD{[Capability]
caps :: ViewData -> [Capability]
caps :: [Capability]
caps, Journal
j :: ViewData -> Journal
j :: Journal
j, Query
m :: ViewData -> Query
m :: Query
m, WebOpts
opts :: ViewData -> WebOpts
opts :: WebOpts
opts, Text
q :: ViewData -> Text
q :: Text
q, [QueryOpt]
qopts :: ViewData -> [QueryOpt]
qopts :: [QueryOpt]
qopts, Day
today :: ViewData -> Day
today :: Day
today} <- Handler ViewData
getViewData
  Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Capability
CapView Capability -> [Capability] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Capability]
caps) (Text -> Handler ()
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Missing the 'view' capability")
  let title :: Text
title = case [QueryOpt] -> Maybe (Text, Bool)
inAccount [QueryOpt]
qopts of
        Maybe (Text, Bool)
Nothing -> Text
"General Journal"
        Just (Text
a, Bool
inclsubs) -> Text
"Transactions in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
inclsubs then Text
"" else Text
" (excluding subaccounts)"
      title' :: Text
title' = Text
title Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Query
m Query -> Query -> Bool
forall a. Eq a => a -> a -> Bool
/= Query
Any then Text
", filtered" else Text
""
      acctlink :: Text -> (Route App, [(a, Text)])
acctlink Text
a = (Route App
RegisterR, [(a
"q", Text -> Text -> Text
replaceInacct Text
q (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
accountQuery Text
a)])
      rspec :: ReportSpec
rspec = (CliOpts -> ReportSpec
reportspec_ (CliOpts -> ReportSpec) -> CliOpts -> ReportSpec
forall a b. (a -> b) -> a -> b
$ WebOpts -> CliOpts
cliopts_ WebOpts
opts){_rsQuery :: Query
_rsQuery = Query
m}
      items :: [EntriesReportItem]
items = [EntriesReportItem] -> [EntriesReportItem]
forall a. [a] -> [a]
reverse ([EntriesReportItem] -> [EntriesReportItem])
-> [EntriesReportItem] -> [EntriesReportItem]
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> [EntriesReportItem]
entriesReport ReportSpec
rspec Journal
j
      transactionFrag :: EntriesReportItem -> String
transactionFrag = Journal -> EntriesReportItem -> String
transactionFragment Journal
j

  WidgetFor App () -> Handler Html
forall site.
Yesod site =>
WidgetFor site () -> HandlerFor site Html
defaultLayout (WidgetFor App () -> Handler Html)
-> WidgetFor App () -> Handler Html
forall a b. (a -> b) -> a -> b
$ do
    Html -> WidgetFor App ()
forall (m :: * -> *). MonadWidget m => Html -> m ()
setTitle Html
"journal - hledger-web"
    $(widgetFile "journal")