]> Git — Sourcephile - comptalang.git/blob - ledger/Hcompta/Ledger/Read/Test.hs
Remove cli/
[comptalang.git] / ledger / Hcompta / Ledger / Read / Test.hs
1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
3
4 module Read.Test where
5
6 import Control.Applicative (Applicative(..), (<*))
7 import Control.Arrow (right)
8 import Control.Monad.IO.Class (MonadIO(..))
9 import Data.Bool
10 import Data.Data ()
11 import Data.Decimal (DecimalRaw(..))
12 import Data.Either (rights)
13 import Data.Function (($), (.), id, const)
14 import Data.Functor ((<$>))
15 import Data.List.NonEmpty (NonEmpty(..))
16 import qualified Data.Map.Strict as Map
17 import Data.Maybe (Maybe(..), fromMaybe)
18 import Data.Monoid (Monoid(..), (<>))
19 import Data.Text (Text)
20 import qualified Data.Text as Text
21 import qualified Data.Time.Calendar as Time
22 import qualified Data.Time.LocalTime as Time
23 import Test.Tasty
24 import Test.Tasty.HUnit
25 import qualified Text.Parsec as R hiding
26 ( char
27 , anyChar
28 , crlf
29 , newline
30 , noneOf
31 , oneOf
32 , satisfy
33 , space
34 , spaces
35 , string
36 , tab
37 )
38 import qualified Text.Parsec.Combinator.CorrectSourcePosWithTab as R
39 import qualified Text.Parsec.Error.Custom as R
40 import qualified Text.Parsec.Pos as R
41
42 import qualified Hcompta as H
43 import qualified Hcompta.Ledger as Ledger
44
45 tests :: TestTree
46 tests = testGroup "Read"
47 [ testGroup "read_date" $
48 (let (==>) (txt::Text) =
49 testCase (Text.unpack txt) .
50 (@?=) (rights [R.runParserWithError
51 (Ledger.read_date id Nothing <* R.eof) () "" txt]) in
52 [ "2000-01-01" ==>
53 [ Time.zonedTimeToUTC $
54 Time.ZonedTime
55 (Time.LocalTime
56 (Time.fromGregorian 2000 01 01)
57 (Time.TimeOfDay 0 0 0))
58 Time.utc ]
59 , "2000/01/01" ==> []
60 , "2000-01-01_12:34" ==>
61 [ Time.zonedTimeToUTC $
62 Time.ZonedTime
63 (Time.LocalTime
64 (Time.fromGregorian 2000 01 01)
65 (Time.TimeOfDay 12 34 0))
66 Time.utc ]
67 , "2000-01-01_12:34:56" ==>
68 [ Time.zonedTimeToUTC $
69 Time.ZonedTime
70 (Time.LocalTime
71 (Time.fromGregorian 2000 01 01)
72 (Time.TimeOfDay 12 34 56))
73 Time.utc ]
74 , "2000-01-01_12:34_CET" ==>
75 [ Time.zonedTimeToUTC $
76 Time.ZonedTime
77 (Time.LocalTime
78 (Time.fromGregorian 2000 01 01)
79 (Time.TimeOfDay 12 34 0))
80 (Time.TimeZone 60 True "CET") ]
81 , "2000-01-01_12:34+01:30" ==>
82 [ Time.zonedTimeToUTC $
83 Time.ZonedTime
84 (Time.LocalTime
85 (Time.fromGregorian 2000 01 01)
86 (Time.TimeOfDay 12 34 0))
87 (Time.TimeZone 90 False "+01:30") ]
88 , "2000-01-01_12:34:56_CET" ==>
89 [ Time.zonedTimeToUTC $
90 Time.ZonedTime
91 (Time.LocalTime
92 (Time.fromGregorian 2000 01 01)
93 (Time.TimeOfDay 12 34 56))
94 (Time.TimeZone 60 True "CET") ]
95 , "2001-02-29" ==> []
96 ]) <>
97 (let (==>) (txt::Text, def) =
98 testCase (Text.unpack txt) .
99 (@?=) (rights [R.runParserWithError
100 (Ledger.read_date id (Just def) <* R.eof) () "" txt]) in
101 [ ("01-01", 2000) ==>
102 [ Time.zonedTimeToUTC $
103 Time.ZonedTime
104 (Time.LocalTime
105 (Time.fromGregorian 2000 01 01)
106 (Time.TimeOfDay 0 0 0))
107 Time.utc]
108 ])
109 , testGroup "read_account_section" $
110 let (==>) (txt::Text) b =
111 testCase (Text.unpack txt) $
112 (@?=) (rights [R.runParser
113 (Ledger.read_account_section <* R.eof) () "" txt])
114 [txt | b] in
115 [ "" ==> False
116 , "A" ==> True
117 , "AA" ==> True
118 , " " ==> False
119 , ":" ==> False
120 , "A:" ==> False
121 , ":A" ==> False
122 , "A " ==> False
123 , "A A" ==> True
124 , "A " ==> False
125 , "A\t" ==> False
126 , "A \n" ==> False
127 , "(A)A" ==> True
128 , "( )A" ==> True
129 , "(A) A" ==> True
130 , "[ ] A" ==> True
131 , "(A) " ==> False
132 , "(A)" ==> True
133 , "A(A)" ==> True
134 , "[A]A" ==> True
135 , "[A] A" ==> True
136 , "[A] " ==> False
137 , "[A]" ==> True
138 , testCase "\"A \"" $
139 rights [R.runParser
140 Ledger.read_account_section
141 () "" ("A "::Text)]
142 @?=
143 ["A"]
144 ]
145 , testGroup "read_account" $
146 let (==>) (txt::Text) =
147 testCase (Text.unpack txt) .
148 (@?=) (rights [R.runParser
149 (Ledger.read_account <* R.eof) () "" txt]) in
150 [ "" ==> []
151 , "A" ==> [ "A":|[] ]
152 , "A:" ==> []
153 , ":A" ==> []
154 , "A " ==> []
155 , " A" ==> []
156 , "A:B" ==> [ "A":|["B"] ]
157 , "A:B:C" ==> [ "A":|["B","C"] ]
158 , "Aa:Bbb:Cccc" ==> [ "Aa":|["Bbb", "Cccc"] ]
159 , "A a : B b b : C c c c" ==> [ "A a ":|[" B b b ", " C c c c"] ]
160 , "A: :C" ==> [ "A":|[" ", "C"] ]
161 , "A::C" ==> []
162 , "A:B:(C)" ==> [ "A":|["B", "(C)"] ]
163 ]
164 , testGroup "read_amount" $
165 let (==>) (txt::Text) =
166 testCase (Text.unpack txt) .
167 (@?=) (rights [R.runParser
168 (Ledger.read_amount <* R.eof) () "" txt]) in
169 [ "" ==> []
170 , "0" ==>
171 [( mempty
172 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
173 , "00" ==>
174 [( mempty
175 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
176 , "0." ==>
177 [( mempty { Ledger.amount_style_fractioning = Just '.' }
178 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
179 , ".0" ==>
180 [( mempty { Ledger.amount_style_fractioning = Just '.' }
181 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
182 , "0," ==>
183 [( mempty { Ledger.amount_style_fractioning = Just ',' }
184 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
185 , ",0" ==>
186 [( mempty { Ledger.amount_style_fractioning = Just ',' }
187 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
188 , "0_" ==> []
189 , "_0" ==> []
190 , "0.0" ==>
191 [( mempty { Ledger.amount_style_fractioning = Just '.' }
192 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
193 , "00.00" ==>
194 [( mempty { Ledger.amount_style_fractioning = Just '.' }
195 , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
196 , "0,0" ==>
197 [( mempty { Ledger.amount_style_fractioning = Just ',' }
198 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
199 , "00,00" ==>
200 [( mempty { Ledger.amount_style_fractioning = Just ',' }
201 , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
202 , "0_0" ==>
203 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
204 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
205 , "00_00" ==>
206 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
207 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
208 , "0,000.00" ==>
209 [( mempty
210 { Ledger.amount_style_fractioning = Just '.'
211 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3] }
212 , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
213 , "0.000,00" ==>
214 [( mempty
215 { Ledger.amount_style_fractioning = Just ','
216 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3] }
217 , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
218 , "1,000.00" ==>
219 [( mempty
220 { Ledger.amount_style_fractioning = Just '.'
221 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3] }
222 , Ledger.amount { Ledger.amount_quantity = Decimal 2 100000 } )]
223 , "1.000,00" ==>
224 [( mempty
225 { Ledger.amount_style_fractioning = Just ','
226 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3] }
227 , Ledger.amount { Ledger.amount_quantity = Decimal 2 100000 } )]
228 , "1,000.00." ==> []
229 , "1.000,00," ==> []
230 , "1,000.00_" ==> []
231 , "123" ==>
232 [( mempty
233 , Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
234 , "1.2" ==>
235 [( mempty { Ledger.amount_style_fractioning = Just '.' }
236 , Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
237 , "1,2" ==>
238 [( mempty { Ledger.amount_style_fractioning = Just ',' }
239 , Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
240 , "12.34" ==>
241 [( mempty { Ledger.amount_style_fractioning = Just '.' }
242 , Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
243 , "12,34" ==>
244 [( mempty { Ledger.amount_style_fractioning = Just ',' }
245 , Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
246 , "1_2" ==>
247 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
248 , Ledger.amount { Ledger.amount_quantity = Decimal 0 12 } )]
249 , "1_23" ==>
250 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
251 , Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
252 , "1_23_456" ==>
253 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [3, 2] }
254 , Ledger.amount { Ledger.amount_quantity = Decimal 0 123456 } )]
255 , "1_23_456,7890_12345_678901" ==>
256 [( mempty
257 { Ledger.amount_style_fractioning = Just ','
258 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [3, 2]
259 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
260 , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
261 , "1_23_456.7890_12345_678901" ==>
262 [( mempty
263 { Ledger.amount_style_fractioning = Just '.'
264 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [3, 2]
265 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
266 , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
267 , "1,23,456.7890_12345_678901" ==>
268 [( mempty
269 { Ledger.amount_style_fractioning = Just '.'
270 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3, 2]
271 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
272 , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
273 , "1.23.456,7890_12345_678901" ==>
274 [( mempty
275 { Ledger.amount_style_fractioning = Just ','
276 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3, 2]
277 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
278 , Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
279 , "123456_78901_2345.678_90_1" ==>
280 [( mempty
281 { Ledger.amount_style_fractioning = Just '.'
282 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6]
283 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [3, 2] }
284 , Ledger.amount { Ledger.amount_quantity = Decimal 6 123456789012345678901 } )]
285 , "$1" ==>
286 [( mempty
287 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
288 , Ledger.amount_style_unit_spaced = Just False }
289 , Ledger.amount
290 { Ledger.amount_quantity = Decimal 0 1
291 , Ledger.amount_unit = "$" } )]
292 , "1$" ==>
293 [( mempty
294 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Right
295 , Ledger.amount_style_unit_spaced = Just False }
296 , Ledger.amount
297 { Ledger.amount_quantity = Decimal 0 1
298 , Ledger.amount_unit = "$" } )]
299 , "$ 1" ==>
300 [( mempty
301 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
302 , Ledger.amount_style_unit_spaced = Just True }
303 , Ledger.amount
304 { Ledger.amount_quantity = Decimal 0 1
305 , Ledger.amount_unit = "$" } )]
306 , "1 $" ==>
307 [( mempty
308 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Right
309 , Ledger.amount_style_unit_spaced = Just True }
310 , Ledger.amount
311 { Ledger.amount_quantity = Decimal 0 1
312 , Ledger.amount_unit = "$" } )]
313 , "-$1" ==>
314 [( mempty
315 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
316 , Ledger.amount_style_unit_spaced = Just False }
317 , Ledger.amount
318 { Ledger.amount_quantity = Decimal 0 (-1)
319 , Ledger.amount_unit = "$" } )]
320 , "\"4 2\"1" ==>
321 [( mempty
322 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
323 , Ledger.amount_style_unit_spaced = Just False }
324 , Ledger.amount
325 { Ledger.amount_quantity = Decimal 0 1
326 , Ledger.amount_unit = "4 2" } )]
327 , "1\"4 2\"" ==>
328 [( mempty
329 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Right
330 , Ledger.amount_style_unit_spaced = Just False }
331 , Ledger.amount
332 { Ledger.amount_quantity = Decimal 0 1
333 , Ledger.amount_unit = "4 2" } )]
334 , "$1.000,00" ==>
335 [( mempty
336 { Ledger.amount_style_fractioning = Just ','
337 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3]
338 , Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
339 , Ledger.amount_style_unit_spaced = Just False }
340 , Ledger.amount
341 { Ledger.amount_quantity = Decimal 2 100000
342 , Ledger.amount_unit = "$" } )]
343 , "1.000,00$" ==>
344 [( mempty
345 { Ledger.amount_style_fractioning = Just ','
346 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3]
347 , Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Right
348 , Ledger.amount_style_unit_spaced = Just False }
349 , Ledger.amount
350 { Ledger.amount_quantity = Decimal 2 100000
351 , Ledger.amount_unit = "$" } )]
352 ]
353 , testGroup "read_posting_type" $
354 let (==>) a (ty, ac) =
355 let read (t::Text) = rights [R.runParser
356 (Ledger.read_account <* R.eof) () "" t] in
357 testCase (Text.unpack a) $
358 (@?=)
359 (Ledger.read_posting_type <$> read a)
360 (Ledger.Posting_Typed ty <$> read (fromMaybe a ac)) in
361 [ "A" ==> (Ledger.Posting_Type_Regular, Nothing)
362 , "(" ==> (Ledger.Posting_Type_Regular, Nothing)
363 , ")" ==> (Ledger.Posting_Type_Regular, Nothing)
364 , "()" ==> (Ledger.Posting_Type_Regular, Nothing)
365 , "( )" ==> (Ledger.Posting_Type_Regular, Nothing)
366 , "(A)" ==> (Ledger.Posting_Type_Virtual, Just "A")
367 , "(A:B:C)" ==> (Ledger.Posting_Type_Virtual, Just "A:B:C")
368 , "A:B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
369 , "(A):B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
370 , "A:(B):C" ==> (Ledger.Posting_Type_Regular, Nothing)
371 , "A:B:(C)" ==> (Ledger.Posting_Type_Regular, Nothing)
372 , "[" ==> (Ledger.Posting_Type_Regular, Nothing)
373 , "]" ==> (Ledger.Posting_Type_Regular, Nothing)
374 , "[]" ==> (Ledger.Posting_Type_Regular, Nothing)
375 , "[ ]" ==> (Ledger.Posting_Type_Regular, Nothing)
376 , "[A]" ==> (Ledger.Posting_Type_Virtual_Balanced, Just "A")
377 , "[A:B:C]" ==> (Ledger.Posting_Type_Virtual_Balanced, Just "A:B:C")
378 , "A:B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
379 , "[A]:B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
380 , "A:[B]:C" ==> (Ledger.Posting_Type_Regular, Nothing)
381 , "A:B:[C]" ==> (Ledger.Posting_Type_Regular, Nothing)
382 ]
383 , testGroup "read_comment" $
384 let (==>) (txt::Text, end) =
385 testCase (Text.unpack txt) .
386 (@?=) (rights [R.runParser
387 (Ledger.read_comment <* end) () "" txt]) in
388 [ ("; some comment", R.eof) ==> [" some comment"]
389 , ("; some comment \n", R.newline <* R.eof) ==> [ " some comment " ]
390 , ("; some comment \r\n", R.string "\r\n" <* R.eof) ==> [ " some comment " ]
391 ]
392 , testGroup "read_comments" $
393 let (==>) (txt::Text, end) =
394 testCase (Text.unpack txt) .
395 (@?=) (rights [R.runParser
396 (Ledger.read_comments <* end) () "" txt]) in
397 [ ("; some comment\n ; some other comment", R.eof) ==> [ [" some comment", " some other comment"] ]
398 , ("; some comment \n", R.string "\n" <* R.eof) ==> [ [" some comment "] ]
399 ]
400 , testGroup "read_tag_value" $
401 let (==>) (txt::Text, end) =
402 testCase (Text.unpack txt) .
403 (@?=) (rights [R.runParser
404 (Ledger.read_tag_value <* end) () "" txt]) in
405 [ (",", R.eof) ==> [","]
406 , (",\n", R.char '\n' <* R.eof) ==> [","]
407 , (",x", R.eof) ==> [",x"]
408 , (",x:", R.string ",x:" <* R.eof) ==> [""]
409 , ("v, v, n:", R.string ", n:" <* R.eof) ==> ["v, v"]
410 ]
411 , testGroup "read_tag" $
412 let (==>) (txt::Text, end) =
413 testCase (Text.unpack txt) .
414 (@?=) (rights [R.runParser
415 (Ledger.read_tag <* end) () "" txt]) in
416 [ ("Name:" , R.eof) ==> [ ("Name":|[], "") ]
417 , ("Name:Value" , R.eof) ==> [ ("Name":|[], "Value") ]
418 , ("Name:Value\n" , R.string "\n" <* R.eof) ==> [ ("Name":|[], "Value") ]
419 , ("Name:Val ue" , R.eof) ==> [ ("Name":|[], "Val ue") ]
420 , ("Name:," , R.eof) ==> [ ("Name":|[], ",") ]
421 , ("Name:Val,ue" , R.eof) ==> [ ("Name":|[], "Val,ue") ]
422 , ("Name:Val,ue:" , R.string ",ue:" <* R.eof) ==> [ ("Name":|[], "Val") ]
423 , ("Name:Val,ue :", R.eof) ==> [ ("Name":|[], "Val,ue :") ]
424 ]
425 , testGroup "read_tags" $
426 let (==>) (txt::Text) =
427 testCase (Text.unpack txt) .
428 (@?=) (rights [R.runParser
429 (Ledger.read_tags <* R.eof) () "" txt]) .
430 pure . Map.fromList in
431 [ "Name:" ==> [ ("Name":|[], [""]) ]
432 , "Name:," ==> [ ("Name":|[], [","]) ]
433 , "Name:,Name:" ==> [ ("Name":|[], ["", ""]) ]
434 , "Name:,Name2:" ==>
435 [ ("Name":|[], [""])
436 , ("Name2":|[], [""])
437 ]
438 , "Name: , Name2:" ==>
439 [ ("Name":|[], [" "])
440 , ("Name2":|[], [""])
441 ]
442 , "Name:,Name2:,Name3:" ==>
443 [ ("Name":|[], [""])
444 , ("Name2":|[], [""])
445 , ("Name3":|[], [""])
446 ]
447 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ==>
448 [ ("Name":|[], ["Val ue"])
449 , ("Name2":|[], ["V a l u e"])
450 , ("Name3":|[], ["V al ue"])
451 ]
452 ]
453 , testGroup "read_posting" $
454 let (==>) (txt::Text) =
455 let context_read =
456 ( Ledger.context_read (const ()) Ledger.journal
457 ::Ledger.Context_Read () ()) in
458 testCase (Text.unpack txt) .
459 (@?=) (rights [R.runParserWithError
460 (Ledger.read_posting <* R.eof) context_read "" txt]) .
461 ((\p -> Ledger.Posting_Typed Ledger.Posting_Type_Regular
462 p { Ledger.posting_sourcepos = R.newPos "" 1 1 }) <$>) in
463 [ " A:B:C" ==> [Ledger.posting ("A":|["B", "C"])]
464 , "A:B:C" ==> []
465 , " !A:B:C" ==> [(Ledger.posting ("A":|["B", "C"]))
466 { Ledger.posting_status = True }]
467 , " *A:B:C" ==> [(Ledger.posting ("A":|["B", "C"]))
468 { Ledger.posting_status = True }]
469 , " A:B:C $1" ==> [Ledger.posting ("A":|["B", "C $1"])]
470 , " A:B:C $1" ==> [(Ledger.posting ("A":|["B", "C"]))
471 { Ledger.posting_amounts = Map.fromList [("$", 1)] }]
472 , " A:B:C $1 + 1€" ==> [(Ledger.posting ("A":|["B", "C"]))
473 { Ledger.posting_amounts = Map.fromList [("$", 1), ("€", 1)] }]
474 , " A:B:C $1 + 1$" ==> [(Ledger.posting ("A":|["B", "C"]))
475 { Ledger.posting_amounts = Map.fromList [("$", 2)] }]
476 , " A:B:C $1 + 1$ + 1$" ==> [(Ledger.posting ("A":|["B", "C"]))
477 { Ledger.posting_amounts = Map.fromList [("$", 3)] }]
478 , " A:B:C ; some comment" ==> [(Ledger.posting ("A":|["B", "C"]))
479 { Ledger.posting_amounts = Map.fromList []
480 , Ledger.posting_comments = [" some comment"] }]
481 , " A:B:C ; some comment\n ; some other comment" ==>
482 [(Ledger.posting ("A":|["B", "C"]))
483 { Ledger.posting_amounts = Map.fromList []
484 , Ledger.posting_comments = [" some comment", " some other comment"] }]
485 , " A:B:C $1 ; some comment" ==>
486 [(Ledger.posting ("A":|["B", "C"]))
487 { Ledger.posting_amounts = Map.fromList [("$", 1)]
488 , Ledger.posting_comments = [" some comment"] }]
489 , " A:B:C ; N:V" ==>
490 [(Ledger.posting ("A":|["B", "C"]))
491 { Ledger.posting_comments = [" N:V"]
492 , Ledger.posting_tags = H.Posting_Tags $
493 H.tag_from_List [ ("N":|[], "V") ] }]
494 , " A:B:C ; some comment N:V" ==>
495 [(Ledger.posting ("A":|["B", "C"]))
496 { Ledger.posting_comments = [" some comment N:V"]
497 , Ledger.posting_tags = H.Posting_Tags $
498 H.tag_from_List [ ("N":|[], "V") ] }]
499 , " A:B:C ; some comment N:V v, N2:V2 v2" ==>
500 [(Ledger.posting ("A":|["B", "C"]))
501 { Ledger.posting_comments = [" some comment N:V v, N2:V2 v2"]
502 , Ledger.posting_tags = H.Posting_Tags $
503 H.tag_from_List
504 [ ("N":|[], "V v")
505 , ("N2":|[], "V2 v2") ] }]
506 , " A:B:C ; N:V\n ; N:V2" ==>
507 [(Ledger.posting ("A":|["B", "C"]))
508 { Ledger.posting_comments = [" N:V", " N:V2"]
509 , Ledger.posting_tags = H.Posting_Tags $
510 H.tag_from_List
511 [ ("N":|[], "V")
512 , ("N":|[], "V2")
513 ] }]
514 , " A:B:C ; N:V\n ; N2:V" ==>
515 [(Ledger.posting ("A":|["B", "C"]))
516 { Ledger.posting_comments = [" N:V", " N2:V"]
517 , Ledger.posting_tags = H.Posting_Tags $
518 H.tag_from_List
519 [ ("N":|[], "V")
520 , ("N2":|[], "V")
521 ] }]
522 , " A:B:C ; date:2001-01-01" ==>
523 [(Ledger.posting ("A":|["B", "C"]))
524 { Ledger.posting_comments = [" date:2001-01-01"]
525 , Ledger.posting_dates =
526 [ Time.zonedTimeToUTC $
527 Time.ZonedTime
528 (Time.LocalTime
529 (Time.fromGregorian 2001 01 01)
530 (Time.TimeOfDay 0 0 0))
531 Time.utc
532 ]
533 , Ledger.posting_tags = H.Posting_Tags $
534 H.tag_from_List
535 [ ("date":|[], "2001-01-01") ] }]
536 , testCase " (A:B:C) = Right (A:B:C)" $
537 rights [R.runParserWithError
538 (Ledger.read_posting <* R.eof)
539 ( Ledger.context_read (const ()) Ledger.journal
540 ::Ledger.Context_Read () ())
541 "" (" (A:B:C)"::Text)] @?=
542 [Ledger.Posting_Typed
543 Ledger.Posting_Type_Virtual
544 (Ledger.posting ("A":|["B", "C"]))]
545 , testCase " [A:B:C] = Right [A:B:C]" $
546 rights [R.runParserWithError
547 (Ledger.read_posting <* R.eof)
548 ( Ledger.context_read (const ()) Ledger.journal
549 ::Ledger.Context_Read () ())
550 "" (" [A:B:C]"::Text)] @?=
551 [Ledger.Posting_Typed
552 Ledger.Posting_Type_Virtual_Balanced
553 (Ledger.posting ("A":|["B", "C"]))]
554 ]
555 , testGroup "read_transaction" $
556 let (==>) (txt::Text) =
557 let context_read =
558 ( Ledger.context_read (const ()) Ledger.journal
559 ::Ledger.Context_Read () ()) in
560 testCase (Text.unpack txt) .
561 (@?=) (rights [R.runParserWithError
562 (Ledger.read_transaction <* R.eof) context_read "" txt]) .
563 ((\t -> t { Ledger.transaction_sourcepos = R.newPos "" 1 1 }) <$>) in
564 [ "2000-01-01 some wording\n A:B:C $1\n a:b:c" ==>
565 [Ledger.transaction
566 { Ledger.transaction_dates=
567 ( Time.zonedTimeToUTC $
568 Time.ZonedTime
569 (Time.LocalTime
570 (Time.fromGregorian 2000 01 01)
571 (Time.TimeOfDay 0 0 0))
572 Time.utc
573 , [] )
574 , Ledger.transaction_wording="some wording"
575 , Ledger.transaction_postings = Ledger.postings_by_account
576 [ (Ledger.posting ("A":|["B", "C"]))
577 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
578 , Ledger.posting_sourcepos = R.newPos "" 2 1 }
579 , (Ledger.posting ("a":|["b", "c"]))
580 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
581 , Ledger.posting_sourcepos = R.newPos "" 3 1 }
582 ]
583 }]
584 , "2000-01-01 some wording\n A:B:C $1\n a:b:c\n" ==> []
585 , "2000-01-01 some wording ; some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C $1\n a:b:c" ==>
586 [Ledger.transaction
587 { Ledger.transaction_comments_after =
588 [ " some comment"
589 , " some other;comment"
590 , " some Tag:"
591 , " some last comment"
592 ]
593 , Ledger.transaction_dates=
594 ( Time.zonedTimeToUTC $
595 Time.ZonedTime
596 (Time.LocalTime
597 (Time.fromGregorian 2000 01 01)
598 (Time.TimeOfDay 0 0 0))
599 Time.utc
600 , [] )
601 , Ledger.transaction_wording="some wording"
602 , Ledger.transaction_postings = Ledger.postings_by_account
603 [ (Ledger.posting ("A":|["B", "C"]))
604 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
605 , Ledger.posting_sourcepos = R.newPos "" 5 1 }
606 , (Ledger.posting ("a":|["b", "c"]))
607 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
608 , Ledger.posting_sourcepos = R.newPos "" 6 1 } ]
609 , Ledger.transaction_tags = H.Transaction_Tags $
610 H.tag_from_List [ ("Tag":|[], "") ] }]
611 ]
612 , testGroup "read_journal"
613 [ testCase "2000-01-01 1° wording\\n A:B:C $1\\n a:b:c\\n2000-01-02 2° wording\\n A:B:C $1\\n x:y:z" $ do
614 jnl <- liftIO $
615 R.runParserTWithError
616 (Ledger.read_journal "" {-<* R.eof-})
617 ( Ledger.context_read id Ledger.journal
618 ::Ledger.Context_Read (Ledger.Charted Ledger.Transaction)
619 [Ledger.Charted Ledger.Transaction])
620 "" ("2000-01-01 1° wording\n A:B:C $1\n a:b:c\n2000-01-02 2° wording\n A:B:C $1\n x:y:z"::Text)
621 ((\j -> j{Ledger.journal_last_read_time=H.date_epoch}) <$> rights [jnl])
622 @?=
623 [Ledger.journal
624 { Ledger.journal_content =
625 Ledger.Charted mempty <$>
626 [ Ledger.transaction
627 { Ledger.transaction_dates=
628 ( Time.zonedTimeToUTC $
629 Time.ZonedTime
630 (Time.LocalTime
631 (Time.fromGregorian 2000 01 02)
632 (Time.TimeOfDay 0 0 0))
633 Time.utc
634 , [] )
635 , Ledger.transaction_wording="2° wording"
636 , Ledger.transaction_postings = Ledger.postings_by_account
637 [ (Ledger.posting ("A":|["B", "C"]))
638 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
639 , Ledger.posting_sourcepos = R.newPos "" 5 1
640 }
641 , (Ledger.posting ("x":|["y", "z"]))
642 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
643 , Ledger.posting_sourcepos = R.newPos "" 6 1
644 }
645 ]
646 , Ledger.transaction_sourcepos = R.newPos "" 4 1
647 }
648 , Ledger.transaction
649 { Ledger.transaction_dates=
650 ( Time.zonedTimeToUTC $
651 Time.ZonedTime
652 (Time.LocalTime
653 (Time.fromGregorian 2000 01 01)
654 (Time.TimeOfDay 0 0 0))
655 Time.utc
656 , [] )
657 , Ledger.transaction_wording="1° wording"
658 , Ledger.transaction_postings = Ledger.postings_by_account
659 [ (Ledger.posting ("A":|["B", "C"]))
660 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
661 , Ledger.posting_sourcepos = R.newPos "" 2 1
662 }
663 , (Ledger.posting ("a":|["b", "c"]))
664 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
665 , Ledger.posting_sourcepos = R.newPos "" 3 1
666 }
667 ]
668 , Ledger.transaction_sourcepos = R.newPos "" 1 1
669 }
670 ]
671 , Ledger.journal_files = [""]
672 , Ledger.journal_amount_styles = Ledger.Amount_Styles $ Map.fromList
673 [ ( Ledger.Unit "$"
674 , mempty
675 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
676 , Ledger.amount_style_unit_spaced = Just False }
677 )
678 ]
679 }
680 ]
681 ]
682 , testGroup "read_journal" $
683 let (==>) (txt::Text) e =
684 testCase (Text.unpack txt) $ do
685 jnl <-
686 liftIO $
687 right (\j -> j{Ledger.journal_last_read_time=H.date_epoch}) <$>
688 R.runParserTWithError
689 (Ledger.read_journal "" {-<* R.eof-})
690 ( Ledger.context_read id Ledger.journal
691 ::Ledger.Context_Read (Ledger.Charted Ledger.Transaction)
692 [Ledger.Charted Ledger.Transaction])
693 "" (txt::Text)
694 (@?=) (rights [jnl]) e in
695 [ Text.unlines
696 [ "2000-01-01 1° wording"
697 , " A:B:C $1"
698 , " a:b:c"
699 , "2000-01-02 2° wording"
700 , " A:B:C $1"
701 , " x:y:z"
702 ] ==>
703 [ Ledger.journal
704 { Ledger.journal_content =
705 Ledger.Charted mempty <$>
706 [ Ledger.transaction
707 { Ledger.transaction_dates =
708 ( Time.zonedTimeToUTC $
709 Time.ZonedTime
710 (Time.LocalTime
711 (Time.fromGregorian 2000 01 02)
712 (Time.TimeOfDay 0 0 0))
713 Time.utc
714 , [] )
715 , Ledger.transaction_wording ="2° wording"
716 , Ledger.transaction_postings = Ledger.postings_by_account
717 [ (Ledger.posting ("A":|["B", "C"]))
718 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
719 , Ledger.posting_sourcepos = R.newPos "" 5 1
720 }
721 , (Ledger.posting ("x":|["y", "z"]))
722 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
723 , Ledger.posting_sourcepos = R.newPos "" 6 1
724 }
725 ]
726 , Ledger.transaction_sourcepos = R.newPos "" 4 1
727 }
728 , Ledger.transaction
729 { Ledger.transaction_dates =
730 ( Time.zonedTimeToUTC $
731 Time.ZonedTime
732 (Time.LocalTime
733 (Time.fromGregorian 2000 01 01)
734 (Time.TimeOfDay 0 0 0))
735 Time.utc
736 , [] )
737 , Ledger.transaction_wording = "1° wording"
738 , Ledger.transaction_postings = Ledger.postings_by_account
739 [ (Ledger.posting ("A":|["B", "C"]))
740 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
741 , Ledger.posting_sourcepos = R.newPos "" 2 1
742 }
743 , (Ledger.posting ("a":|["b", "c"]))
744 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
745 , Ledger.posting_sourcepos = R.newPos "" 3 1
746 }
747 ]
748 , Ledger.transaction_sourcepos = R.newPos "" 1 1
749 }
750 ]
751 , Ledger.journal_files = [""]
752 , Ledger.journal_amount_styles = Ledger.Amount_Styles $ Map.fromList
753 [ ( Ledger.Unit "$"
754 , mempty
755 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
756 , Ledger.amount_style_unit_spaced = Just False }
757 )
758 ]
759 }
760 ]
761 ]
762 ]