]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Posting.hs
Fix balance tests to use new TreeMap.
[comptalang.git] / 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 -}