lcc/Hcompta/LCC/Transaction.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   4 {-# LANGUAGE MultiParamTypeClasses #-}
   5 {-# LANGUAGE OverloadedStrings #-}
   6 {-# LANGUAGE NamedFieldPuns #-}
   7 {-# LANGUAGE RecordWildCards #-}
   8 {-# LANGUAGE TypeFamilies #-}
   9 module Hcompta.LCC.Transaction where
  10
  11 import Control.DeepSeq (NFData(..))
  12 import Data.Data (Data(..))
  13 import Data.Eq (Eq(..))
  14 import Data.Function (($), (.))
  15 import Data.Functor.Compose (Compose(..))
  16 import Data.Map.Strict (Map)
  17 import Data.Monoid (Monoid(..))
  18 import Data.NonNull (NonNull)
  19 import Data.Ord (Ord(..))
  20 import Data.String (IsString)
  21 import Data.Text (Text)
  22 import Data.Typeable (Typeable)
  23 import Prelude (flip, seq)
  24 import Text.Show (Show)
  25 import qualified Data.List as List
  26 import qualified Data.Map.Strict as Map
  27 import qualified Data.MonoTraversable as MT
  28 import qualified Data.NonNull as NonNull
  29
  30 import qualified Hcompta as H
  31
  32 import Hcompta.LCC.Account
  33 import Hcompta.LCC.Tag
  34 import Hcompta.LCC.Posting
  35 -- import Hcompta.LCC.Chart
  36
  37 -- * Type 'Transaction'
  38 data Transaction
  39  =   Transaction
  40  {   transaction_comments  :: [Comment]
  41  ,   transaction_dates     :: NonNull [Date]
  42  ,   transaction_postings  :: Postings
  43  ,   transaction_sourcepos :: SourcePos
  44  ,   transaction_tags      :: Transaction_Tags
  45  ,   transaction_wording   :: Wording
  46  } deriving (Data, Eq, Ord, Show, Typeable)
  47 transaction_date :: Transaction -> Date
  48 transaction_date = NonNull.head . transaction_dates
  49 -- instance H.Transaction Transaction
  50 instance NFData Transaction where
  51         rnf Transaction{..} =
  52                 rnf transaction_comments `seq`
  53                 rnf transaction_dates `seq`
  54                 rnf transaction_postings `seq`
  55                 -- rnf transaction_sourcepos `seq`
  56                 rnf transaction_tags `seq`
  57                 rnf transaction_wording
  58 type instance MT.Element Transaction = Posting
  59 instance MT.MonoFunctor Transaction where
  60         omap f t = t{transaction_postings = f `MT.omap` transaction_postings t}
  61 instance MT.MonoFoldable Transaction where
  62         ofoldMap f   = MT.ofoldMap f   . transaction_postings
  63         ofoldr f a   = MT.ofoldr f a   . transaction_postings
  64         ofoldl' f a  = MT.ofoldl' f a  . transaction_postings
  65         ofoldr1Ex f  = MT.ofoldr1Ex f  . transaction_postings
  66         ofoldl1Ex' f = MT.ofoldl1Ex' f . transaction_postings
  67
  68 -- type instance H.Postings H.:@ Transaction = Postings
  69 instance H.Get Postings Transaction where
  70         get = transaction_postings
  71
  72 {-
  73 type instance H.Date H.:@ Transaction = Date
  74 instance H.GetI H.Date Transaction where
  75         getI = NonNull.head . transaction_dates
  76 instance H.SetI H.Date Transaction where
  77         setI d t = t{transaction_dates =
  78                 NonNull.ncons d $ NonNull.tail $ transaction_dates t}
  79
  80 type instance H.Postings H.:@ Transaction = Postings
  81 instance H.GetI H.Postings Transaction where
  82         getI = transaction_postings
  83 instance H.SetI H.Postings Transaction where
  84         setI transaction_postings t = t{transaction_postings}
  85 -}
  86
  87 transaction :: Transaction
  88 transaction =
  89         Transaction
  90          { transaction_comments  = []
  91          , transaction_dates     = NonNull.ncons H.epoch []
  92          , transaction_postings  = mempty
  93          , transaction_sourcepos = initialPos ""
  94          , transaction_tags      = mempty
  95          , transaction_wording   = ""
  96          }
  97
  98 {-
  99 -- ** Type 'Transaction_Anchor'
 100 newtype Transaction_Anchor = Transaction_Anchor Anchor
 101  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 102 -- ** Type 'Transaction_Anchors'
 103 newtype Transaction_Anchors = Transaction_Anchors Anchors
 104  deriving (Data, Eq, Monoid, NFData, Ord, Show, Typeable)
 105 type instance MT.Element Transaction_Anchors = Transaction_Anchor
 106 -}
 107
 108 -- ** Type 'Transaction_Tag'
 109 newtype Transaction_Tag = Transaction_Tag Tag
 110  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 111 -- ** Type 'Transaction_Tags'
 112 newtype Transaction_Tags = Transaction_Tags Tags
 113  deriving (Data, Eq, Monoid, NFData, Ord, Show, Typeable)
 114 type instance MT.Element Transaction_Tags = Transaction_Tag
 115
 116 -- ** Type 'Transactions'
 117 newtype Transactions = Transactions (Map Account [Transaction])
 118  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 119
 120 type instance MT.Element Transactions = Transaction
 121 -- instance H.Transactions Transactions
 122
 123 -- ** Type 'Wording'
 124 newtype Wording = Wording Text
 125  deriving (Data, Eq, IsString, NFData, Ord, Show, Typeable)
 126
 127
 128
 129
 130
 131
 132
 133 {-
 134
 135 -- Transaction
 136 instance H.Transaction      Transaction where
 137         type Transaction_Posting  Transaction = Posting
 138         type Transaction_Postings Transaction = Compose (Map Account) [] Posting
 139         transaction_date        = fst . transaction_dates
 140         transaction_description = transaction_wording
 141         transaction_postings    = Compose . transaction_postings
 142         transaction_tags        = transaction_tags
 143 instance H.Transaction      (Charted Transaction) where
 144         type Transaction_Posting  (Charted Transaction) = H.Transaction_Posting  Transaction
 145         type Transaction_Postings (Charted Transaction) = H.Transaction_Postings Transaction
 146         transaction_date        = H.transaction_date . charted
 147         transaction_description = H.transaction_description . charted
 148         transaction_postings    = H.transaction_postings . charted
 149         transaction_tags        = H.transaction_tags . charted
 150
 151 -- Journal
 152 instance H.Journal_Transaction Transaction
 153 instance H.Journal_Transaction (Charted Transaction)
 154
 155 -- Stats
 156 instance H.Stats_Transaction Transaction where
 157         stats_transaction_postings_count = Map.size . transaction_postings
 158 instance H.Stats_Transaction (Charted Transaction) where
 159         stats_transaction_postings_count = H.stats_transaction_postings_count . charted
 160
 161 -- GL
 162 instance H.GL_Transaction  Transaction where
 163         type GL_Transaction_Line Transaction = Transaction
 164         gl_transaction_line = id
 165         {-
 166         gl_transaction_postings_filter f t =
 167                 t{ transaction_postings =
 168                         Map.mapMaybe
 169                          (\post -> case List.filter f post of
 170                                  [] -> Nothing
 171                                  posts -> Just posts)
 172                          (transaction_postings t)
 173                  }
 174         -}
 175 instance H.GL_Transaction  (Charted Transaction) where
 176         type GL_Transaction_Line (Charted Transaction) = H.GL_Transaction_Line Transaction
 177         gl_transaction_line = H.gl_transaction_line . charted
 178         {-
 179         gl_transaction_postings_filter f (Charted c t) =
 180                 Charted c
 181                  t{ transaction_postings =
 182                         Map.mapMaybe
 183                          (\post -> case List.filter f $ ({-Charted c <$>-} post) of
 184                                  [] -> Nothing
 185                                  posts -> Just $ {-charted <$>-} posts)
 186                          (transaction_postings t)
 187                  }
 188         -}
 189
 190 {-
 191 instance Filter.Transaction (Charted Transaction) where
 192         type Transaction_Posting  (Charted Transaction) = Charted Posting
 193         type Transaction_Postings (Charted Transaction) = Compose (Map Account) []
 194         transaction_date = fst . transaction_dates . Chart.charted
 195         transaction_wording = transaction_wording . Chart.charted
 196         transaction_postings (Chart.Charted c t)  =
 197                 fmap (Chart.Charted c) $
 198                 Compose $ transaction_postings t
 199         {-
 200         transaction_postings_virtual (Chart.Charted c t) =
 201                 fmap (Chart.Charted c) $
 202                 Compose
 203                  [ Compose $ transaction_virtual_postings t
 204                  , Compose $ transaction_balanced_virtual_postings t
 205                  ]
 206         -}
 207         transaction_tags = transaction_tags . Chart.charted
 208 -}
 209 -}
 210 -- | Return a 'Map' associating
 211 --   the given 'Transaction's with their respective 'Date'.
 212 transaction_by_date :: [Transaction] -> (Compose (Map Date) []) Transaction
 213 transaction_by_date =
 214         Compose .
 215         Map.fromListWith (flip mappend) .
 216         List.map (\t -> (NonNull.head $ transaction_dates t, [t]))