lib/Hcompta/Posting.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 {-# LANGUAGE UndecidableSuperClasses #-}
   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 import           Data.Proxy (Proxy(..))
  21
  22 import           Hcompta.Account
  23 import           Hcompta.Amount
  24 import           Hcompta.Anchor
  25 import           Hcompta.Tag
  26 import           Hcompta.Has
  27
  28 -- * Class 'Posting'
  29 class
  30  ( HasI Account p
  31  , HasI Amounts p
  32  ) => Posting p
  33
  34 _Posting :: Proxy Posting
  35 _Posting = Proxy
  36
  37 -- * Class 'Postings'
  38 class Posting (MT.Element ps) => Postings ps
  39 -- type instance Gather Postings ps = Posting
  40 -- type instance Gather Postings (Map acct ps) = Gather Postings ps
  41
  42 _Postings :: Proxy Postings
  43 _Postings = Proxy
  44
  45
  46 {-
  47 class Many Posting ps => Postings ps
  48
  49 instance Many Posting (Map acct ps) where
  50         type Many_Type Posting (Map acct ps) = Many_Type Posting ps
  51 instance Many Posting [p] where
  52         type Many_Type Posting [p] = p
  53 -}
  54
  55
  56
  57 {-
  58 class Posting (Postings_Posting ps) => Postings ps where
  59         type Postings_Posting ps
  60 instance
  61  Postings ps =>
  62  Postings (Map acct ps) where
  63         type Postings_Posting (Map acct ps) = Postings_Posting ps
  64
  65 -- * Class 'Posting'
  66 class
  67  ( Account (Posting_Account p)
  68  , Amounts (Posting_Amounts p)
  69  ) => Posting p where
  70         type Posting_Account p
  71         type Posting_Amounts p
  72         posting_account :: p -> Posting_Account p
  73         posting_amounts :: p -> Posting_Amounts p
  74 instance -- (acct, amts)
  75  ( Account acct
  76  , Amounts amts
  77  ) => Posting (acct, amts) where
  78         type Posting_Account (acct, amts) = acct
  79         type Posting_Amounts (acct, amts) = amts
  80         posting_account = fst
  81         posting_amounts = snd
  82
  83 -- * Class 'Postings'
  84 class Posting (Postings_Posting ps) => Postings ps where
  85         type Postings_Posting ps
  86 instance
  87  Posting p =>
  88  Postings [p] where
  89         type Postings_Posting [p] = p
  90 instance
  91  Postings ps =>
  92  Postings (Map acct ps) where
  93         type Postings_Posting (Map acct ps) = Postings_Posting ps
  94 -}
  95
  96 {-
  97 -- Type (account, Map unit quantity)
  98 instance -- Posting
  99  ( Account account
 100  , Amount (unit, quantity)
 101  -- , Amount (MT.Element amounts)
 102  -- , MT.MonoFoldable amounts
 103  ) => Posting (account, Map unit quantity) where
 104         type Posting_Account (account, Map unit quantity) = account
 105         type Posting_Amount  (account, Map unit quantity) = (unit, quantity) -- MT.Element amounts
 106         type Posting_Amounts (account, Map unit quantity) = Map unit quantity
 107         posting_account = fst
 108         posting_amounts = snd
 109
 110 -- * Type 'Posting_Anchor'
 111 newtype Posting_Anchor
 112  =      Posting_Anchor Anchor
 113  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 114 newtype Posting_Anchors
 115  =      Posting_Anchors Anchors
 116  deriving (Data, Eq, Monoid, NFData, Show, Typeable)
 117
 118 posting_anchor :: Anchor_Path -> Posting_Anchor
 119 posting_anchor = Posting_Anchor . anchor
 120
 121 -- | Return the given 'Posting_Anchors' with the given 'Posting_Anchor' incorporated.
 122 posting_anchor_cons :: Posting_Anchor -> Posting_Anchors -> Posting_Anchors
 123 posting_anchor_cons (Posting_Anchor t) (Posting_Anchors ts) =
 124         Posting_Anchors $ anchor_cons t ts
 125
 126 -- * Type 'Posting_Tag'
 127 newtype Posting_Tag
 128  =      Posting_Tag Tag
 129  deriving (Data, Eq, NFData, Ord, Show, Typeable)
 130 newtype Posting_Tags
 131  =      Posting_Tags Tags
 132  deriving (Data, Eq, Monoid, NFData, Show, Typeable)
 133
 134 posting_tag :: Tag_Path -> Tag_Value -> Posting_Tag
 135 posting_tag p v = Posting_Tag $ tag p v
 136
 137 -- | Return the given 'Posting_Tags' with the given 'Posting_Tag' incorporated.
 138 posting_tag_cons :: Posting_Tag -> Posting_Tags -> Posting_Tags
 139 posting_tag_cons (Posting_Tag t) (Posting_Tags ts) =
 140         Posting_Tags $ tag_cons t ts
 141 -}