jcc/Hcompta/Format/JCC/Transaction.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE TypeFamilies #-}
   6 module Hcompta.Format.JCC.Transaction where
   7
   8 import           Control.DeepSeq (NFData(..))
   9 import           Data.Data (Data(..))
  10 import           Data.Eq (Eq(..))
  11 import           Data.Function (($), (.), id)
  12 import           Data.Functor (Functor(..))
  13 import           Data.Functor.Compose (Compose(..))
  14 import qualified Data.List as List
  15 import           Data.Map.Strict (Map)
  16 import qualified Data.Map.Strict as Map
  17 import           Data.Maybe (Maybe(..))
  18 import           Data.Monoid (Monoid(..))
  19 import           Data.Text (Text)
  20 import           Data.Tuple (fst)
  21 import           Data.Typeable (Typeable)
  22 import           Prelude (flip, seq)
  23 import           Text.Parsec.Pos (SourcePos, initialPos)
  24 import           Text.Show (Show)
  25
  26 import qualified Hcompta.Chart as Chart
  27 import           Hcompta.Date (Date)
  28 import qualified Hcompta.Date as Date
  29 import qualified Hcompta.Filter as Filter
  30 import qualified Hcompta.GL as GL
  31 import qualified Hcompta.Journal as Journal
  32 import           Hcompta.Lib.Parsec ()
  33 import qualified Hcompta.Stats as Stats
  34 import           Hcompta.Transaction ( Transaction_Tags(..)
  35                                      , Transaction_Anchors(..) )
  36
  37 import           Hcompta.Format.JCC.Account
  38 import           Hcompta.Format.JCC.Posting
  39 import           Hcompta.Format.JCC.Chart
  40
  41 type Wording = Text
  42
  43 -- * Type 'Transaction'
  44
  45 data Transaction
  46  =   Transaction
  47  { transaction_anchors   :: Transaction_Anchors
  48  , transaction_comments  :: [Comment]
  49  , transaction_dates     :: (Date, [Date])
  50  , transaction_postings  :: Map Account [Posting]
  51  , transaction_sourcepos :: SourcePos
  52  , transaction_tags      :: Transaction_Tags
  53  , transaction_wording   :: Wording
  54  } deriving (Data, Eq, Show, Typeable)
  55 instance NFData Transaction where
  56         rnf
  57          Transaction
  58          { transaction_anchors
  59          , transaction_comments
  60          , transaction_dates
  61          , transaction_postings
  62          -- , transaction_sourcepos
  63          , transaction_tags
  64          , transaction_wording
  65          } =
  66                 rnf transaction_anchors `seq`
  67                 rnf transaction_comments `seq`
  68                 rnf transaction_dates `seq`
  69                 rnf transaction_postings `seq`
  70                 -- rnf transaction_sourcepos `seq`
  71                 rnf transaction_tags `seq`
  72                 rnf transaction_wording
  73
  74 transaction :: Transaction
  75 transaction =
  76         Transaction
  77          { transaction_anchors   = mempty
  78          , transaction_comments  = []
  79          , transaction_dates     = (Date.nil, [])
  80          , transaction_postings  = mempty
  81          , transaction_sourcepos = initialPos ""
  82          , transaction_tags      = mempty
  83          , transaction_wording   = ""
  84          }
  85
  86 instance Filter.Transaction (Charted Transaction) where
  87         type Transaction_Posting  (Charted Transaction) = Charted Posting
  88         type Transaction_Postings (Charted Transaction) = Compose (Map Account) []
  89         transaction_date = fst . transaction_dates . Chart.charted
  90         transaction_wording = transaction_wording . Chart.charted
  91         transaction_postings (Chart.Charted c t)  =
  92                 fmap (Chart.Charted c) $
  93                 Compose $ transaction_postings t
  94         {-
  95         transaction_postings_virtual (Chart.Charted c t) =
  96                 fmap (Chart.Charted c) $
  97                 Compose
  98                  [ Compose $ transaction_virtual_postings t
  99                  , Compose $ transaction_balanced_virtual_postings t
 100                  ]
 101         -}
 102         transaction_tags = transaction_tags . Chart.charted
 103
 104 instance Journal.Transaction Transaction where
 105         transaction_date = fst . transaction_dates
 106 instance Journal.Transaction (Charted Transaction) where
 107         transaction_date = Journal.transaction_date . Chart.charted
 108
 109 instance Stats.Transaction  Transaction where
 110         type Transaction_Posting  Transaction = Posting
 111         type Transaction_Postings Transaction = Compose (Map Account) []
 112         transaction_date = fst . transaction_dates
 113         transaction_postings = Compose . transaction_postings
 114         transaction_postings_size = Map.size . transaction_postings
 115         transaction_tags = transaction_tags
 116 instance Stats.Transaction  (Charted Transaction) where
 117         type Transaction_Posting  (Charted Transaction) = Stats.Transaction_Posting  Transaction
 118         type Transaction_Postings (Charted Transaction) = Stats.Transaction_Postings Transaction
 119         transaction_date = Stats.transaction_date . Chart.charted
 120         transaction_postings = Stats.transaction_postings . Chart.charted
 121         transaction_postings_size = Stats.transaction_postings_size . Chart.charted
 122         transaction_tags = Stats.transaction_tags . Chart.charted
 123
 124 instance GL.Transaction     Transaction where
 125         type Transaction_Line     Transaction = Transaction
 126         type Transaction_Posting  Transaction = Posting
 127         type Transaction_Postings Transaction = Compose (Map Account) []
 128         transaction_line = id
 129         transaction_date = fst . transaction_dates
 130         transaction_postings = Compose . transaction_postings
 131         transaction_postings_filter f t =
 132                 t{ transaction_postings =
 133                         Map.mapMaybe
 134                          (\p -> case List.filter f p of
 135                                  [] -> Nothing
 136                                  ps -> Just ps)
 137                          (transaction_postings t)
 138                  }
 139 instance GL.Transaction     (Charted Transaction) where
 140         type Transaction_Line     (Charted Transaction) = Transaction
 141         type Transaction_Posting  (Charted Transaction) = (Charted (GL.Transaction_Posting Transaction))
 142         type Transaction_Postings (Charted Transaction) = GL.Transaction_Postings Transaction
 143         transaction_line = Chart.charted
 144         transaction_date = GL.transaction_date . Chart.charted
 145         transaction_postings (Chart.Charted c t) =
 146                 fmap (Chart.Charted c) $
 147                 GL.transaction_postings t
 148         transaction_postings_filter f (Chart.Charted c t) =
 149                 Chart.Charted c
 150                  t{ transaction_postings =
 151                         Map.mapMaybe
 152                          (\p -> case List.filter f $ fmap (Chart.Charted c) p of
 153                                  [] -> Nothing
 154                                  ps -> Just $ fmap Chart.charted ps)
 155                          (transaction_postings t)
 156                  }
 157
 158 -- | Return a 'Map' associating
 159 --   the given 'Transaction's with their respective 'Date'.
 160 transaction_by_date :: [Transaction] -> (Compose (Map Date) []) Transaction
 161 transaction_by_date =
 162         Compose .
 163         Map.fromListWith (flip mappend) .
 164         List.map (\t -> (fst $ transaction_dates t, [t]))