{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE TypeFamilies #-} module Hcompta.Format.Ledger.Transaction where import Control.DeepSeq (NFData(..)) import Data.Bool import Data.Data (Data(..)) import Data.Eq (Eq(..)) import Data.Function (($), (.), id) import Data.Functor (Functor(..)) import Data.Functor.Compose (Compose(..)) import qualified Data.List as List import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (Maybe(..)) import Data.Monoid (Monoid(..)) import Data.Text (Text) import Data.Tuple (fst) import Data.Typeable (Typeable) import Prelude (flip, seq) import Text.Parsec.Pos (SourcePos, initialPos) import Text.Show (Show) import qualified Hcompta.Chart as Chart import Hcompta.Date (Date) import qualified Hcompta.Date as Date import qualified Hcompta.Filter as Filter import qualified Hcompta.GL as GL import qualified Hcompta.Journal as Journal import Hcompta.Lib.Parsec () import qualified Hcompta.Stats as Stats import Hcompta.Transaction (Transaction_Tags(..)) import Hcompta.Format.Ledger.Account import Hcompta.Format.Ledger.Posting import Hcompta.Format.Ledger.Chart type Code = Text type Status = Bool type Wording = Text -- * Type 'Transaction' data Transaction = Transaction { transaction_code :: Code , transaction_comments_before :: [Comment] , transaction_comments_after :: [Comment] , transaction_dates :: (Date, [Date]) , transaction_postings :: Map Account [Posting] , transaction_sourcepos :: SourcePos , transaction_status :: Status , transaction_tags :: Transaction_Tags , transaction_wording :: Wording } deriving (Data, Eq, Show, Typeable) instance NFData Transaction where rnf Transaction { transaction_code , transaction_comments_before , transaction_comments_after , transaction_dates , transaction_postings -- , transaction_sourcepos , transaction_status , transaction_tags , transaction_wording } = rnf transaction_code `seq` rnf transaction_comments_before `seq` rnf transaction_comments_after `seq` rnf transaction_dates `seq` rnf transaction_postings `seq` -- rnf transaction_sourcepos `seq` rnf transaction_status `seq` rnf transaction_tags `seq` rnf transaction_wording transaction :: Transaction transaction = Transaction { transaction_code = "" , transaction_comments_after = [] , transaction_comments_before = [] , transaction_dates = (Date.nil, []) , transaction_postings = mempty , transaction_sourcepos = initialPos "" , transaction_status = False , transaction_tags = mempty , transaction_wording = "" } instance Filter.Transaction (Charted Transaction) where type Transaction_Posting (Charted Transaction) = Charted Posting type Transaction_Postings (Charted Transaction) = Compose (Map Account) [] transaction_date = fst . transaction_dates . Chart.charted transaction_wording = transaction_wording . Chart.charted transaction_postings (Chart.Charted c t) = fmap (Chart.Charted c) $ Compose $ transaction_postings t {- transaction_postings_virtual (Chart.Charted c t) = fmap (Chart.Charted c) $ Compose [ Compose $ transaction_virtual_postings t , Compose $ transaction_balanced_virtual_postings t ] -} transaction_tags = transaction_tags . Chart.charted instance Journal.Transaction Transaction where transaction_date = fst . transaction_dates instance Journal.Transaction (Charted Transaction) where transaction_date = Journal.transaction_date . Chart.charted instance Stats.Transaction Transaction where type Transaction_Posting Transaction = Posting type Transaction_Postings Transaction = Compose (Map Account) [] transaction_date = fst . transaction_dates transaction_postings = Compose . transaction_postings transaction_postings_size = Map.size . transaction_postings transaction_tags = transaction_tags instance Stats.Transaction (Charted Transaction) where type Transaction_Posting (Charted Transaction) = Stats.Transaction_Posting Transaction type Transaction_Postings (Charted Transaction) = Stats.Transaction_Postings Transaction transaction_date = Stats.transaction_date . Chart.charted transaction_postings = Stats.transaction_postings . Chart.charted transaction_postings_size = Stats.transaction_postings_size . Chart.charted transaction_tags = Stats.transaction_tags . Chart.charted instance GL.Transaction Transaction where type Transaction_Line Transaction = Transaction type Transaction_Posting Transaction = Posting type Transaction_Postings Transaction = Compose (Map Account) [] transaction_line = id transaction_date = fst . transaction_dates transaction_postings = Compose . transaction_postings transaction_postings_filter f t = t{ transaction_postings = Map.mapMaybe (\p -> case List.filter f p of [] -> Nothing ps -> Just ps) (transaction_postings t) } instance GL.Transaction (Charted Transaction) where type Transaction_Line (Charted Transaction) = Transaction type Transaction_Posting (Charted Transaction) = (Charted (GL.Transaction_Posting Transaction)) type Transaction_Postings (Charted Transaction) = GL.Transaction_Postings Transaction transaction_line = Chart.charted transaction_date = GL.transaction_date . Chart.charted transaction_postings (Chart.Charted c t) = fmap (Chart.Charted c) $ GL.transaction_postings t transaction_postings_filter f (Chart.Charted c t) = Chart.Charted c t{ transaction_postings = Map.mapMaybe (\p -> case List.filter f $ fmap (Chart.Charted c) p of [] -> Nothing ps -> Just $ fmap Chart.charted ps) (transaction_postings t) } -- | Return a 'Map' associating -- the given 'Transaction's with their respective 'Date'. transaction_by_date :: [Transaction] -> (Compose (Map Date) []) Transaction transaction_by_date = Compose . Map.fromListWith (flip mappend) . List.map (\t -> (fst $ transaction_dates t, [t]))