lib/Hcompta/Transaction.hs

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