{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances, ScopedTypeVariables #-}
{-|

Journal entries report, used by the print command.

-}

module Hledger.Reports.EntriesReport (
  EntriesReport,
  EntriesReportItem,
  entriesReport,
  -- * Tests
  tests_EntriesReport
)
where

import Data.List (sortBy)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)
import Data.Time (fromGregorian)

import Hledger.Data
import Hledger.Query
import Hledger.Reports.ReportOptions
import Hledger.Utils


-- | A journal entries report is a list of whole transactions as
-- originally entered in the journal (mostly). This is used by eg
-- hledger's print command and hledger-web's journal entries view.
type EntriesReport = [EntriesReportItem]
type EntriesReportItem = Transaction

-- | Select transactions for an entries report.
entriesReport :: ReportSpec -> Journal -> EntriesReport
entriesReport :: ReportSpec -> Journal -> EntriesReport
entriesReport rspec :: ReportSpec
rspec@ReportSpec{rsOpts :: ReportSpec -> ReportOpts
rsOpts=ropts :: ReportOpts
ropts@ReportOpts{Bool
Int
[Text]
[Status]
Maybe Int
Maybe NormalSign
Maybe DateSpan
Maybe ValuationType
Interval
Period
StringFormat
Costing
AccountListMode
BalanceType
ReportType
transpose_ :: ReportOpts -> Bool
forecast_ :: ReportOpts -> Maybe DateSpan
color_ :: ReportOpts -> Bool
normalbalance_ :: ReportOpts -> Maybe NormalSign
invert_ :: ReportOpts -> Bool
percent_ :: ReportOpts -> Bool
sort_amount_ :: ReportOpts -> Bool
pretty_tables_ :: ReportOpts -> Bool
no_total_ :: ReportOpts -> Bool
row_total_ :: ReportOpts -> Bool
drop_ :: ReportOpts -> Int
accountlistmode_ :: ReportOpts -> AccountListMode
balancetype_ :: ReportOpts -> BalanceType
reporttype_ :: ReportOpts -> ReportType
txn_dates_ :: ReportOpts -> Bool
related_ :: ReportOpts -> Bool
average_ :: ReportOpts -> Bool
querystring_ :: ReportOpts -> [Text]
format_ :: ReportOpts -> StringFormat
real_ :: ReportOpts -> Bool
no_elide_ :: ReportOpts -> Bool
empty_ :: ReportOpts -> Bool
date2_ :: ReportOpts -> Bool
depth_ :: ReportOpts -> Maybe Int
infer_value_ :: ReportOpts -> Bool
value_ :: ReportOpts -> Maybe ValuationType
cost_ :: ReportOpts -> Costing
statuses_ :: ReportOpts -> [Status]
interval_ :: ReportOpts -> Interval
period_ :: ReportOpts -> Period
transpose_ :: Bool
forecast_ :: Maybe DateSpan
color_ :: Bool
normalbalance_ :: Maybe NormalSign
invert_ :: Bool
percent_ :: Bool
sort_amount_ :: Bool
pretty_tables_ :: Bool
no_total_ :: Bool
row_total_ :: Bool
drop_ :: Int
accountlistmode_ :: AccountListMode
balancetype_ :: BalanceType
reporttype_ :: ReportType
txn_dates_ :: Bool
related_ :: Bool
average_ :: Bool
querystring_ :: [Text]
format_ :: StringFormat
real_ :: Bool
no_elide_ :: Bool
empty_ :: Bool
date2_ :: Bool
depth_ :: Maybe Int
infer_value_ :: Bool
value_ :: Maybe ValuationType
cost_ :: Costing
statuses_ :: [Status]
interval_ :: Interval
period_ :: Period
..}} j :: Journal
j@Journal{[FilePath]
[(FilePath, Text)]
[(Text, AccountDeclarationInfo)]
[(Text, PayeeDeclarationInfo)]
[Text]
[MarketPrice]
[PriceDirective]
[TimeclockEntry]
[PeriodicTransaction]
[TransactionModifier]
EntriesReport
[AccountAlias]
Maybe DecimalMark
Maybe Year
Maybe (Text, AmountStyle)
Text
Map Text Commodity
Map Text AmountStyle
Map AccountType [Text]
ClockTime
jlastreadtime :: Journal -> ClockTime
jfiles :: Journal -> [(FilePath, Text)]
jfinalcommentlines :: Journal -> Text
jtxns :: Journal -> EntriesReport
jperiodictxns :: Journal -> [PeriodicTransaction]
jtxnmodifiers :: Journal -> [TransactionModifier]
jinferredmarketprices :: Journal -> [MarketPrice]
jpricedirectives :: Journal -> [PriceDirective]
jinferredcommodities :: Journal -> Map Text AmountStyle
jcommodities :: Journal -> Map Text Commodity
jglobalcommoditystyles :: Journal -> Map Text AmountStyle
jdeclaredaccounttypes :: Journal -> Map AccountType [Text]
jdeclaredaccounts :: Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredpayees :: Journal -> [(Text, PayeeDeclarationInfo)]
jincludefilestack :: Journal -> [FilePath]
jparsetimeclockentries :: Journal -> [TimeclockEntry]
jparsealiases :: Journal -> [AccountAlias]
jparseparentaccounts :: Journal -> [Text]
jparsedecimalmark :: Journal -> Maybe DecimalMark
jparsedefaultcommodity :: Journal -> Maybe (Text, AmountStyle)
jparsedefaultyear :: Journal -> Maybe Year
jlastreadtime :: ClockTime
jfiles :: [(FilePath, Text)]
jfinalcommentlines :: Text
jtxns :: EntriesReport
jperiodictxns :: [PeriodicTransaction]
jtxnmodifiers :: [TransactionModifier]
jinferredmarketprices :: [MarketPrice]
jpricedirectives :: [PriceDirective]
jinferredcommodities :: Map Text AmountStyle
jcommodities :: Map Text Commodity
jglobalcommoditystyles :: Map Text AmountStyle
jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
jdeclaredpayees :: [(Text, PayeeDeclarationInfo)]
jincludefilestack :: [FilePath]
jparsetimeclockentries :: [TimeclockEntry]
jparsealiases :: [AccountAlias]
jparseparentaccounts :: [Text]
jparsedecimalmark :: Maybe DecimalMark
jparsedefaultcommodity :: Maybe (Text, AmountStyle)
jparsedefaultyear :: Maybe Year
..} =
  (Transaction -> Transaction -> Ordering)
