lib/Hcompta/Posting.hs

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