1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE ScopedTypeVariables #-}
6 import Control.Applicative (Applicative(..), (<*))
7 import Control.Arrow (right)
8 import Control.Monad.IO.Class (MonadIO(..))
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
24 import Test.Tasty.HUnit
25 import qualified Text.Parsec as R hiding
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
42 import qualified Hcompta as H
43 import qualified Hcompta.Ledger as Ledger
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
53 [ Time.zonedTimeToUTC $
56 (Time.fromGregorian 2000 01 01)
57 (Time.TimeOfDay 0 0 0))
60 , "2000-01-01_12:34" ==>
61 [ Time.zonedTimeToUTC $
64 (Time.fromGregorian 2000 01 01)
65 (Time.TimeOfDay 12 34 0))
67 , "2000-01-01_12:34:56" ==>
68 [ Time.zonedTimeToUTC $
71 (Time.fromGregorian 2000 01 01)
72 (Time.TimeOfDay 12 34 56))
74 , "2000-01-01_12:34_CET" ==>
75 [ Time.zonedTimeToUTC $
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 $
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 $
92 (Time.fromGregorian 2000 01 01)
93 (Time.TimeOfDay 12 34 56))
94 (Time.TimeZone 60 True "CET") ]
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 $
105 (Time.fromGregorian 2000 01 01)
106 (Time.TimeOfDay 0 0 0))
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])
138 , testCase "\"A \"" $
140 Ledger.read_account_section
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
151 , "A" ==> [ "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"] ]
162 , "A:B:(C)" ==> [ "A":|["B", "(C)"] ]
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
172 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
175 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
177 [( mempty { Ledger.amount_style_fractioning = Just '.' }
178 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
180 [( mempty { Ledger.amount_style_fractioning = Just '.' }
181 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
183 [( mempty { Ledger.amount_style_fractioning = Just ',' }
184 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
186 [( mempty { Ledger.amount_style_fractioning = Just ',' }
187 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
191 [( mempty { Ledger.amount_style_fractioning = Just '.' }
192 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
194 [( mempty { Ledger.amount_style_fractioning = Just '.' }
195 , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
197 [( mempty { Ledger.amount_style_fractioning = Just ',' }
198 , Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
200 [( mempty { Ledger.amount_style_fractioning = Just ',' }
201 , Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
203 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
204 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
206 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
207 , Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
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 } )]
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 } )]
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 } )]
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 } )]
233 , Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
235 [( mempty { Ledger.amount_style_fractioning = Just '.' }
236 , Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
238 [( mempty { Ledger.amount_style_fractioning = Just ',' }
239 , Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
241 [( mempty { Ledger.amount_style_fractioning = Just '.' }
242 , Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
244 [( mempty { Ledger.amount_style_fractioning = Just ',' }
245 , Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
247 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
248 , Ledger.amount { Ledger.amount_quantity = Decimal 0 12 } )]
250 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
251 , Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
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" ==>
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" ==>
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" ==>
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" ==>
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" ==>
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 } )]
287 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
288 , Ledger.amount_style_unit_spaced = Just False }
290 { Ledger.amount_quantity = Decimal 0 1
291 , Ledger.amount_unit = "$" } )]
294 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Right
295 , Ledger.amount_style_unit_spaced = Just False }
297 { Ledger.amount_quantity = Decimal 0 1
298 , Ledger.amount_unit = "$" } )]
301 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
302 , Ledger.amount_style_unit_spaced = Just True }
304 { Ledger.amount_quantity = Decimal 0 1
305 , Ledger.amount_unit = "$" } )]
308 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Right
309 , Ledger.amount_style_unit_spaced = Just True }
311 { Ledger.amount_quantity = Decimal 0 1
312 , Ledger.amount_unit = "$" } )]
315 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
316 , Ledger.amount_style_unit_spaced = Just False }
318 { Ledger.amount_quantity = Decimal 0 (-1)
319 , Ledger.amount_unit = "$" } )]
322 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
323 , Ledger.amount_style_unit_spaced = Just False }
325 { Ledger.amount_quantity = Decimal 0 1
326 , Ledger.amount_unit = "4 2" } )]
329 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Right
330 , Ledger.amount_style_unit_spaced = Just False }
332 { Ledger.amount_quantity = Decimal 0 1
333 , Ledger.amount_unit = "4 2" } )]
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 }
341 { Ledger.amount_quantity = Decimal 2 100000
342 , Ledger.amount_unit = "$" } )]
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 }
350 { Ledger.amount_quantity = Decimal 2 100000
351 , Ledger.amount_unit = "$" } )]
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) $
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)
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 " ]
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 "] ]
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"]
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 :") ]
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":|[], ["", ""]) ]
436 , ("Name2":|[], [""])
438 , "Name: , Name2:" ==>
439 [ ("Name":|[], [" "])
440 , ("Name2":|[], [""])
442 , "Name:,Name2:,Name3:" ==>
444 , ("Name2":|[], [""])
445 , ("Name3":|[], [""])
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"])
453 , testGroup "read_posting" $
454 let (==>) (txt::Text) =
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"])]
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"] }]
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 $
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 $
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 $
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 $
529 (Time.fromGregorian 2001 01 01)
530 (Time.TimeOfDay 0 0 0))
533 , Ledger.posting_tags = H.Posting_Tags $
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"]))]
555 , testGroup "read_transaction" $
556 let (==>) (txt::Text) =
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" ==>
566 { Ledger.transaction_dates=
567 ( Time.zonedTimeToUTC $
570 (Time.fromGregorian 2000 01 01)
571 (Time.TimeOfDay 0 0 0))
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 }
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" ==>
587 { Ledger.transaction_comments_after =
589 , " some other;comment"
591 , " some last comment"
593 , Ledger.transaction_dates=
594 ( Time.zonedTimeToUTC $
597 (Time.fromGregorian 2000 01 01)
598 (Time.TimeOfDay 0 0 0))
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":|[], "") ] }]
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
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])
624 { Ledger.journal_content =
625 Ledger.Charted mempty <$>
627 { Ledger.transaction_dates=
628 ( Time.zonedTimeToUTC $
631 (Time.fromGregorian 2000 01 02)
632 (Time.TimeOfDay 0 0 0))
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
641 , (Ledger.posting ("x":|["y", "z"]))
642 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
643 , Ledger.posting_sourcepos = R.newPos "" 6 1
646 , Ledger.transaction_sourcepos = R.newPos "" 4 1
649 { Ledger.transaction_dates=
650 ( Time.zonedTimeToUTC $
653 (Time.fromGregorian 2000 01 01)
654 (Time.TimeOfDay 0 0 0))
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
663 , (Ledger.posting ("a":|["b", "c"]))
664 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
665 , Ledger.posting_sourcepos = R.newPos "" 3 1
668 , Ledger.transaction_sourcepos = R.newPos "" 1 1
671 , Ledger.journal_files = [""]
672 , Ledger.journal_amount_styles = Ledger.Amount_Styles $ Map.fromList
675 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
676 , Ledger.amount_style_unit_spaced = Just False }
682 , testGroup "read_journal" $
683 let (==>) (txt::Text) e =
684 testCase (Text.unpack txt) $ do
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])
694 (@?=) (rights [jnl]) e in
696 [ "2000-01-01 1° wording"
699 , "2000-01-02 2° wording"
704 { Ledger.journal_content =
705 Ledger.Charted mempty <$>
707 { Ledger.transaction_dates =
708 ( Time.zonedTimeToUTC $
711 (Time.fromGregorian 2000 01 02)
712 (Time.TimeOfDay 0 0 0))
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
721 , (Ledger.posting ("x":|["y", "z"]))
722 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
723 , Ledger.posting_sourcepos = R.newPos "" 6 1
726 , Ledger.transaction_sourcepos = R.newPos "" 4 1
729 { Ledger.transaction_dates =
730 ( Time.zonedTimeToUTC $
733 (Time.fromGregorian 2000 01 01)
734 (Time.TimeOfDay 0 0 0))
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
743 , (Ledger.posting ("a":|["b", "c"]))
744 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
745 , Ledger.posting_sourcepos = R.newPos "" 3 1
748 , Ledger.transaction_sourcepos = R.newPos "" 1 1
751 , Ledger.journal_files = [""]
752 , Ledger.journal_amount_styles = Ledger.Amount_Styles $ Map.fromList
755 { Ledger.amount_style_unit_side = Just Ledger.Amount_Style_Side_Left
756 , Ledger.amount_style_unit_spaced = Just False }