]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Format/Ledger.hs
Ajout : Model.Filter : Test_Tag.
[comptalang.git] / lib / Hcompta / Format / Ledger.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE NamedFieldPuns #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE TypeFamilies #-}
5 module Hcompta.Format.Ledger where
6
7 import Data.Data (Data(..))
8 import Data.Typeable (Typeable)
9 import Text.Parsec.Pos (SourcePos, initialPos)
10 import qualified Data.Map.Strict as Data.Map
11 import Data.Map.Strict (Map)
12 import qualified Data.List as Data.List
13 import qualified Data.Time.Clock as Time
14 import qualified Data.Time.Clock.POSIX as Time
15
16 import Hcompta.Lib.Parsec ()
17 import qualified Hcompta.Calc.Balance as Balance
18 import Hcompta.Model.Date (Date)
19 import qualified Hcompta.Model.Date as Date
20 import Hcompta.Model.Account (Account)
21 -- import qualified Hcompta.Model.Account as Account
22 import Hcompta.Model.Amount (Amount)
23 import qualified Hcompta.Model.Amount as Amount
24 import qualified Hcompta.Model.Filter as Model.Filter
25 import Data.Text (Text)
26
27 type Code = Text
28 type Description = Text
29 type Status = Bool
30 type Comment = Text
31
32 -- * The 'Journal' type
33
34 data Journal
35 = Journal
36 { journal_file :: FilePath
37 , journal_includes :: [Journal]
38 , journal_last_read_time :: Time.UTCTime
39 , journal_transactions :: Transaction_by_Date
40 , journal_unit_styles :: Data.Map.Map Amount.Unit Amount.Style
41 } deriving (Data, Eq, Show, Typeable)
42
43 journal :: Journal
44 journal =
45 Journal
46 { journal_file = ""
47 , journal_includes = []
48 , journal_last_read_time = Time.posixSecondsToUTCTime 0
49 , journal_transactions = Data.Map.empty
50 , journal_unit_styles = Data.Map.empty
51 }
52
53 -- * The 'Transaction' type
54
55 data Transaction
56 = Transaction
57 { transaction_code :: Code
58 , transaction_comments_before :: [Comment]
59 , transaction_comments_after :: [Comment]
60 , transaction_dates :: (Date, [Date])
61 , transaction_description :: Description
62 , transaction_postings :: Posting_by_Account
63 , transaction_virtual_postings :: Posting_by_Account
64 , transaction_balanced_virtual_postings :: Posting_by_Account
65 , transaction_sourcepos :: SourcePos
66 , transaction_status :: Status
67 , transaction_tags :: Tag_by_Name
68 } deriving (Data, Eq, Show, Typeable)
69
70 transaction :: Transaction
71 transaction =
72 Transaction
73 { transaction_code = ""
74 , transaction_comments_before = []
75 , transaction_comments_after = []
76 , transaction_dates = (Date.nil, [])
77 , transaction_description = ""
78 , transaction_postings = Data.Map.empty
79 , transaction_virtual_postings = Data.Map.empty
80 , transaction_balanced_virtual_postings = Data.Map.empty
81 , transaction_sourcepos = initialPos ""
82 , transaction_status = False
83 , transaction_tags = Data.Map.empty
84 }
85
86 instance Model.Filter.Transaction Transaction where
87 type Transaction_Posting Transaction = Posting
88 transaction_date = fst . transaction_dates
89 transaction_description = transaction_description
90 transaction_postings = transaction_postings
91 transaction_tags = transaction_tags
92
93 type Transaction_by_Date
94 = Data.Map.Map Date [Transaction]
95
96 -- | Return a 'Data.Map.Map' associating
97 -- the given 'Transaction's with their respective 'Date'.
98 transaction_by_Date :: [Transaction] -> Transaction_by_Date
99 transaction_by_Date =
100 Data.Map.fromListWith (flip (++)) .
101 Data.List.map (\t -> (fst $ transaction_dates t, [t]))
102
103 -- * The 'Posting' type
104
105 data Posting
106 = Posting
107 { posting_account :: Account
108 , posting_amounts :: Map Amount.Unit Amount
109 , posting_comments :: [Comment]
110 , posting_dates :: [Date]
111 , posting_sourcepos :: SourcePos
112 , posting_status :: Bool
113 , posting_tags :: Tag_by_Name
114 } deriving (Data, Eq, Show, Typeable)
115
116 data Posting_Type
117 = Posting_Type_Regular
118 | Posting_Type_Virtual
119 | Posting_Type_Virtual_Balanced
120 deriving (Data, Eq, Read, Show, Typeable)
121
122 posting :: Account -> Posting
123 posting acct =
124 Posting
125 { posting_account = acct
126 , posting_amounts = Data.Map.empty
127 , posting_comments = []
128 , posting_dates = []
129 , posting_status = False
130 , posting_sourcepos = initialPos ""
131 , posting_tags = Data.Map.empty
132 }
133
134 instance
135 Balance.Posting Posting where
136 type Posting_Amount Posting = Balance.Amount_Sum Amount
137 posting_account = posting_account
138 posting_amounts = Data.Map.map Balance.amount_sum . posting_amounts
139 posting_set_amounts amounts p =
140 p { posting_amounts=Data.Map.map Balance.amount_sum_balance amounts }
141
142 instance Model.Filter.Posting Posting where
143 type Posting_Amount Posting = Amount
144 posting_account = posting_account
145 posting_amounts = posting_amounts
146
147 -- ** The 'Posting' mappings
148
149 type Posting_by_Account
150 = Data.Map.Map Account [Posting]
151
152 type Posting_by_Amount_and_Account
153 = Data.Map.Map Amount.By_Unit Posting_by_Account
154
155 type Posting_by_Signs_and_Account
156 = Data.Map.Map Amount.Signs Posting_by_Account
157
158 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
159 posting_by_Account :: [Posting] -> Posting_by_Account
160 posting_by_Account =
161 Data.Map.fromListWith (flip (++)) .
162 Data.List.map
163 (\p -> (posting_account p, [p]))
164
165 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
166 posting_by_Amount_and_Account =
167 Data.Map.foldlWithKey
168 (flip (\acct ->
169 Data.List.foldl
170 (flip (\p ->
171 Data.Map.insertWith
172 (Data.Map.unionWith (++))
173 (posting_amounts p)
174 (Data.Map.singleton acct [p])))))
175 Data.Map.empty
176
177 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
178 posting_by_Signs_and_Account =
179 Data.Map.foldlWithKey
180 (flip (\acct ->
181 Data.List.foldl
182 (flip (\p ->
183 Data.Map.insertWith
184 (Data.Map.unionWith (++))
185 (Amount.signs $ posting_amounts p)
186 (Data.Map.singleton acct [p])))))
187 Data.Map.empty
188
189 -- * The 'Tag' type
190
191 type Tag = (Tag_Name, Tag_Value)
192 type Tag_Name = Text
193 type Tag_Value = Text
194
195 type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
196
197 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
198 tag_by_Name :: [Tag] -> Tag_by_Name
199 tag_by_Name =
200 Data.Map.fromListWith (flip (++)) .
201 Data.List.map (\(n, v) -> (n, [v]))