lib/Hcompta/Posting.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   5 {-# LANGUAGE TypeFamilies #-}
   6 module Hcompta.Posting where
   7
   8 import           Control.DeepSeq (NFData)
   9 import           Data.Data
  10 import           Data.Eq (Eq)
  11 -- import           Data.Foldable (Foldable(..))
  12 import           Data.Function (($), (.))
  13 import           Data.Map.Strict (Map)
  14 import           Data.Monoid (Monoid)
  15 import           Data.Ord (Ord)
  16 import           Data.Tuple (fst, snd)
  17 import           Data.Typeable ()
  18 import           Text.Show (Show)
  19 import qualified Data.MonoTraversable as MT
  20
  21 import           Hcompta.Account
  22 import           Hcompta.Amount
  23 import           Hcompta.Anchor
  24 import           Hcompta.Tag
  25
  26 -- * Class 'Posting'
  27
  28 class
  29  ( Account (Posting_Account p)
  30  , Amount  (Posting_Amount  p)
  31  , MT.MonoFoldable (Posting_Amounts p)
  32  ) => Posting p where
  33         type Posting_Account p
  34         type Posting_Amount  p
  35         type Posting_Amounts p
  36         posting_account :: p -> Posting_Account p
  37         posting_amounts :: p -> Posting_Amounts p
  38
  39 -- Type (account, Map unit quantity)
  40 instance -- Posting
  41  ( Account account
  42  , Amount (unit, quantity)
  43  -- , Amount (MT.Element amounts)
  44  -- , MT.MonoFoldable amounts
  45  ) => Posting (account, Map unit quantity) where
  46         type Posting_Account (account, Map unit quantity) = account
  47         type Posting_Amount  (account, Map unit quantity) = (unit, quantity) -- MT.Element amounts
  48         type Posting_Amounts (account, Map unit quantity) = Map unit quantity
  49         posting_account = fst
  50         posting_amounts = snd
  51
  52 -- * Type 'Posting_Anchor'
  53
  54 newtype Posting_Anchor
  55  =      Posting_Anchor Anchor
  56  deriving (Data, Eq, NFData, Ord, Show, Typeable)
  57 newtype Posting_Anchors
  58  =      Posting_Anchors Anchors
  59  deriving (Data, Eq, Monoid, NFData, Show, Typeable)
  60
  61 posting_anchor :: Anchor_Path -> Posting_Anchor
  62 posting_anchor = Posting_Anchor . anchor
  63
  64 -- | Return the given 'Posting_Anchors' with the given 'Posting_Anchor' incorporated.
  65 posting_anchor_cons :: Posting_Anchor -> Posting_Anchors -> Posting_Anchors
  66 posting_anchor_cons (Posting_Anchor t) (Posting_Anchors ts) =
  67         Posting_Anchors $ anchor_cons t ts
  68
  69 -- * Type 'Posting_Tag'
  70
  71 newtype Posting_Tag
  72  =      Posting_Tag Tag
  73  deriving (Data, Eq, NFData, Ord, Show, Typeable)
  74 newtype Posting_Tags
  75  =      Posting_Tags Tags
  76  deriving (Data, Eq, Monoid, NFData, Show, Typeable)
  77
  78 posting_tag :: Tag_Path -> Tag_Value -> Posting_Tag
  79 posting_tag p v = Posting_Tag $ tag p v
  80
  81 -- | Return the given 'Posting_Tags' with the given 'Posting_Tag' incorporated.
  82 posting_tag_cons :: Posting_Tag -> Posting_Tags -> Posting_Tags
  83 posting_tag_cons (Posting_Tag t) (Posting_Tags ts) =
  84         Posting_Tags $ tag_cons t ts