{-# LANGUAGE FlexibleInstances   #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE 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.Ord (comparing)
import Data.Time (fromGregorian)

import Hledger.Data
import Hledger.Query (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{_rsReportOpts :: ReportSpec -> ReportOpts
_rsReportOpts=ReportOpts
ropts} =
    (EntriesReportItem -> EntriesReportItem -> Ordering)
-> EntriesReport -> EntriesReport
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((EntriesReportItem -> Day)
-> EntriesReportItem -> EntriesReportItem -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((EntriesReportItem -> Day)
 -> EntriesReportItem -> EntriesReportItem -> Ordering)
-> (EntriesReportItem -> Day)
-> EntriesReportItem
-> EntriesReportItem
-> Ordering
forall a b. (a -> b) -> a -> b
$ ReportOpts -> EntriesReportItem -> Day
transactionDateFn ReportOpts
ropts) (EntriesReport -> EntriesReport)
-> (Journal -> EntriesReport) -> Journal -> EntriesReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> EntriesReport
jtxns
    (Journal -> EntriesReport)
-> (Journal -> Journal) -> Journal -> EntriesReport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> Journal -> Journal
journalApplyValuationFromOpts (ConversionOp -> ReportSpec -> ReportSpec
setDefaultConversionOp ConversionOp
NoConversionOp ReportSpec
rspec)
    (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Journal -> Journal
filterJournalTransactions (ReportSpec -> Query
_rsQuery ReportSpec
rspec)

tests_EntriesReport :: TestTree
tests_EntriesReport = TestName -> [TestTree] -> TestTree
testGroup TestName
"EntriesReport" [
  TestName -> [TestTree] -> TestTree
testGroup TestName
"entriesReport" [
     TestName -> Assertion -> TestTree
testCase TestName
"not acct" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (EntriesReport -> Int
forall a. [a] -> 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=Not . Acct $ toRegex' "bank"} Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
1
    ,TestName -> Assertion -> TestTree
testCase TestName
"date" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ (EntriesReport -> Int
forall a. [a] -> 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=Date $ DateSpan (Just $ Exact $ fromGregorian 2008 06 01) (Just $ Exact $ fromGregorian 2008 07 01)} Journal
samplejournal) Int -> Int -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Int
3
  ]
 ]