1 {-# LANGUAGE UndecidableSuperClasses #-}
2 module Hcompta.Posting where
4 import Control.DeepSeq (NFData)
7 -- import Data.Foldable (Foldable(..))
8 import Data.Function (($), (.))
9 import Data.Map.Strict (Map)
10 import Data.Semigroup (Semigroup)
12 import Data.Tuple (fst, snd)
13 import Data.Typeable ()
14 import Text.Show (Show)
15 import qualified Data.MonoTraversable as MT
17 import Hcompta.Account
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
35 class Many Posting ps => Postings ps
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
46 class Posting (Postings_Posting ps) => Postings ps where
47 type Postings_Posting ps
50 Postings (Map acct ps) where
51 type Postings_Posting (Map acct ps) = Postings_Posting ps
55 ( Account (Posting_Account p)
56 , Amounts (Posting_Amounts p)
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)
65 ) => Posting (acct, amts) where
66 type Posting_Account (acct, amts) = acct
67 type Posting_Amounts (acct, amts) = amts
72 class Posting (Postings_Posting ps) => Postings ps where
73 type Postings_Posting ps
77 type Postings_Posting [p] = p
80 Postings (Map acct ps) where
81 type Postings_Posting (Map acct ps) = Postings_Posting ps
85 -- Type (account, Map unit quantity)
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
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)
106 posting_anchor :: Anchor_Path -> Posting_Anchor
107 posting_anchor = Posting_Anchor . anchor
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
114 -- * Type 'Posting_Tag'
117 deriving (Data, Eq, NFData, Ord, Show, Typeable)
120 deriving (Data, Eq, NFData, Semigroup, Show, Typeable)
122 posting_tag :: Tag_Path -> Tag_Value -> Posting_Tag
123 posting_tag p v = Posting_Tag $ tag p v
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