ledger/Hcompta/Format/Ledger/Transaction.hs

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