ledger/Hcompta/Ledger/Transaction.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE NamedFieldPuns #-}
   5 {-# LANGUAGE RecordWildCards #-}
   6 {-# LANGUAGE TypeFamilies #-}
   7 module Hcompta.Ledger.Transaction where
   8
   9 import           Control.DeepSeq (NFData(..))
  10 import           Data.Bool
  11 import           Data.Data (Data(..))
  12 import           Data.Eq (Eq(..))
  13 import           Data.Function (($), (.), id)
  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.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 as H
  27
  28 import           Hcompta.Ledger.Account
  29 import           Hcompta.Ledger.Posting
  30 import           Hcompta.Ledger.Chart
  31
  32 -- * Type 'Transaction'
  33
  34 data Transaction
  35  =   Transaction
  36  {   transaction_code            :: Code
  37  ,   transaction_comments_before :: [Comment]
  38  ,   transaction_comments_after  :: [Comment]
  39  ,   transaction_dates           :: (H.Date, [H.Date])
  40  ,   transaction_postings        :: Map Account [Posting]
  41  ,   transaction_sourcepos       :: SourcePos
  42  ,   transaction_status          :: Status
  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_code            = ""
  51          , transaction_comments_after  = []
  52          , transaction_comments_before = []
  53          , transaction_dates           = (H.date_epoch, [])
  54          , transaction_postings        = mempty
  55          , transaction_sourcepos       = initialPos ""
  56          , transaction_status          = False
  57          , transaction_tags            = mempty
  58          , transaction_wording         = ""
  59          }
  60
  61 instance NFData Transaction where
  62         rnf Transaction{..} =
  63                 rnf transaction_code `seq`
  64                 rnf transaction_comments_before `seq`
  65                 rnf transaction_comments_after `seq`
  66                 rnf transaction_dates `seq`
  67                 rnf transaction_postings `seq`
  68                 -- rnf transaction_sourcepos `seq`
  69                 rnf transaction_status `seq`
  70                 rnf transaction_tags `seq`
  71                 rnf transaction_wording
  72
  73 -- Transaction
  74 instance H.Transaction      Transaction where
  75         type Transaction_Posting  Transaction = Posting
  76         type Transaction_Postings Transaction = Compose (Map Account) [] Posting
  77         transaction_date        = fst . transaction_dates
  78         transaction_description = transaction_wording
  79         transaction_postings    = Compose . transaction_postings
  80         transaction_tags        = transaction_tags
  81 instance H.Transaction      (Charted Transaction) where
  82         type Transaction_Posting  (Charted Transaction) = H.Transaction_Posting  Transaction
  83         type Transaction_Postings (Charted Transaction) = H.Transaction_Postings Transaction
  84         transaction_date        = H.transaction_date . charted
  85         transaction_description = H.transaction_description . charted
  86         transaction_postings    = H.transaction_postings . charted
  87         transaction_tags        = H.transaction_tags . charted
  88
  89 -- Journal
  90 instance H.Journal_Transaction Transaction
  91 instance H.Journal_Transaction (Charted Transaction)
  92
  93 -- Stats
  94 instance H.Stats_Transaction Transaction where
  95         stats_transaction_postings_count = Map.size . transaction_postings
  96 instance H.Stats_Transaction (Charted Transaction) where
  97         stats_transaction_postings_count = H.stats_transaction_postings_count . charted
  98
  99 -- GL
 100 instance H.GL_Transaction  Transaction where
 101         type GL_Transaction_Line Transaction = Transaction
 102         gl_transaction_line = id
 103 instance H.GL_Transaction  (Charted Transaction) where
 104         type GL_Transaction_Line (Charted Transaction) = H.GL_Transaction_Line Transaction
 105         gl_transaction_line = H.gl_transaction_line . charted
 106
 107 -- | Return a 'Map' associating
 108 --   the given 'Transaction's with their respective 'Date'.
 109 transaction_by_date :: [Transaction] -> (Compose (Map H.Date) []) Transaction
 110 transaction_by_date =
 111         Compose .
 112         Map.fromListWith (flip mappend) .
 113         List.map (\t -> (fst $ transaction_dates t, [t]))
 114
 115 -- ** Type 'Wording'
 116
 117 type Wording = Text
 118
 119 -- ** Type 'Date'
 120
 121 type Date = H.Date
 122
 123 -- ** Type 'Code'
 124
 125 type Code = Text
 126
 127 -- ** Type 'Status'
 128 type Status = Bool