-> EntriesReport -> EntriesReport
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Transaction -> Day) -> Transaction -> Transaction -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Transaction -> Day
getdate) (EntriesReport -> EntriesReport) -> EntriesReport -> EntriesReport
forall a b. (a -> b) -> a -> b
$ (Transaction -> Bool) -> EntriesReport -> EntriesReport
forall a. (a -> Bool) -> [a] -> [a]
filter (ReportSpec -> Query
rsQuery ReportSpec
rspec Query -> Transaction -> Bool
`matchesTransaction`) (EntriesReport -> EntriesReport) -> EntriesReport -> EntriesReport
forall a b. (a -> b) -> a -> b
$ (Transaction -> Transaction) -> EntriesReport -> EntriesReport
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
tvalue EntriesReport
jtxns
  where
    getdate :: Transaction -> Day
getdate = ReportOpts -> Transaction -> Day
transactionDateFn ReportOpts
ropts
    -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
    tvalue :: Transaction -> Transaction
tvalue t :: Transaction
t@Transaction{Year
[Tag]
[Posting]
Maybe Day
Text
Day
GenericSourcePos
Status
tpostings :: Transaction -> [Posting]
ttags :: Transaction -> [Tag]
tcomment :: Transaction -> Text
tdescription :: Transaction -> Text
tcode :: Transaction -> Text
tstatus :: Transaction -> Status
tdate2 :: Transaction -> Maybe Day
tdate :: Transaction -> Day
tsourcepos :: Transaction -> GenericSourcePos
tprecedingcomment :: Transaction -> Text
tindex :: Transaction -> Year
tpostings :: [Posting]
ttags :: [Tag]
tcomment :: Text
tdescription :: Text
tcode :: Text
tstatus :: Status
tdate2 :: Maybe Day
tdate :: Day
tsourcepos :: GenericSourcePos
tprecedingcomment :: Text
tindex :: Year
..} = Transaction
t{tpostings :: [Posting]
tpostings=(Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
pvalue [Posting]
tpostings}
      where
        pvalue :: Posting -> Posting
pvalue = PriceOracle
-> Map Text AmountStyle
-> Day
-> Day
-> Costing
-> Maybe ValuationType
-> Posting
-> Posting
postingApplyCostValuation (Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer_value_ Journal
j) (Journal -> Map Text AmountStyle
journalCommodityStyles Journal
j) Day
periodlast (ReportSpec -> Day
rsToday ReportSpec
rspec) Costing
cost_ Maybe ValuationType
value_
          where periodlast :: Day
periodlast  = Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (ReportSpec -> Day
rsToday ReportSpec
rspec) (Maybe Day -> Day) -> Maybe Day -> Day
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ReportSpec
rspec Journal
j

tests_EntriesReport :: TestTree
tests_EntriesReport = FilePath -> [TestTree] -> TestTree
tests FilePath
"EntriesReport" [
  FilePath -> [TestTree] -> TestTree
tests FilePath
"entriesReport" [
     FilePath -> Assertion -> TestTree
test FilePath
"not acct" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (EntriesReport -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (EntriesReport -> Int) -> EntriesReport -> Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> EntriesReport
entriesReport ReportSpec
defreportspec{rsQuery :: Query
rsQuery=Query -> Query
Not (Query -> Query) -> (Regexp -> Query) -> Regexp -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ Text -> Regexp
toRegex' Text
"bank"} Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
1
    ,FilePath -> Assertion -> TestTree
test FilePath
"date" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (EntriesReport -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (EntriesReport -> Int) -> EntriesReport -> Int
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Journal -> EntriesReport
entriesReport ReportSpec
defreportspec{rsQuery :: Query
rsQuery=DateSpan -> Query
Date (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
06 Int
01) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Year -> Int -> Int -> Day
fromGregorian Year
2008 Int
07 Int
01)} Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
3
  ]
 ]