]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Model/Transaction/Posting.hs
Correction : Format.Ledger.Read : posting_type davantage laxiste
[comptalang.git] / lib / Hcompta / Model / Transaction / Posting.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3 {-# OPTIONS_GHC -fno-warn-orphans #-}
4 module Hcompta.Model.Transaction.Posting where
5
6 import Data.Data
7 import qualified Data.Foldable
8 import qualified Data.List
9 import qualified Data.Map.Strict as Data.Map
10 import Data.Text (Text)
11 import Data.Typeable ()
12 import Text.Parsec.Pos (SourcePos, initialPos)
13
14 import qualified Hcompta.Model.Account as Account ()
15 import Hcompta.Model.Account (Account)
16 import qualified Hcompta.Model.Amount as Amount
17 import Hcompta.Model.Date (Date)
18 import qualified Hcompta.Model.Transaction.Tag as Tag
19
20 -- * The 'Posting' type
21
22 data Posting
23 = Posting
24 { account :: Account
25 , amounts :: Amount.By_Unit
26 , comments :: [Comment]
27 , dates :: [Date]
28 , sourcepos :: SourcePos
29 , status :: Bool
30 , tags :: Tag.By_Name
31 } deriving (Data, Eq, Read, Show, Typeable)
32
33 type Comment = Text
34
35 instance Read SourcePos where
36 readsPrec _ s = [(initialPos s, "")]
37
38 data Type
39 = Type_Regular
40 | Type_Virtual
41 | Type_Virtual_Balanced
42 deriving (Data, Eq, Read, Show, Typeable)
43
44 -- ** Convenient constructors
45
46 nil :: Account -> Posting
47 nil acct =
48 Posting
49 { account = acct
50 , amounts = Data.Map.empty
51 , comments = []
52 , dates = []
53 , status = False
54 , sourcepos = initialPos ""
55 , tags = Data.Map.empty
56 }
57
58 -- * The 'By_Account' mapping
59
60 type By_Account
61 = Data.Map.Map Account [Posting]
62
63 type By_Amount_and_Account
64 = Data.Map.Map Amount.By_Unit By_Account
65
66 type By_Signs_and_Account
67 = Data.Map.Map Amount.Signs By_Account
68
69 by_amount_and_account :: By_Account -> By_Amount_and_Account
70 by_amount_and_account =
71 Data.Map.foldlWithKey
72 (flip (\acct ->
73 Data.List.foldl
74 (flip (\p ->
75 Data.Map.insertWith
76 (Data.Map.unionWith (++))
77 (amounts p)
78 (Data.Map.singleton acct [p])))))
79 Data.Map.empty
80
81 by_signs_and_account :: By_Account -> By_Signs_and_Account
82 by_signs_and_account =
83 Data.Map.foldlWithKey
84 (flip (\acct ->
85 Data.List.foldl
86 (flip (\p ->
87 Data.Map.insertWith
88 (Data.Map.unionWith (++))
89 (Amount.signs $ amounts p)
90 (Data.Map.singleton acct [p])))))
91 Data.Map.empty
92
93 -- ** Convenient constructors
94
95 -- | Return a tuple associating the given 'Posting' with its 'Account'.
96 by_account :: Posting -> (Account, Posting)
97 by_account posting = (account posting, posting)
98
99 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
100 from_List :: [Posting] -> By_Account
101 from_List postings =
102 Data.Map.fromListWith (flip (++)) $
103 Data.List.map
104 (\posting -> (account posting, [posting]))
105 postings
106
107 -- * Collectors
108
109 -- | Return the 'Unit's in use within the given 'Posting's
110 units
111 :: Data.Foldable.Foldable m
112 => m [Posting]
113 -> [Amount.Unit]
114 units =
115 Data.Foldable.foldl
116 (\acc ->
117 Data.List.union acc .
118 Data.List.concatMap
119 (Data.Map.keys . amounts))
120 []