lib/Hcompta/Transaction.hs

   1 {-# LANGUAGE UndecidableSuperClasses #-}
   2 module Hcompta.Transaction where
   3
   4 import           Control.DeepSeq (NFData)
   5 import           Data.Data
   6 import           Data.Eq (Eq)
   7 import           Data.Function (($), (.), const)
   8 import           Data.Map.Strict (Map)
   9 import           Data.Monoid (Monoid(..))
  10 import qualified Data.MonoTraversable as MT
  11 import           Data.Ord (Ord)
  12 import           Data.Text (Text)
  13 import           Data.Typeable ()
  14 import           Text.Show (Show)
  15 import           Data.Tuple (fst, snd)
  16
  17 import           Hcompta.Date (Date)
  18 import           Hcompta.Lib.Consable (Consable(..))
  19 import           Hcompta.Posting
  20 import           Hcompta.Tag
  21 import           Hcompta.Has
  22
  23 -- * Class 'Transaction'
  24 class
  25  ( HasI Date t
  26  , HasI Postings t
  27  ) => Transaction t
  28
  29 -- * Class 'Transactions'
  30 class Transaction (MT.Element ts) => Transactions ts
  31
  32 {-
  33 -- * Class 'Transaction'
  34 class
  35  ( Date     (Transaction_Date t)
  36  , Postings (Transaction_Postings t)
  37  ) => Transaction t where
  38         type Transaction_Date     t
  39         type Transaction_Postings t
  40         type Transaction_Wording  t
  41         transaction_date     :: t -> Transaction_Date t
  42         transaction_postings :: t -> Transaction_Postings t
  43         transaction_wording  :: t -> Transaction_Wording t
  44         -- transaction_tags        :: t -> Transaction_Tags
  45
  46 instance
  47  ( Date date
  48  , Postings ps
  49  ) => Transaction (date, ps) where
  50         type Transaction_Date     (date, ps) = date
  51         type Transaction_Postings (date, ps) = ps
  52         type Transaction_Wording  (date, ps) = ()
  53         transaction_date     = fst
  54         transaction_postings = snd
  55         transaction_wording  = const ()
  56         -- transaction_tags        = const mempty
  57
  58 -- * Class 'Transactions'
  59 class Transaction (Transactions_Transaction ts) => Transactions ts where
  60         type Transactions_Transaction ts
  61 instance
  62  Transaction t =>
  63  Transactions [t] where
  64         type Transactions_Transaction [t] = t
  65 instance
  66  Transactions ts =>
  67  Transactions (Map date ts) where
  68         type Transactions_Transaction (Map date ts) = Transactions_Transaction ts
  69 -}
  70 {-
  71 -- ** Type 'Description'
  72
  73 type Description = Text
  74
  75 -- * Type 'Transaction_Anchor'
  76 newtype Transaction_Anchor
  77  =      Transaction_Anchor Anchor
  78  deriving (Data, Eq, NFData, Ord, Show, Typeable)
  79 newtype Transaction_Anchors
  80  =      Transaction_Anchors Anchors
  81  deriving (Data, Eq, NFData, Semigroup, Show, Typeable)
  82
  83 instance Consable Anchor Transaction_Anchors where
  84         mcons a (Transaction_Anchors anchors) =
  85                 Transaction_Anchors $ mcons a anchors
  86
  87 transaction_anchor :: Anchor_Path -> Transaction_Anchor
  88 transaction_anchor = Transaction_Anchor . anchor
  89
  90 -- | Return the given 'Transaction_Anchors'
  91 -- with the given 'Transaction_Anchor' incorporated.
  92 transaction_anchor_cons :: Transaction_Anchor -> Transaction_Anchors -> Transaction_Anchors
  93 transaction_anchor_cons (Transaction_Anchor t) (Transaction_Anchors ts) =
  94         Transaction_Anchors $ anchor_cons t ts
  95
  96 -- * Type 'Transaction_Tag'
  97
  98 newtype Transaction_Tag
  99  =      Transaction_Tag Tag
 100  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 101 newtype Transaction_Tags
 102  =      Transaction_Tags Tags
 103  deriving (Data, Eq, NFData, Semigroup, Show, Typeable)
 104
 105 instance Consable Tag Transaction_Tags where
 106         mcons t (Transaction_Tags tags) =
 107                 Transaction_Tags $ mcons t tags
 108
 109 transaction_tag :: Tag_Path -> Tag_Value -> Transaction_Tag
 110 transaction_tag p v = Transaction_Tag $ tag p v
 111
 112 -- | Return the given 'Transaction_Tags' with the given 'Transaction_Tag' incorporated.
 113 transaction_tag_cons :: Transaction_Tag -> Transaction_Tags -> Transaction_Tags
 114 transaction_tag_cons (Transaction_Tag t) (Transaction_Tags ts) =
 115         Transaction_Tags $ tag_cons t ts
 116 -}