jcc/Hcompta/JCC/Transaction.hs

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