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 module Hcompta.Transaction where
  12
  13 import           Control.DeepSeq (NFData)
  14 import           Data.Data
  15 import           Data.Eq (Eq)
  16 import           Data.Monoid (Monoid)
  17 import           Data.Ord (Ord)
  18 import           Data.Text (Text)
  19 import           Data.Typeable ()
  20 import           Prelude (($), (.))
  21 import           Text.Show (Show)
  22
  23 import           Hcompta.Anchor (Anchor, Anchors)
  24 import qualified Hcompta.Anchor as Anchor
  25 import           Hcompta.Date (Date)
  26 import           Hcompta.Lib.Consable (Consable(..))
  27 import           Hcompta.Posting (Posting)
  28 import           Hcompta.Tag (Tag, Tags(..))
  29 import qualified Hcompta.Tag as Tag
  30
  31 -- * Class 'Transaction'
  32
  33 class
  34  ( Posting (Transaction_Posting t)
  35  ) => Transaction t where
  36         type Transaction_Posting t
  37         transaction_date        :: t -> Date
  38         transaction_description :: t -> Description
  39         transaction_postings    :: t -> [Transaction_Posting t]
  40
  41 type Description = Text
  42
  43 -- * Type 'Transaction_Anchor'
  44 newtype Transaction_Anchor
  45  =      Transaction_Anchor Anchor
  46  deriving (Data, Eq, NFData, Ord, Show, Typeable)
  47 newtype Transaction_Anchors
  48  =      Transaction_Anchors Anchors
  49  deriving (Data, Eq, Monoid, NFData, Show, Typeable)
  50
  51 instance Consable Anchor Transaction_Anchors where
  52         mcons a (Transaction_Anchors anchors) =
  53                 Transaction_Anchors $ mcons a anchors
  54
  55 anchor :: Anchor.Path -> Transaction_Anchor
  56 anchor = Transaction_Anchor . Anchor.anchor
  57
  58 -- | Return the given 'Transaction_Anchors' with the given 'Transaction_Anchor' incorporated.
  59 anchor_cons :: Transaction_Anchor -> Transaction_Anchors -> Transaction_Anchors
  60 anchor_cons (Transaction_Anchor t) (Transaction_Anchors ts) =
  61         Transaction_Anchors $ Anchor.cons t ts
  62
  63 -- * Type 'Transaction_Tag'
  64 newtype Transaction_Tag
  65  =      Transaction_Tag Tag
  66  deriving (Data, Eq, NFData, Ord, Show, Typeable)
  67 newtype Transaction_Tags
  68  =      Transaction_Tags Tags
  69  deriving (Data, Eq, Monoid, NFData, Show, Typeable)
  70
  71 instance Consable Tag Transaction_Tags where
  72         mcons t (Transaction_Tags tags) =
  73                 Transaction_Tags $ mcons t tags
  74
  75 tag :: Tag.Path -> Tag.Value -> Transaction_Tag
  76 tag p v = Transaction_Tag $ Tag.tag p v
  77
  78 -- | Return the given 'Transaction_Tags' with the given 'Transaction_Tag' incorporated.
  79 tag_cons :: Transaction_Tag -> Transaction_Tags -> Transaction_Tags
  80 tag_cons (Transaction_Tag t) (Transaction_Tags ts) =
  81         Transaction_Tags $ Tag.cons t ts