1 {-# LANGUAGE TupleSections #-}
2 {-# LANGUAGE OverloadedStrings #-}
6 import Test.Framework.Providers.HUnit (hUnitTestToTests)
7 import Test.Framework.Runners.Console (defaultMain)
9 import Control.Applicative ((<*))
10 import Control.Monad.IO.Class (liftIO)
11 import Data.Decimal (DecimalRaw(..))
12 import qualified Data.Either
13 import qualified Data.List
14 import Data.List.NonEmpty (NonEmpty(..))
15 import qualified Data.Map.Strict as Data.Map
16 import Data.Text (Text)
17 import qualified Data.Time.Calendar as Time
18 import qualified Data.Time.LocalTime as Time
19 import qualified Text.Parsec as P
20 import qualified Text.Parsec.Pos as P
21 -- import qualified Text.PrettyPrint.Leijen.Text as PP
23 import qualified Hcompta.Model.Account as Account
24 import qualified Hcompta.Model.Amount as Amount
25 import qualified Hcompta.Model.Amount.Style as Amount.Style
26 import qualified Hcompta.Model.Date as Date
27 import qualified Hcompta.Model.Transaction as Transaction
28 import qualified Hcompta.Model.Transaction.Posting as Posting
29 import qualified Hcompta.Calc.Balance as Calc.Balance
30 import qualified Hcompta.Format.Ledger.Read as Format.Ledger.Read
31 import qualified Hcompta.Format.Ledger.Journal as Format.Ledger.Journal
32 import qualified Hcompta.Format.Ledger.Write as Format.Ledger.Write
33 import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
35 --instance Eq Text.Parsec.ParseError where
36 -- (==) = const (const False)
39 main = defaultMain $ hUnitTestToTests test_Hcompta
45 [ "TreeMap" ~: TestList
46 [ "insert" ~: TestList
48 (Lib.TreeMap.insert const ((0::Int):|[]) () Lib.TreeMap.empty)
50 (Lib.TreeMap.TreeMap $
52 [ ((0::Int), Lib.TreeMap.leaf ())
55 (Lib.TreeMap.insert const ((0::Int):|1:[]) () Lib.TreeMap.empty)
57 (Lib.TreeMap.TreeMap $
59 [ ((0::Int), Lib.TreeMap.Node
60 { Lib.TreeMap.node_value = Nothing
61 , Lib.TreeMap.node_size = 1
62 , Lib.TreeMap.node_descendants =
63 Lib.TreeMap.singleton ((1::Int):|[]) ()
70 , "map_by_depth_first" ~: TestList
73 , "flatten" ~: TestList
74 [ "[0, 0/1, 0/1/2]" ~:
75 (Lib.TreeMap.flatten id $
76 Lib.TreeMap.from_List const
88 , "[1, 1/2, 1/22, 1/2/3, 1/2/33, 11, 11/2, 11/2/3, 11/2/33]" ~:
89 (Lib.TreeMap.flatten id $
90 Lib.TreeMap.from_List const
112 , ((11:|2:33:[]), ())
117 , "Model" ~: TestList
118 [ "Account" ~: TestList
119 [ "foldr" ~: TestList
121 (reverse $ Account.foldr ("A":|[]) (:) []) ~?= ["A":|[]]
123 (reverse $ Account.foldr ("A":|["B"]) (:) []) ~?= ["A":|[], "A":|["B"]]
125 (reverse $ Account.foldr ("A":|["B", "C"]) (:) []) ~?= ["A":|[], "A":|["B"], "A":|["B", "C"]]
127 , "ascending" ~: TestList
129 Account.ascending ("A":|[]) ~?= Nothing
131 Account.ascending ("A":|["B"]) ~?= Just ("A":|[])
133 Account.ascending ("A":|["B", "C"]) ~?= Just ("A":|["B"])
136 , "Amount" ~: TestList
141 { Amount.quantity = Decimal 0 1
142 , Amount.style = Amount.Style.nil
143 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
148 { Amount.quantity = Decimal 0 1
149 , Amount.style = Amount.Style.nil
150 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
156 { Amount.quantity = Decimal 0 2
157 , Amount.style = Amount.Style.nil
158 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
163 , "from_List" ~: TestList
164 [ "from_List [$1, 1$] = $2" ~:
167 { Amount.quantity = Decimal 0 1
168 , Amount.style = Amount.Style.nil
169 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
174 { Amount.quantity = Decimal 0 1
175 , Amount.style = Amount.Style.nil
176 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
184 { Amount.quantity = Decimal 0 2
185 , Amount.style = Amount.Style.nil
186 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
195 [ "Balance" ~: TestList
196 [ "posting" ~: TestList
197 [ "[A+$1] = A+$1 & $+1" ~:
198 (Calc.Balance.posting
199 (Posting.nil ("A":|[]))
200 { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
205 { Calc.Balance.by_account =
206 Lib.TreeMap.from_List const
207 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
208 , Calc.Balance.by_unit =
210 Data.List.map Calc.Balance.assoc_unit_sum $
211 [ Calc.Balance.Unit_Sum
212 { Calc.Balance.amount = Amount.usd $ 1
213 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
218 , "[A+$1, A-$1] = {A+$0, $+0}" ~:
220 (flip Calc.Balance.posting)
222 [ (Posting.nil ("A":|[]))
223 { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
225 , (Posting.nil ("A":|[]))
226 { Posting.amounts=Amount.from_List [ Amount.usd $ -1 ]
231 { Calc.Balance.by_account =
232 Lib.TreeMap.from_List const
233 [ ("A":|[], Amount.from_List [ Amount.usd $ 0 ]) ]
234 , Calc.Balance.by_unit =
236 Data.List.map Calc.Balance.assoc_unit_sum $
237 [ Calc.Balance.Unit_Sum
238 { Calc.Balance.amount = Amount.usd $ 0
239 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
244 , "[A+$1, A-€1] = {A+$1-€1, $+1 €-1}" ~:
246 (flip Calc.Balance.posting)
248 [ (Posting.nil ("A":|[]))
249 { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
251 , (Posting.nil ("A":|[]))
252 { Posting.amounts=Amount.from_List [ Amount.eur $ -1 ]
257 { Calc.Balance.by_account =
258 Lib.TreeMap.from_List const
259 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ -1 ]) ]
260 , Calc.Balance.by_unit =
262 Data.List.map Calc.Balance.assoc_unit_sum $
263 [ Calc.Balance.Unit_Sum
264 { Calc.Balance.amount = Amount.usd $ 1
265 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
268 , Calc.Balance.Unit_Sum
269 { Calc.Balance.amount = Amount.eur $ -1
270 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
275 , "[A+$1, B-$1] = {A+$1 B-$1, $+0}" ~:
277 (flip Calc.Balance.posting)
279 [ (Posting.nil ("A":|[]))
280 { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
282 , (Posting.nil ("B":|[]))
283 { Posting.amounts=Amount.from_List [ Amount.usd $ -1 ]
288 { Calc.Balance.by_account =
289 Lib.TreeMap.from_List const
290 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
291 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
293 , Calc.Balance.by_unit =
295 Data.List.map Calc.Balance.assoc_unit_sum $
296 [ Calc.Balance.Unit_Sum
297 { Calc.Balance.amount = Amount.usd $ 0
298 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
303 , "[A+$1+€2, A-$1-€2] = {A+$0+€0, $+0 €+0}" ~:
305 (flip Calc.Balance.posting)
307 [ (Posting.nil ("A":|[]))
308 { Posting.amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2 ]
310 , (Posting.nil ("A":|[]))
311 { Posting.amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2 ]
316 { Calc.Balance.by_account =
317 Lib.TreeMap.from_List const
318 [ ("A":|[], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
320 , Calc.Balance.by_unit =
322 Data.List.map Calc.Balance.assoc_unit_sum $
323 [ Calc.Balance.Unit_Sum
324 { Calc.Balance.amount = Amount.usd $ 0
325 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
328 , Calc.Balance.Unit_Sum
329 { Calc.Balance.amount = Amount.eur $ 0
330 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
335 , "[A+$1+€2+£3, B-$1-2€-£3] = {A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~:
337 (flip Calc.Balance.posting)
339 [ (Posting.nil ("A":|[]))
340 { Posting.amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ]
342 , (Posting.nil ("B":|[]))
343 { Posting.amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ]
348 { Calc.Balance.by_account =
349 Lib.TreeMap.from_List const
350 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
351 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
353 , Calc.Balance.by_unit =
355 Data.List.map Calc.Balance.assoc_unit_sum $
356 [ Calc.Balance.Unit_Sum
357 { Calc.Balance.amount = Amount.usd $ 0
358 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
361 , Calc.Balance.Unit_Sum
362 { Calc.Balance.amount = Amount.eur $ 0
363 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
366 , Calc.Balance.Unit_Sum
367 { Calc.Balance.amount = Amount.gbp $ 0
368 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
374 , "union" ~: TestList
381 , "{A+$1, $+1} {A+$1, $+1} = {A+$2, $+2}" ~:
383 (Calc.Balance.Balance
384 { Calc.Balance.by_account =
385 Lib.TreeMap.from_List const
386 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
387 , Calc.Balance.by_unit =
389 Data.List.map Calc.Balance.assoc_unit_sum $
390 [ Calc.Balance.Unit_Sum
391 { Calc.Balance.amount = Amount.usd $ 1
392 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
397 (Calc.Balance.Balance
398 { Calc.Balance.by_account =
399 Lib.TreeMap.from_List const
400 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
401 , Calc.Balance.by_unit =
403 Data.List.map Calc.Balance.assoc_unit_sum $
404 [ Calc.Balance.Unit_Sum
405 { Calc.Balance.amount = Amount.usd $ 1
406 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
413 { Calc.Balance.by_account =
414 Lib.TreeMap.from_List const
415 [ ("A":|[], Amount.from_List [ Amount.usd $ 2 ]) ]
416 , Calc.Balance.by_unit =
418 Data.List.map Calc.Balance.assoc_unit_sum $
419 [ Calc.Balance.Unit_Sum
420 { Calc.Balance.amount = Amount.usd $ 2
421 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
426 , "{A+$1, $+1} {B+$1, $+1} = {A+$1 B+$1, $+2}" ~:
428 (Calc.Balance.Balance
429 { Calc.Balance.by_account =
430 Lib.TreeMap.from_List const
431 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
432 , Calc.Balance.by_unit =
434 Data.List.map Calc.Balance.assoc_unit_sum $
435 [ Calc.Balance.Unit_Sum
436 { Calc.Balance.amount = Amount.usd $ 1
437 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
442 (Calc.Balance.Balance
443 { Calc.Balance.by_account =
444 Lib.TreeMap.from_List const
445 [ ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
446 , Calc.Balance.by_unit =
448 Data.List.map Calc.Balance.assoc_unit_sum $
449 [ Calc.Balance.Unit_Sum
450 { Calc.Balance.amount = Amount.usd $ 1
451 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
458 { Calc.Balance.by_account =
459 Lib.TreeMap.from_List const
460 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
461 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
462 , Calc.Balance.by_unit =
464 Data.List.map Calc.Balance.assoc_unit_sum $
465 [ Calc.Balance.Unit_Sum
466 { Calc.Balance.amount = Amount.usd $ 2
467 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
472 , "{A+$1, $+1} {B+€1, €+1} = {A+$1 B+€1, $+1 €+1}" ~:
474 (Calc.Balance.Balance
475 { Calc.Balance.by_account =
476 Lib.TreeMap.from_List const
477 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
478 , Calc.Balance.by_unit =
480 Data.List.map Calc.Balance.assoc_unit_sum $
481 [ Calc.Balance.Unit_Sum
482 { Calc.Balance.amount = Amount.usd $ 1
483 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
488 (Calc.Balance.Balance
489 { Calc.Balance.by_account =
490 Lib.TreeMap.from_List const
491 [ ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
492 , Calc.Balance.by_unit =
494 Data.List.map Calc.Balance.assoc_unit_sum $
495 [ Calc.Balance.Unit_Sum
496 { Calc.Balance.amount = Amount.eur $ 1
497 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
504 { Calc.Balance.by_account =
505 Lib.TreeMap.from_List const
506 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
507 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
508 , Calc.Balance.by_unit =
510 Data.List.map Calc.Balance.assoc_unit_sum $
511 [ Calc.Balance.Unit_Sum
512 { Calc.Balance.amount = Amount.usd $ 1
513 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
516 , Calc.Balance.Unit_Sum
517 { Calc.Balance.amount = Amount.eur $ 1
518 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
524 , "expand" ~: TestList
525 [ "nil_By_Account" ~:
527 Calc.Balance.nil_By_Account
532 (Lib.TreeMap.from_List const
533 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ])
535 (Lib.TreeMap.from_List const
536 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
537 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
538 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
541 , "A/A+$1 = A+$1 A/A+$1" ~:
543 (Lib.TreeMap.from_List const
544 [ ("A":|["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
546 (Lib.TreeMap.from_List const
547 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
548 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
549 , Calc.Balance.exclusive = Amount.from_List []
551 , ("A":|["A"], Calc.Balance.Account_Sum_Expanded
552 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
553 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
556 , "A/B+$1 = A+$1 A/B+$1" ~:
558 (Lib.TreeMap.from_List const
559 [ ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ]) ])
561 (Lib.TreeMap.from_List const
562 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
563 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
564 , Calc.Balance.exclusive = Amount.from_List []
566 , ("A":|["B"], Calc.Balance.Account_Sum_Expanded
567 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
568 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
571 , "A/B/C+$1 = A+$1 A/B+$1 A/B/C+$1" ~:
573 (Lib.TreeMap.from_List const
574 [ ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
576 (Lib.TreeMap.from_List const
577 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
578 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
579 , Calc.Balance.exclusive = Amount.from_List []
581 , ("A":|["B"], Calc.Balance.Account_Sum_Expanded
582 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
583 , Calc.Balance.exclusive = Amount.from_List []
585 , ("A":|["B", "C"], Calc.Balance.Account_Sum_Expanded
586 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
587 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
590 , "A+$1 A/B+$1 = A+$2 A/B+$1" ~:
592 (Lib.TreeMap.from_List const
593 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
594 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
597 (Lib.TreeMap.from_List const
598 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
599 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 2 ]
600 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
602 , ("A":|["B"], Calc.Balance.Account_Sum_Expanded
603 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
604 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
607 , "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
609 (Lib.TreeMap.from_List const
610 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
611 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
612 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
615 (Lib.TreeMap.from_List const
616 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
617 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 3 ]
618 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
620 , ("A":|["B"], Calc.Balance.Account_Sum_Expanded
621 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 2 ]
622 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
624 , ("A":|["B", "C"], Calc.Balance.Account_Sum_Expanded
625 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
626 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
629 , "A+$1 A/B+$1 A/B/C+$1 A/B/C/D+$1 = A+$4 A/B+$3 A/B/C+$2 A/B/C/D+$1" ~:
631 (Lib.TreeMap.from_List const
632 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
633 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
634 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
635 , ("A":|["B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
638 (Lib.TreeMap.from_List const
639 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
640 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 4 ]
641 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
643 , ("A":|["B"], Calc.Balance.Account_Sum_Expanded
644 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 3 ]
645 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
647 , ("A":|["B", "C"], Calc.Balance.Account_Sum_Expanded
648 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 2 ]
649 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
651 , ("A":|["B", "C", "D"], Calc.Balance.Account_Sum_Expanded
652 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
653 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
656 , "A+$1 A/B+$1 A/BB+$1 AA/B+$1 = A+$3 A/B+$1 A/BB+$1 AA+$1 AA/B+$1" ~:
658 (Lib.TreeMap.from_List const
659 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
660 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
661 , ("A":|["BB"], Amount.from_List [ Amount.usd $ 1 ])
662 , ("AA":|["B"], Amount.from_List [ Amount.usd $ 1 ])
665 (Lib.TreeMap.from_List const
666 [ ("A":|[], Calc.Balance.Account_Sum_Expanded
667 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 3 ]
668 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
670 , ("A":|["B"], Calc.Balance.Account_Sum_Expanded
671 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
672 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
674 , ("A":|["BB"], Calc.Balance.Account_Sum_Expanded
675 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
676 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
678 , ("AA":|[], Calc.Balance.Account_Sum_Expanded
679 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
680 , Calc.Balance.exclusive = Amount.from_List []
682 , ("AA":|["B"], Calc.Balance.Account_Sum_Expanded
683 { Calc.Balance.inclusive = Amount.from_List [ Amount.usd $ 1 ]
684 , Calc.Balance.exclusive = Amount.from_List [ Amount.usd $ 1 ]
688 , "equilibre" ~: TestList
690 (Calc.Balance.equilibre $
692 { Calc.Balance.by_account =
693 Lib.TreeMap.from_List const
694 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
695 , ("B":|[], Amount.from_List [])
697 , Calc.Balance.by_unit =
699 Data.List.map Calc.Balance.assoc_unit_sum $
700 [ Calc.Balance.Unit_Sum
701 { Calc.Balance.amount = Amount.usd $ 1
702 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
708 (Calc.Balance.Equilibre $
710 Data.List.map Calc.Balance.assoc_unit_sum $
711 [ Calc.Balance.Unit_Sum
712 { Calc.Balance.amount = Amount.usd $ 1
713 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
718 , "is_equilibrable" ~: TestList
719 [ "nil" ~: TestCase $
721 Calc.Balance.is_equilibrable $
722 Calc.Balance.equilibre $
724 , "{A+$0, $+0}" ~: TestCase $
726 Calc.Balance.is_equilibrable $
727 Calc.Balance.equilibre $
729 { Calc.Balance.by_account =
730 Lib.TreeMap.from_List const
731 [ ("A":|[], Amount.from_List [ Amount.usd $ 0 ])
733 , Calc.Balance.by_unit =
735 Data.List.map Calc.Balance.assoc_unit_sum $
736 [ Calc.Balance.Unit_Sum
737 { Calc.Balance.amount = Amount.usd $ 0
738 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
743 , "{A+$1, $+1}" ~: TestCase $
745 Calc.Balance.is_equilibrable $
746 Calc.Balance.equilibre $
748 { Calc.Balance.by_account =
749 Lib.TreeMap.from_List const
750 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
752 , Calc.Balance.by_unit =
754 Data.List.map Calc.Balance.assoc_unit_sum $
755 [ Calc.Balance.Unit_Sum
756 { Calc.Balance.amount = Amount.usd $ 1
757 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
762 , "{A+$0+€0, $0 €+0}" ~: TestCase $
764 Calc.Balance.is_equilibrable $
765 Calc.Balance.equilibre $
767 { Calc.Balance.by_account =
768 Lib.TreeMap.from_List const
769 [ ("A":|[], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
771 , Calc.Balance.by_unit =
773 Data.List.map Calc.Balance.assoc_unit_sum $
774 [ Calc.Balance.Unit_Sum
775 { Calc.Balance.amount = Amount.usd $ 0
776 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
779 , Calc.Balance.Unit_Sum
780 { Calc.Balance.amount = Amount.eur $ 0
781 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
786 , "{A+$1, B-$1, $+0}" ~: TestCase $
788 Calc.Balance.is_equilibrable $
789 Calc.Balance.equilibre $
791 { Calc.Balance.by_account =
792 Lib.TreeMap.from_List const
793 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
794 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
796 , Calc.Balance.by_unit =
798 Data.List.map Calc.Balance.assoc_unit_sum $
799 [ Calc.Balance.Unit_Sum
800 { Calc.Balance.amount = Amount.usd $ 0
801 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
806 , "{A+$1 B, $+1}" ~: TestCase $
808 Calc.Balance.is_equilibrable $
809 Calc.Balance.equilibre $
811 { Calc.Balance.by_account =
812 Lib.TreeMap.from_List const
813 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
814 , ("B":|[], Amount.from_List [])
816 , Calc.Balance.by_unit =
818 Data.List.map Calc.Balance.assoc_unit_sum $
819 [ Calc.Balance.Unit_Sum
820 { Calc.Balance.amount = Amount.usd $ 1
821 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
826 , "{A+$1 B+€1, $+1 €+1}" ~: TestCase $
828 Calc.Balance.is_equilibrable $
829 Calc.Balance.equilibre $
831 { Calc.Balance.by_account =
832 Lib.TreeMap.from_List const
833 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
834 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ])
836 , Calc.Balance.by_unit =
838 Data.List.map Calc.Balance.assoc_unit_sum $
839 [ Calc.Balance.Unit_Sum
840 { Calc.Balance.amount = Amount.usd $ 1
841 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
844 , Calc.Balance.Unit_Sum
845 { Calc.Balance.amount = Amount.eur $ 1
846 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
851 , "{A+$1 B-$1+€1, $+0 €+1}" ~: TestCase $
853 Calc.Balance.is_equilibrable $
854 Calc.Balance.equilibre $
856 { Calc.Balance.by_account =
857 Lib.TreeMap.from_List const
858 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
859 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ 1 ])
861 , Calc.Balance.by_unit =
863 Data.List.map Calc.Balance.assoc_unit_sum $
864 [ Calc.Balance.Unit_Sum
865 { Calc.Balance.amount = Amount.usd $ 0
866 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
869 , Calc.Balance.Unit_Sum
870 { Calc.Balance.amount = Amount.eur $ 1
871 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
876 , "{A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~: TestCase $
878 Calc.Balance.is_equilibrable $
879 Calc.Balance.equilibre $
881 { Calc.Balance.by_account =
882 Lib.TreeMap.from_List const
883 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
884 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
886 , Calc.Balance.by_unit =
888 Data.List.map Calc.Balance.assoc_unit_sum $
889 [ Calc.Balance.Unit_Sum
890 { Calc.Balance.amount = Amount.usd $ 0
891 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
894 , Calc.Balance.Unit_Sum
895 { Calc.Balance.amount = Amount.eur $ 0
896 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
899 , Calc.Balance.Unit_Sum
900 { Calc.Balance.amount = Amount.gbp $ 0
901 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
907 , "infer_equilibre" ~: TestList
909 (Calc.Balance.infer_equilibre $
911 [ (Posting.nil ("A":|[]))
912 { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ] }
913 , (Posting.nil ("B":|[]))
914 { Posting.amounts=Amount.from_List [] }
919 [ (Posting.nil ("A":|[]))
920 { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ] }
921 , (Posting.nil ("B":|[]))
922 { Posting.amounts=Amount.from_List [ Amount.usd $ -1 ] }
925 (Calc.Balance.infer_equilibre $
927 [ (Posting.nil ("A":|[]))
928 { Posting.amounts=Amount.from_List [ Amount.usd $ 1 ] }
929 , (Posting.nil ("B":|[]))
930 { Posting.amounts=Amount.from_List [ Amount.eur $ -1 ] }
935 [ (Posting.nil ("A":|[]))
936 { Posting.amounts=Amount.from_List [ Amount.eur $ 1 ] }
937 , (Posting.nil ("A":|[]))
938 { Posting.amounts=Amount.from_List [ Amount.usd $ 1] }
939 , (Posting.nil ("B":|[]))
940 { Posting.amounts=Amount.from_List [ Amount.usd $ -1 ] }
941 , (Posting.nil ("B":|[]))
942 { Posting.amounts=Amount.from_List [ Amount.eur $ -1 ] }
947 , "Format" ~: TestList
948 [ "Ledger" ~: TestList
950 [ "account_name" ~: TestList
952 (Data.Either.rights $
954 (Format.Ledger.Read.account_name <* P.eof)
959 (Data.Either.rights $
961 (Format.Ledger.Read.account_name <* P.eof)
966 (Data.Either.rights $
968 (Format.Ledger.Read.account_name <* P.eof)
973 (Data.Either.rights $
975 (Format.Ledger.Read.account_name <* P.eof)
980 (Data.Either.rights $
982 (Format.Ledger.Read.account_name <* P.eof)
987 (Data.Either.rights $
989 (Format.Ledger.Read.account_name <* P.eof)
994 (Data.Either.rights $
996 (Format.Ledger.Read.account_name <* P.eof)
1001 (Data.Either.rights $
1003 (Format.Ledger.Read.account_name <* P.eof)
1004 () "" ("A "::Text)])
1008 (Data.Either.rights $
1010 (Format.Ledger.Read.account_name)
1011 () "" ("A "::Text)])
1015 (Data.Either.rights $
1017 (Format.Ledger.Read.account_name <* P.eof)
1018 () "" ("A A"::Text)])
1022 (Data.Either.rights $
1024 (Format.Ledger.Read.account_name <* P.eof)
1025 () "" ("A "::Text)])
1029 (Data.Either.rights $
1031 (Format.Ledger.Read.account_name <* P.eof)
1032 () "" ("A \n"::Text)])
1036 (Data.Either.rights $
1038 (Format.Ledger.Read.account_name <* P.eof)
1039 () "" ("(A)A"::Text)])
1043 (Data.Either.rights $
1045 (Format.Ledger.Read.account_name <* P.eof)
1046 () "" ("( )A"::Text)])
1050 (Data.Either.rights $
1052 (Format.Ledger.Read.account_name <* P.eof)
1053 () "" ("(A) A"::Text)])
1057 (Data.Either.rights $
1059 (Format.Ledger.Read.account_name <* P.eof)
1060 () "" ("[ ]A"::Text)])
1064 (Data.Either.rights $
1066 (Format.Ledger.Read.account_name <* P.eof)
1067 () "" ("(A) "::Text)])
1071 (Data.Either.rights $
1073 (Format.Ledger.Read.account_name <* P.eof)
1074 () "" ("(A)"::Text)])
1078 (Data.Either.rights $
1080 (Format.Ledger.Read.account_name <* P.eof)
1081 () "" ("A(A)"::Text)])
1085 (Data.Either.rights $
1087 (Format.Ledger.Read.account_name <* P.eof)
1088 () "" ("[A]A"::Text)])
1092 (Data.Either.rights $
1094 (Format.Ledger.Read.account_name <* P.eof)
1095 () "" ("[A] A"::Text)])
1099 (Data.Either.rights $
1101 (Format.Ledger.Read.account_name <* P.eof)
1102 () "" ("[A] "::Text)])
1106 (Data.Either.rights $
1108 (Format.Ledger.Read.account_name <* P.eof)
1109 () "" ("[A]"::Text)])
1113 , "account" ~: TestList
1115 (Data.Either.rights $
1117 (Format.Ledger.Read.account <* P.eof)
1122 (Data.Either.rights $
1124 (Format.Ledger.Read.account <* P.eof)
1129 (Data.Either.rights $
1131 (Format.Ledger.Read.account <* P.eof)
1132 () "" ("A:"::Text)])
1136 (Data.Either.rights $
1138 (Format.Ledger.Read.account <* P.eof)
1139 () "" (":A"::Text)])
1143 (Data.Either.rights $
1145 (Format.Ledger.Read.account <* P.eof)
1146 () "" ("A "::Text)])
1150 (Data.Either.rights $
1152 (Format.Ledger.Read.account <* P.eof)
1153 () "" (" A"::Text)])
1157 (Data.Either.rights $
1159 (Format.Ledger.Read.account <* P.eof)
1160 () "" ("A:B"::Text)])
1164 (Data.Either.rights $
1166 (Format.Ledger.Read.account <* P.eof)
1167 () "" ("A:B:C"::Text)])
1170 , "\"Aa:Bbb:Cccc\"" ~:
1171 (Data.Either.rights $
1173 (Format.Ledger.Read.account <* P.eof)
1174 () "" ("Aa:Bbb:Cccc"::Text)])
1176 ["Aa":|["Bbb", "Cccc"]]
1177 , "\"A a : B b b : C c c c\"" ~:
1178 (Data.Either.rights $
1180 (Format.Ledger.Read.account <* P.eof)
1181 () "" ("A a : B b b : C c c c"::Text)])
1183 ["A a ":|[" B b b ", " C c c c"]]
1185 (Data.Either.rights $
1187 (Format.Ledger.Read.account <* P.eof)
1188 () "" ("A: :C"::Text)])
1192 (Data.Either.rights $
1194 (Format.Ledger.Read.account <* P.eof)
1195 () "" ("A::C"::Text)])
1199 (Data.Either.rights $
1201 (Format.Ledger.Read.account <* P.eof)
1202 () "" ("A:B:(C)"::Text)])
1206 , "posting_type" ~: TestList
1208 Format.Ledger.Read.posting_type
1211 (Posting.Type_Regular, "A":|[])
1213 Format.Ledger.Read.posting_type
1216 (Posting.Type_Regular, "(":|[])
1218 Format.Ledger.Read.posting_type
1221 (Posting.Type_Regular, ")":|[])
1223 Format.Ledger.Read.posting_type
1226 (Posting.Type_Regular, "()":|[])
1228 Format.Ledger.Read.posting_type
1231 (Posting.Type_Regular, "( )":|[])
1233 Format.Ledger.Read.posting_type
1236 (Posting.Type_Virtual, "A":|[])
1238 Format.Ledger.Read.posting_type
1241 (Posting.Type_Virtual, "A":|["B", "C"])
1243 Format.Ledger.Read.posting_type
1246 (Posting.Type_Regular, "A":|["B", "C"])
1248 Format.Ledger.Read.posting_type
1251 (Posting.Type_Regular, "(A)":|["B", "C"])
1253 Format.Ledger.Read.posting_type
1256 (Posting.Type_Regular, "A":|["(B)", "C"])
1258 Format.Ledger.Read.posting_type
1261 (Posting.Type_Regular, "A":|["B", "(C)"])
1263 Format.Ledger.Read.posting_type
1266 (Posting.Type_Regular, "[":|[])
1268 Format.Ledger.Read.posting_type
1271 (Posting.Type_Regular, "]":|[])
1273 Format.Ledger.Read.posting_type
1276 (Posting.Type_Regular, "[]":|[])
1278 Format.Ledger.Read.posting_type
1281 (Posting.Type_Regular, "[ ]":|[])
1283 Format.Ledger.Read.posting_type
1286 (Posting.Type_Virtual_Balanced, "A":|[])
1288 Format.Ledger.Read.posting_type
1291 (Posting.Type_Virtual_Balanced, "A":|["B", "C"])
1293 Format.Ledger.Read.posting_type
1296 (Posting.Type_Regular, "A":|["B", "C"])
1298 Format.Ledger.Read.posting_type
1301 (Posting.Type_Regular, "[A]":|["B", "C"])
1303 Format.Ledger.Read.posting_type
1306 (Posting.Type_Regular, "A":|["[B]", "C"])
1308 Format.Ledger.Read.posting_type
1311 (Posting.Type_Regular, "A":|["B", "[C]"])
1313 , "amount" ~: TestList
1315 (Data.Either.rights $
1317 (Format.Ledger.Read.amount <* P.eof)
1321 , "\"0\" = Right 0" ~:
1322 (Data.Either.rights $
1324 (Format.Ledger.Read.amount <* P.eof)
1328 { Amount.quantity = Decimal 0 0
1330 , "\"00\" = Right 0" ~:
1331 (Data.Either.rights $
1333 (Format.Ledger.Read.amount <* P.eof)
1334 () "" ("00"::Text)])
1337 { Amount.quantity = Decimal 0 0
1339 , "\"0.\" = Right 0." ~:
1340 (Data.Either.rights $
1342 (Format.Ledger.Read.amount <* P.eof)
1343 () "" ("0."::Text)])
1346 { Amount.quantity = Decimal 0 0
1349 { Amount.Style.fractioning = Just '.'
1352 , "\".0\" = Right 0.0" ~:
1353 (Data.Either.rights $
1355 (Format.Ledger.Read.amount <* P.eof)
1356 () "" (".0"::Text)])
1359 { Amount.quantity = Decimal 0 0
1362 { Amount.Style.fractioning = Just '.'
1363 , Amount.Style.precision = 1
1366 , "\"0,\" = Right 0," ~:
1367 (Data.Either.rights $
1369 (Format.Ledger.Read.amount <* P.eof)
1370 () "" ("0,"::Text)])
1373 { Amount.quantity = Decimal 0 0
1376 { Amount.Style.fractioning = Just ','
1379 , "\",0\" = Right 0,0" ~:
1380 (Data.Either.rights $
1382 (Format.Ledger.Read.amount <* P.eof)
1383 () "" (",0"::Text)])
1386 { Amount.quantity = Decimal 0 0
1389 { Amount.Style.fractioning = Just ','
1390 , Amount.Style.precision = 1
1393 , "\"0_\" = Left" ~:
1394 (Data.Either.rights $
1396 (Format.Ledger.Read.amount <* P.eof)
1397 () "" ("0_"::Text)])
1400 , "\"_0\" = Left" ~:
1401 (Data.Either.rights $
1403 (Format.Ledger.Read.amount <* P.eof)
1404 () "" ("_0"::Text)])
1407 , "\"0.0\" = Right 0.0" ~:
1408 (Data.Either.rights $
1410 (Format.Ledger.Read.amount <* P.eof)
1411 () "" ("0.0"::Text)])
1414 { Amount.quantity = Decimal 0 0
1417 { Amount.Style.fractioning = Just '.'
1418 , Amount.Style.precision = 1
1421 , "\"00.00\" = Right 0.00" ~:
1422 (Data.Either.rights $
1424 (Format.Ledger.Read.amount <* P.eof)
1425 () "" ("00.00"::Text)])
1428 { Amount.quantity = Decimal 0 0
1431 { Amount.Style.fractioning = Just '.'
1432 , Amount.Style.precision = 2
1435 , "\"0,0\" = Right 0,0" ~:
1436 (Data.Either.rights $
1438 (Format.Ledger.Read.amount <* P.eof)
1439 () "" ("0,0"::Text)])
1442 { Amount.quantity = Decimal 0 0
1445 { Amount.Style.fractioning = Just ','
1446 , Amount.Style.precision = 1
1449 , "\"00,00\" = Right 0,00" ~:
1450 (Data.Either.rights $
1452 (Format.Ledger.Read.amount <* P.eof)
1453 () "" ("00,00"::Text)])
1456 { Amount.quantity = Decimal 0 0
1459 { Amount.Style.fractioning = Just ','
1460 , Amount.Style.precision = 2
1463 , "\"0_0\" = Right 0" ~:
1464 (Data.Either.rights $
1466 (Format.Ledger.Read.amount <* P.eof)
1467 () "" ("0_0"::Text)])
1470 { Amount.quantity = Decimal 0 0
1473 { Amount.Style.fractioning = Nothing
1474 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
1475 , Amount.Style.precision = 0
1478 , "\"00_00\" = Right 0" ~:
1479 (Data.Either.rights $
1481 (Format.Ledger.Read.amount <* P.eof)
1482 () "" ("00_00"::Text)])
1485 { Amount.quantity = Decimal 0 0
1488 { Amount.Style.fractioning = Nothing
1489 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
1490 , Amount.Style.precision = 0
1493 , "\"0,000.00\" = Right 0,000.00" ~:
1494 (Data.Either.rights $
1496 (Format.Ledger.Read.amount <* P.eof)
1497 () "" ("0,000.00"::Text)])
1500 { Amount.quantity = Decimal 0 0
1503 { Amount.Style.fractioning = Just '.'
1504 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
1505 , Amount.Style.precision = 2
1508 , "\"0.000,00\" = Right 0.000,00" ~:
1509 (Data.Either.rights $
1511 (Format.Ledger.Read.amount)
1512 () "" ("0.000,00"::Text)])
1515 { Amount.quantity = Decimal 0 0
1518 { Amount.Style.fractioning = Just ','
1519 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1520 , Amount.Style.precision = 2
1523 , "\"1,000.00\" = Right 1,000.00" ~:
1524 (Data.Either.rights $
1526 (Format.Ledger.Read.amount <* P.eof)
1527 () "" ("1,000.00"::Text)])
1530 { Amount.quantity = Decimal 0 1000
1533 { Amount.Style.fractioning = Just '.'
1534 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
1535 , Amount.Style.precision = 2
1538 , "\"1.000,00\" = Right 1.000,00" ~:
1539 (Data.Either.rights $
1541 (Format.Ledger.Read.amount)
1542 () "" ("1.000,00"::Text)])
1545 { Amount.quantity = Decimal 0 1000
1548 { Amount.Style.fractioning = Just ','
1549 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1550 , Amount.Style.precision = 2
1553 , "\"1,000.00.\" = Left" ~:
1554 (Data.Either.rights $
1556 (Format.Ledger.Read.amount)
1557 () "" ("1,000.00."::Text)])
1560 , "\"1.000,00,\" = Left" ~:
1561 (Data.Either.rights $
1563 (Format.Ledger.Read.amount)
1564 () "" ("1.000,00,"::Text)])
1567 , "\"1,000.00_\" = Left" ~:
1568 (Data.Either.rights $
1570 (Format.Ledger.Read.amount)
1571 () "" ("1,000.00_"::Text)])
1574 , "\"12\" = Right 12" ~:
1575 (Data.Either.rights $
1577 (Format.Ledger.Read.amount <* P.eof)
1578 () "" ("123"::Text)])
1581 { Amount.quantity = Decimal 0 123
1583 , "\"1.2\" = Right 1.2" ~:
1584 (Data.Either.rights $
1586 (Format.Ledger.Read.amount <* P.eof)
1587 () "" ("1.2"::Text)])
1590 { Amount.quantity = Decimal 1 12
1593 { Amount.Style.fractioning = Just '.'
1594 , Amount.Style.precision = 1
1597 , "\"1,2\" = Right 1,2" ~:
1598 (Data.Either.rights $
1600 (Format.Ledger.Read.amount <* P.eof)
1601 () "" ("1,2"::Text)])
1604 { Amount.quantity = Decimal 1 12
1607 { Amount.Style.fractioning = Just ','
1608 , Amount.Style.precision = 1
1611 , "\"12.23\" = Right 12.23" ~:
1612 (Data.Either.rights $
1614 (Format.Ledger.Read.amount <* P.eof)
1615 () "" ("12.34"::Text)])
1618 { Amount.quantity = Decimal 2 1234
1621 { Amount.Style.fractioning = Just '.'
1622 , Amount.Style.precision = 2
1625 , "\"12,23\" = Right 12,23" ~:
1626 (Data.Either.rights $
1628 (Format.Ledger.Read.amount <* P.eof)
1629 () "" ("12,34"::Text)])
1632 { Amount.quantity = Decimal 2 1234
1635 { Amount.Style.fractioning = Just ','
1636 , Amount.Style.precision = 2
1639 , "\"1_2\" = Right 1_2" ~:
1640 (Data.Either.rights $
1642 (Format.Ledger.Read.amount <* P.eof)
1643 () "" ("1_2"::Text)])
1646 { Amount.quantity = Decimal 0 12
1649 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
1650 , Amount.Style.precision = 0
1653 , "\"1_23\" = Right 1_23" ~:
1654 (Data.Either.rights $
1656 (Format.Ledger.Read.amount <* P.eof)
1657 () "" ("1_23"::Text)])
1660 { Amount.quantity = Decimal 0 123
1663 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
1664 , Amount.Style.precision = 0
1667 , "\"1_23_456\" = Right 1_23_456" ~:
1668 (Data.Either.rights $
1670 (Format.Ledger.Read.amount <* P.eof)
1671 () "" ("1_23_456"::Text)])
1674 { Amount.quantity = Decimal 0 123456
1677 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
1678 , Amount.Style.precision = 0
1681 , "\"1_23_456.7890_12345_678901\" = Right 1_23_456.7890_12345_678901" ~:
1682 (Data.Either.rights $
1684 (Format.Ledger.Read.amount <* P.eof)
1685 () "" ("1_23_456.7890_12345_678901"::Text)])
1688 { Amount.quantity = Decimal 15 123456789012345678901
1691 { Amount.Style.fractioning = Just '.'
1692 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
1693 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [4, 5, 6]
1694 , Amount.Style.precision = 15
1697 , "\"123456_78901_2345.678_90_1\" = Right 123456_78901_2345.678_90_1" ~:
1698 (Data.Either.rights $
1700 (Format.Ledger.Read.amount <* P.eof)
1701 () "" ("123456_78901_2345.678_90_1"::Text)])
1704 { Amount.quantity = Decimal 6 123456789012345678901
1707 { Amount.Style.fractioning = Just '.'
1708 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [4, 5, 6]
1709 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [3, 2]
1710 , Amount.Style.precision = 6
1713 , "\"$1\" = Right $1" ~:
1714 (Data.Either.rights $
1716 (Format.Ledger.Read.amount <* P.eof)
1717 () "" ("$1"::Text)])
1720 { Amount.quantity = Decimal 0 1
1723 { Amount.Style.fractioning = Nothing
1724 , Amount.Style.grouping_integral = Nothing
1725 , Amount.Style.grouping_fractional = Nothing
1726 , Amount.Style.precision = 0
1727 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1728 , Amount.Style.unit_spaced = Just False
1732 , "\"1$\" = Right 1$" ~:
1733 (Data.Either.rights $
1735 (Format.Ledger.Read.amount <* P.eof)
1736 () "" ("1$"::Text)])
1739 { Amount.quantity = Decimal 0 1
1742 { Amount.Style.fractioning = Nothing
1743 , Amount.Style.grouping_integral = Nothing
1744 , Amount.Style.grouping_fractional = Nothing
1745 , Amount.Style.precision = 0
1746 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1747 , Amount.Style.unit_spaced = Just False
1751 , "\"$ 1\" = Right $ 1" ~:
1752 (Data.Either.rights $
1754 (Format.Ledger.Read.amount <* P.eof)
1755 () "" ("$ 1"::Text)])
1758 { Amount.quantity = Decimal 0 1
1761 { Amount.Style.fractioning = Nothing
1762 , Amount.Style.grouping_integral = Nothing
1763 , Amount.Style.grouping_fractional = Nothing
1764 , Amount.Style.precision = 0
1765 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1766 , Amount.Style.unit_spaced = Just True
1770 , "\"1 $\" = Right 1 $" ~:
1771 (Data.Either.rights $
1773 (Format.Ledger.Read.amount <* P.eof)
1774 () "" ("1 $"::Text)])
1777 { Amount.quantity = Decimal 0 1
1780 { Amount.Style.fractioning = Nothing
1781 , Amount.Style.grouping_integral = Nothing
1782 , Amount.Style.grouping_fractional = Nothing
1783 , Amount.Style.precision = 0
1784 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1785 , Amount.Style.unit_spaced = Just True
1789 , "\"-$1\" = Right $-1" ~:
1790 (Data.Either.rights $
1792 (Format.Ledger.Read.amount <* P.eof)
1793 () "" ("-$1"::Text)])
1796 { Amount.quantity = Decimal 0 (-1)
1799 { Amount.Style.fractioning = Nothing
1800 , Amount.Style.grouping_integral = Nothing
1801 , Amount.Style.grouping_fractional = Nothing
1802 , Amount.Style.precision = 0
1803 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1804 , Amount.Style.unit_spaced = Just False
1808 , "\"\\\"4 2\\\"1\" = Right \\\"4 2\\\"1" ~:
1809 (Data.Either.rights $
1811 (Format.Ledger.Read.amount <* P.eof)
1812 () "" ("\"4 2\"1"::Text)])
1815 { Amount.quantity = Decimal 0 1
1818 { Amount.Style.fractioning = Nothing
1819 , Amount.Style.grouping_integral = Nothing
1820 , Amount.Style.grouping_fractional = Nothing
1821 , Amount.Style.precision = 0
1822 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1823 , Amount.Style.unit_spaced = Just False
1825 , Amount.unit = "4 2"
1827 , "\"1\\\"4 2\\\"\" = Right 1\\\"4 2\\\"" ~:
1828 (Data.Either.rights $
1830 (Format.Ledger.Read.amount <* P.eof)
1831 () "" ("1\"4 2\""::Text)])
1834 { Amount.quantity = Decimal 0 1
1837 { Amount.Style.fractioning = Nothing
1838 , Amount.Style.grouping_integral = Nothing
1839 , Amount.Style.grouping_fractional = Nothing
1840 , Amount.Style.precision = 0
1841 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1842 , Amount.Style.unit_spaced = Just False
1844 , Amount.unit = "4 2"
1846 , "\"$1.000,00\" = Right $1.000,00" ~:
1847 (Data.Either.rights $
1849 (Format.Ledger.Read.amount <* P.eof)
1850 () "" ("$1.000,00"::Text)])
1853 { Amount.quantity = Decimal 0 1000
1856 { Amount.Style.fractioning = Just ','
1857 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1858 , Amount.Style.grouping_fractional = Nothing
1859 , Amount.Style.precision = 2
1860 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1861 , Amount.Style.unit_spaced = Just False
1865 , "\"1.000,00$\" = Right 1.000,00$" ~:
1866 (Data.Either.rights $
1868 (Format.Ledger.Read.amount <* P.eof)
1869 () "" ("1.000,00$"::Text)])
1872 { Amount.quantity = Decimal 0 1000
1875 { Amount.Style.fractioning = Just ','
1876 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1877 , Amount.Style.grouping_fractional = Nothing
1878 , Amount.Style.precision = 2
1879 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1880 , Amount.Style.unit_spaced = Just False
1885 , "comment" ~: TestList
1886 [ "; some comment = Right \" some comment\"" ~:
1887 (Data.Either.rights $
1889 (Format.Ledger.Read.comment <* P.eof)
1890 () "" ("; some comment"::Text)])
1893 , "; some comment \\n = Right \" some comment \"" ~:
1894 (Data.Either.rights $
1896 (Format.Ledger.Read.comment <* P.newline <* P.eof)
1897 () "" ("; some comment \n"::Text)])
1899 [ " some comment " ]
1900 , "; some comment \\r\\n = Right \" some comment \"" ~:
1901 (Data.Either.rights $
1903 (Format.Ledger.Read.comment <* P.string "\r\n" <* P.eof)
1904 () "" ("; some comment \r\n"::Text)])
1906 [ " some comment " ]
1908 , "comments" ~: TestList
1909 [ "; some comment\\n ; some other comment = Right [\" some comment\", \" some other comment\"]" ~:
1910 (Data.Either.rights $
1912 (Format.Ledger.Read.comments <* P.eof)
1913 () "" ("; some comment\n ; some other comment"::Text)])
1915 [ [" some comment", " some other comment"] ]
1916 , "; some comment \\n = Right \" some comment \"" ~:
1917 (Data.Either.rights $
1919 (Format.Ledger.Read.comments <* P.string "\n" <* P.eof)
1920 () "" ("; some comment \n"::Text)])
1922 [ [" some comment "] ]
1924 , "date" ~: TestList
1926 (Data.Either.rights $
1928 (Format.Ledger.Read.date Nothing <* P.eof)
1929 () "" ("2000/01/01"::Text)])
1933 (Time.fromGregorian 2000 01 01)
1934 (Time.TimeOfDay 0 0 0))
1936 , "2000/01/01 some text" ~:
1937 (Data.Either.rights $
1939 (Format.Ledger.Read.date Nothing)
1940 () "" ("2000/01/01 some text"::Text)])
1944 (Time.fromGregorian 2000 01 01)
1945 (Time.TimeOfDay 0 0 0))
1947 , "2000/01/01 12:34" ~:
1948 (Data.Either.rights $
1950 (Format.Ledger.Read.date Nothing <* P.eof)
1951 () "" ("2000/01/01 12:34"::Text)])
1955 (Time.fromGregorian 2000 01 01)
1956 (Time.TimeOfDay 12 34 0))
1958 , "2000/01/01 12:34:56" ~:
1959 (Data.Either.rights $
1961 (Format.Ledger.Read.date Nothing <* P.eof)
1962 () "" ("2000/01/01 12:34:56"::Text)])
1966 (Time.fromGregorian 2000 01 01)
1967 (Time.TimeOfDay 12 34 56))
1969 , "2000/01/01 12:34 CET" ~:
1970 (Data.Either.rights $
1972 (Format.Ledger.Read.date Nothing <* P.eof)
1973 () "" ("2000/01/01 12:34 CET"::Text)])
1977 (Time.fromGregorian 2000 01 01)
1978 (Time.TimeOfDay 12 34 0))
1979 (Time.TimeZone 60 True "CET")]
1980 , "2000/01/01 12:34 +0130" ~:
1981 (Data.Either.rights $
1983 (Format.Ledger.Read.date Nothing <* P.eof)
1984 () "" ("2000/01/01 12:34 +0130"::Text)])
1988 (Time.fromGregorian 2000 01 01)
1989 (Time.TimeOfDay 12 34 0))
1990 (Time.TimeZone 90 False "+0130")]
1991 , "2000/01/01 12:34:56 CET" ~:
1992 (Data.Either.rights $
1994 (Format.Ledger.Read.date Nothing <* P.eof)
1995 () "" ("2000/01/01 12:34:56 CET"::Text)])
1999 (Time.fromGregorian 2000 01 01)
2000 (Time.TimeOfDay 12 34 56))
2001 (Time.TimeZone 60 True "CET")]
2003 (Data.Either.rights $
2005 (Format.Ledger.Read.date Nothing <* P.eof)
2006 () "" ("2001/02/29"::Text)])
2010 (Data.Either.rights $
2012 (Format.Ledger.Read.date (Just 2000) <* P.eof)
2013 () "" ("01/01"::Text)])
2017 (Time.fromGregorian 2000 01 01)
2018 (Time.TimeOfDay 0 0 0))
2021 , "tag_value" ~: TestList
2023 (Data.Either.rights $
2025 (Format.Ledger.Read.tag_value <* P.eof)
2030 (Data.Either.rights $
2032 (Format.Ledger.Read.tag_value <* P.char '\n' <* P.eof)
2033 () "" (",\n"::Text)])
2037 (Data.Either.rights $
2039 (Format.Ledger.Read.tag_value <* P.eof)
2040 () "" (",x"::Text)])
2044 (Data.Either.rights $
2046 (Format.Ledger.Read.tag_value <* P.string ",x:" <* P.eof)
2047 () "" (",x:"::Text)])
2051 (Data.Either.rights $
2053 (Format.Ledger.Read.tag_value <* P.string ", n:" <* P.eof)
2054 () "" ("v, v, n:"::Text)])
2060 (Data.Either.rights $
2062 (Format.Ledger.Read.tag <* P.eof)
2063 () "" ("Name:"::Text)])
2067 (Data.Either.rights $
2069 (Format.Ledger.Read.tag <* P.eof)
2070 () "" ("Name:Value"::Text)])
2073 , "Name:Value\\n" ~:
2074 (Data.Either.rights $
2076 (Format.Ledger.Read.tag <* P.string "\n" <* P.eof)
2077 () "" ("Name:Value\n"::Text)])
2081 (Data.Either.rights $
2083 (Format.Ledger.Read.tag <* P.eof)
2084 () "" ("Name:Val ue"::Text)])
2086 [("Name", "Val ue")]
2088 (Data.Either.rights $
2090 (Format.Ledger.Read.tag <* P.eof)
2091 () "" ("Name:,"::Text)])
2095 (Data.Either.rights $
2097 (Format.Ledger.Read.tag <* P.eof)
2098 () "" ("Name:Val,ue"::Text)])
2100 [("Name", "Val,ue")]
2102 (Data.Either.rights $
2104 (Format.Ledger.Read.tag <* P.string ",ue:" <* P.eof)
2105 () "" ("Name:Val,ue:"::Text)])
2109 , "tags" ~: TestList
2111 (Data.Either.rights $
2113 (Format.Ledger.Read.tags <* P.eof)
2114 () "" ("Name:"::Text)])
2121 (Data.Either.rights $
2123 (Format.Ledger.Read.tags <* P.eof)
2124 () "" ("Name:,"::Text)])
2131 (Data.Either.rights $
2133 (Format.Ledger.Read.tags <* P.eof)
2134 () "" ("Name:,Name:"::Text)])
2137 [ ("Name", ["", ""])
2141 (Data.Either.rights $
2143 (Format.Ledger.Read.tags <* P.eof)
2144 () "" ("Name:,Name2:"::Text)])
2151 , "Name: , Name2:" ~:
2152 (Data.Either.rights $
2154 (Format.Ledger.Read.tags <* P.eof)
2155 () "" ("Name: , Name2:"::Text)])
2162 , "Name:,Name2:,Name3:" ~:
2163 (Data.Either.rights $
2165 (Format.Ledger.Read.tags <* P.eof)
2166 () "" ("Name:,Name2:,Name3:"::Text)])
2174 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ~:
2175 (Data.Either.rights $
2177 (Format.Ledger.Read.tags <* P.eof)
2178 () "" ("Name:Val ue,Name2:V a l u e,Name3:V al ue"::Text)])
2181 [ ("Name", ["Val ue"])
2182 , ("Name2", ["V a l u e"])
2183 , ("Name3", ["V al ue"])
2187 , "posting" ~: TestList
2188 [ " A:B:C = Right A:B:C" ~:
2189 (Data.Either.rights $
2191 (Format.Ledger.Read.posting <* P.eof)
2192 Format.Ledger.Read.nil_Context "" (" A:B:C"::Text)])
2194 [ ( (Posting.nil ("A":|["B", "C"]))
2195 { Posting.sourcepos = P.newPos "" 1 1
2197 , Posting.Type_Regular
2200 , " !A:B:C = Right !A:B:C" ~:
2201 (Data.List.map fst $
2202 Data.Either.rights $
2204 (Format.Ledger.Read.posting <* P.eof)
2205 Format.Ledger.Read.nil_Context "" (" !A:B:C"::Text)])
2207 [ (Posting.nil ("A":|["B", "C"]))
2208 { Posting.sourcepos = P.newPos "" 1 1
2209 , Posting.status = True
2212 , " *A:B:C = Right *A:B:C" ~:
2213 (Data.List.map fst $
2214 Data.Either.rights $
2216 (Format.Ledger.Read.posting <* P.eof)
2217 Format.Ledger.Read.nil_Context "" (" *A:B:C"::Text)])
2219 [ (Posting.nil ("A":|["B", "C"]))
2220 { Posting.amounts = Data.Map.fromList []
2221 , Posting.comments = []
2222 , Posting.dates = []
2223 , Posting.status = True
2224 , Posting.sourcepos = P.newPos "" 1 1
2225 , Posting.tags = Data.Map.fromList []
2228 , " A:B:C $1 = Right A:B:C $1" ~:
2229 (Data.List.map fst $
2230 Data.Either.rights $
2232 (Format.Ledger.Read.posting <* P.eof)
2233 Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
2235 [ (Posting.nil ("A":|["B","C $1"]))
2236 { Posting.sourcepos = P.newPos "" 1 1
2239 , " A:B:C $1 = Right A:B:C $1" ~:
2240 (Data.List.map fst $
2241 Data.Either.rights $
2243 (Format.Ledger.Read.posting <* P.eof)
2244 Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
2246 [ (Posting.nil ("A":|["B", "C"]))
2247 { Posting.amounts = Data.Map.fromList
2249 { Amount.quantity = 1
2250 , Amount.style = Amount.Style.nil
2251 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2252 , Amount.Style.unit_spaced = Just False
2257 , Posting.sourcepos = P.newPos "" 1 1
2260 , " A:B:C $1 + 1€ = Right A:B:C $1 + 1€" ~:
2261 (Data.List.map fst $
2262 Data.Either.rights $
2264 (Format.Ledger.Read.posting <* P.eof)
2265 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1€"::Text)])
2267 [ (Posting.nil ("A":|["B", "C"]))
2268 { Posting.amounts = Data.Map.fromList
2270 { Amount.quantity = 1
2271 , Amount.style = Amount.Style.nil
2272 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2273 , Amount.Style.unit_spaced = Just False
2278 { Amount.quantity = 1
2279 , Amount.style = Amount.Style.nil
2280 { Amount.Style.unit_side = Just Amount.Style.Side_Right
2281 , Amount.Style.unit_spaced = Just False
2286 , Posting.sourcepos = P.newPos "" 1 1
2289 , " A:B:C $1 + 1$ = Right A:B:C $2" ~:
2290 (Data.List.map fst $
2291 Data.Either.rights $
2293 (Format.Ledger.Read.posting <* P.eof)
2294 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1$"::Text)])
2296 [ (Posting.nil ("A":|["B", "C"]))
2297 { Posting.amounts = Data.Map.fromList
2299 { Amount.quantity = 2
2300 , Amount.style = Amount.Style.nil
2301 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2302 , Amount.Style.unit_spaced = Just False
2307 , Posting.sourcepos = P.newPos "" 1 1
2310 , " A:B:C $1 + 1$ + 1$ = Right A:B:C $3" ~:
2311 (Data.List.map fst $
2312 Data.Either.rights $
2314 (Format.Ledger.Read.posting <* P.eof)
2315 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1$ + 1$"::Text)])
2317 [ (Posting.nil ("A":|["B", "C"]))
2318 { Posting.amounts = Data.Map.fromList
2320 { Amount.quantity = 3
2321 , Amount.style = Amount.Style.nil
2322 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2323 , Amount.Style.unit_spaced = Just False
2328 , Posting.sourcepos = P.newPos "" 1 1
2331 , " A:B:C ; some comment = Right A:B:C ; some comment" ~:
2332 (Data.List.map fst $
2333 Data.Either.rights $
2335 (Format.Ledger.Read.posting <* P.eof)
2336 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment"::Text)])
2338 [ (Posting.nil ("A":|["B", "C"]))
2339 { Posting.amounts = Data.Map.fromList []
2340 , Posting.comments = [" some comment"]
2341 , Posting.sourcepos = P.newPos "" 1 1
2344 , " A:B:C ; some comment\\n ; some other comment = Right A:B:C ; some comment\\n ; some other comment" ~:
2345 (Data.List.map fst $
2346 Data.Either.rights $
2348 (Format.Ledger.Read.posting <* P.eof)
2349 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment\n ; some other comment"::Text)])
2351 [ (Posting.nil ("A":|["B", "C"]))
2352 { Posting.amounts = Data.Map.fromList []
2353 , Posting.comments = [" some comment", " some other comment"]
2354 , Posting.sourcepos = P.newPos "" 1 1
2357 , " A:B:C $1 ; some comment = Right A:B:C $1 ; some comment" ~:
2358 (Data.List.map fst $
2359 Data.Either.rights $
2361 (Format.Ledger.Read.posting)
2362 Format.Ledger.Read.nil_Context "" (" A:B:C $1 ; some comment"::Text)])
2364 [ (Posting.nil ("A":|["B", "C"]))
2365 { Posting.amounts = Data.Map.fromList
2367 { Amount.quantity = 1
2368 , Amount.style = Amount.Style.nil
2369 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2370 , Amount.Style.unit_spaced = Just False
2375 , Posting.comments = [" some comment"]
2376 , Posting.sourcepos = P.newPos "" 1 1
2379 , " A:B:C ; N:V = Right A:B:C ; N:V" ~:
2380 (Data.List.map fst $
2381 Data.Either.rights $
2383 (Format.Ledger.Read.posting <* P.eof)
2384 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V"::Text)])
2386 [ (Posting.nil ("A":|["B", "C"]))
2387 { Posting.comments = [" N:V"]
2388 , Posting.sourcepos = P.newPos "" 1 1
2389 , Posting.tags = Data.Map.fromList
2394 , " A:B:C ; some comment N:V = Right A:B:C ; some comment N:V" ~:
2395 (Data.List.map fst $
2396 Data.Either.rights $
2398 (Format.Ledger.Read.posting <* P.eof)
2399 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V"::Text)])
2401 [ (Posting.nil ("A":|["B", "C"]))
2402 { Posting.comments = [" some comment N:V"]
2403 , Posting.sourcepos = P.newPos "" 1 1
2404 , Posting.tags = Data.Map.fromList
2409 , " A:B:C ; some comment N:V v, N2:V2 v2 = Right A:B:C ; some comment N:V v, N2:V2 v2" ~:
2410 (Data.List.map fst $
2411 Data.Either.rights $
2413 (Format.Ledger.Read.posting )
2414 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V v, N2:V2 v2"::Text)])
2416 [ (Posting.nil ("A":|["B", "C"]))
2417 { Posting.comments = [" some comment N:V v, N2:V2 v2"]
2418 , Posting.sourcepos = P.newPos "" 1 1
2419 , Posting.tags = Data.Map.fromList
2425 , " A:B:C ; N:V\\n ; N:V2 = Right A:B:C ; N:V\\n ; N:V2" ~:
2426 (Data.List.map fst $
2427 Data.Either.rights $
2429 (Format.Ledger.Read.posting <* P.eof)
2430 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N:V2"::Text)])
2432 [ (Posting.nil ("A":|["B", "C"]))
2433 { Posting.comments = [" N:V", " N:V2"]
2434 , Posting.sourcepos = P.newPos "" 1 1
2435 , Posting.tags = Data.Map.fromList
2436 [ ("N", ["V", "V2"])
2440 , " A:B:C ; N:V\\n ; N2:V = Right A:B:C ; N:V\\n ; N2:V" ~:
2441 (Data.List.map fst $
2442 Data.Either.rights $
2444 (Format.Ledger.Read.posting <* P.eof)
2445 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N2:V"::Text)])
2447 [ (Posting.nil ("A":|["B", "C"]))
2448 { Posting.comments = [" N:V", " N2:V"]
2449 , Posting.sourcepos = P.newPos "" 1 1
2450 , Posting.tags = Data.Map.fromList
2456 , " A:B:C ; date:2001/01/01 = Right A:B:C ; date:2001/01/01" ~:
2457 (Data.List.map fst $
2458 Data.Either.rights $
2460 (Format.Ledger.Read.posting <* P.eof)
2461 Format.Ledger.Read.nil_Context "" (" A:B:C ; date:2001/01/01"::Text)])
2463 [ (Posting.nil ("A":|["B", "C"]))
2464 { Posting.comments = [" date:2001/01/01"]
2468 (Time.fromGregorian 2001 01 01)
2469 (Time.TimeOfDay 0 0 0))
2472 , Posting.sourcepos = P.newPos "" 1 1
2473 , Posting.tags = Data.Map.fromList
2474 [ ("date", ["2001/01/01"])
2478 , " (A:B:C) = Right (A:B:C)" ~:
2479 (Data.Either.rights $
2481 (Format.Ledger.Read.posting <* P.eof)
2482 Format.Ledger.Read.nil_Context "" (" (A:B:C)"::Text)])
2484 [ ( (Posting.nil ("A":|["B", "C"]))
2485 { Posting.sourcepos = P.newPos "" 1 1
2487 , Posting.Type_Virtual
2490 , " [A:B:C] = Right [A:B:C]" ~:
2491 (Data.Either.rights $
2493 (Format.Ledger.Read.posting <* P.eof)
2494 Format.Ledger.Read.nil_Context "" (" [A:B:C]"::Text)])
2496 [ ( (Posting.nil ("A":|["B", "C"]))
2497 { Posting.sourcepos = P.newPos "" 1 1
2499 , Posting.Type_Virtual_Balanced
2503 , "transaction" ~: TestList
2504 [ "2000/01/01 some description\\n A:B:C $1\\n a:b:c" ~:
2505 (Data.Either.rights $
2507 (Format.Ledger.Read.transaction <* P.eof)
2508 Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C $1\n a:b:c"::Text)])
2511 { Transaction.dates=
2514 (Time.fromGregorian 2000 01 01)
2515 (Time.TimeOfDay 0 0 0))
2518 , Transaction.description="some description"
2519 , Transaction.postings = Posting.from_List
2520 [ (Posting.nil ("A":|["B", "C"]))
2521 { Posting.amounts = Data.Map.fromList
2523 { Amount.quantity = 1
2524 , Amount.style = Amount.Style.nil
2525 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2526 , Amount.Style.unit_spaced = Just False
2531 , Posting.sourcepos = P.newPos "" 2 1
2533 , (Posting.nil ("a":|["b", "c"]))
2534 { Posting.sourcepos = P.newPos "" 3 1
2537 , Transaction.sourcepos = P.newPos "" 1 1
2540 , "2000/01/01 some description\\n A:B:C $1\\n a:b:c\\n" ~:
2541 (Data.Either.rights $
2543 (Format.Ledger.Read.transaction <* P.newline <* P.eof)
2544 Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C $1\n a:b:c\n"::Text)])
2547 { Transaction.dates=
2550 (Time.fromGregorian 2000 01 01)
2551 (Time.TimeOfDay 0 0 0))
2554 , Transaction.description="some description"
2555 , Transaction.postings = Posting.from_List
2556 [ (Posting.nil ("A":|["B", "C"]))
2557 { Posting.amounts = Data.Map.fromList
2559 { Amount.quantity = 1
2560 , Amount.style = Amount.Style.nil
2561 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2562 , Amount.Style.unit_spaced = Just False
2567 , Posting.sourcepos = P.newPos "" 2 1
2569 , (Posting.nil ("a":|["b", "c"]))
2570 { Posting.sourcepos = P.newPos "" 3 1
2573 , Transaction.sourcepos = P.newPos "" 1 1
2576 , "2000/01/01 some description ; some comment\\n ; some other;comment\\n ; some Tag:\\n ; some last comment\\n A:B:C $1\\n a:b:c" ~:
2577 (Data.Either.rights $
2579 (Format.Ledger.Read.transaction <* P.eof)
2580 Format.Ledger.Read.nil_Context "" ("2000/01/01 some description ; some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C $1\n a:b:c"::Text)])
2583 { Transaction.comments_after =
2585 , " some other;comment"
2587 , " some last comment"
2589 , Transaction.dates=
2592 (Time.fromGregorian 2000 01 01)
2593 (Time.TimeOfDay 0 0 0))
2596 , Transaction.description="some description"
2597 , Transaction.postings = Posting.from_List
2598 [ (Posting.nil ("A":|["B", "C"]))
2599 { Posting.amounts = Data.Map.fromList
2601 { Amount.quantity = 1
2602 , Amount.style = Amount.Style.nil
2603 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2604 , Amount.Style.unit_spaced = Just False
2609 , Posting.sourcepos = P.newPos "" 5 1
2611 , (Posting.nil ("a":|["b", "c"]))
2612 { Posting.sourcepos = P.newPos "" 6 1
2613 , Posting.tags = Data.Map.fromList []
2616 , Transaction.sourcepos = P.newPos "" 1 1
2617 , Transaction.tags = Data.Map.fromList
2623 , "journal" ~: TestList
2624 [ "2000/01/01 1° description\\n A:B:C $1\\n a:b:c\\n2000/01/02 2° description\\n A:B:C $1\\n x:y:z" ~: TestCase $ do
2627 (Format.Ledger.Read.journal "" {-<* P.eof-})
2628 Format.Ledger.Read.nil_Context "" ("2000/01/01 1° description\n A:B:C $1\n a:b:c\n2000/01/02 2° description\n A:B:C $1\n x:y:z"::Text)
2630 (\j -> j{Format.Ledger.Journal.last_read_time=
2631 Format.Ledger.Journal.last_read_time Format.Ledger.Journal.nil}) $
2632 Data.Either.rights [jnl])
2634 [ Format.Ledger.Journal.nil
2635 { Format.Ledger.Journal.transactions = Transaction.from_List
2637 { Transaction.dates=
2640 (Time.fromGregorian 2000 01 01)
2641 (Time.TimeOfDay 0 0 0))
2644 , Transaction.description="1° description"
2645 , Transaction.postings = Posting.from_List
2646 [ (Posting.nil ("A":|["B", "C"]))
2647 { Posting.amounts = Data.Map.fromList
2649 { Amount.quantity = 1
2650 , Amount.style = Amount.Style.nil
2651 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2652 , Amount.Style.unit_spaced = Just False
2657 , Posting.sourcepos = P.newPos "" 2 1
2659 , (Posting.nil ("a":|["b", "c"]))
2660 { Posting.sourcepos = P.newPos "" 3 1
2663 , Transaction.sourcepos = P.newPos "" 1 1
2666 { Transaction.dates=
2669 (Time.fromGregorian 2000 01 02)
2670 (Time.TimeOfDay 0 0 0))
2673 , Transaction.description="2° description"
2674 , Transaction.postings = Posting.from_List
2675 [ (Posting.nil ("A":|["B", "C"]))
2676 { Posting.amounts = Data.Map.fromList
2678 { Amount.quantity = 1
2679 , Amount.style = Amount.Style.nil
2680 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2681 , Amount.Style.unit_spaced = Just False
2686 , Posting.sourcepos = P.newPos "" 5 1
2688 , (Posting.nil ("x":|["y", "z"]))
2689 { Posting.sourcepos = P.newPos "" 6 1
2692 , Transaction.sourcepos = P.newPos "" 4 1
2699 , "Write" ~: TestList
2700 [ "account" ~: TestList
2702 ((Format.Ledger.Write.show False $
2703 Format.Ledger.Write.account Posting.Type_Regular $
2708 ((Format.Ledger.Write.show False $
2709 Format.Ledger.Write.account Posting.Type_Regular $
2714 ((Format.Ledger.Write.show False $
2715 Format.Ledger.Write.account Posting.Type_Virtual $
2720 ((Format.Ledger.Write.show False $
2721 Format.Ledger.Write.account Posting.Type_Virtual_Balanced $
2726 , "amount" ~: TestList
2728 ((Format.Ledger.Write.show False $
2729 Format.Ledger.Write.amount
2734 ((Format.Ledger.Write.show False $
2735 Format.Ledger.Write.amount
2737 { Amount.style = Amount.Style.nil
2738 { Amount.Style.precision = 2 }
2743 ((Format.Ledger.Write.show False $
2744 Format.Ledger.Write.amount
2746 { Amount.quantity = Decimal 0 123
2751 ((Format.Ledger.Write.show False $
2752 Format.Ledger.Write.amount
2754 { Amount.quantity = Decimal 0 (- 123)
2758 , "12.3 @ prec=0" ~:
2759 ((Format.Ledger.Write.show False $
2760 Format.Ledger.Write.amount
2762 { Amount.quantity = Decimal 1 123
2763 , Amount.style = Amount.Style.nil
2764 { Amount.Style.fractioning = Just '.'
2769 , "12.5 @ prec=0" ~:
2770 ((Format.Ledger.Write.show False $
2771 Format.Ledger.Write.amount
2773 { Amount.quantity = Decimal 1 125
2774 , Amount.style = Amount.Style.nil
2775 { Amount.Style.fractioning = Just '.'
2780 , "12.3 @ prec=1" ~:
2781 ((Format.Ledger.Write.show False $
2782 Format.Ledger.Write.amount
2784 { Amount.quantity = Decimal 1 123
2785 , Amount.style = Amount.Style.nil
2786 { Amount.Style.fractioning = Just '.'
2787 , Amount.Style.precision = 1
2792 , "1,234.56 @ prec=2" ~:
2793 ((Format.Ledger.Write.show False $
2794 Format.Ledger.Write.amount
2796 { Amount.quantity = Decimal 2 123456
2797 , Amount.style = Amount.Style.nil
2798 { Amount.Style.fractioning = Just '.'
2799 , Amount.Style.precision = 2
2800 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
2805 , "123,456,789,01,2.3456789 @ prec=7" ~:
2806 ((Format.Ledger.Write.show False $
2807 Format.Ledger.Write.amount
2809 { Amount.quantity = Decimal 7 1234567890123456789
2810 , Amount.style = Amount.Style.nil
2811 { Amount.Style.fractioning = Just '.'
2812 , Amount.Style.precision = 7
2813 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
2817 "123,456,789,01,2.3456789")
2818 , "1234567.8,90,123,456,789 @ prec=12" ~:
2819 ((Format.Ledger.Write.show False $
2820 Format.Ledger.Write.amount
2822 { Amount.quantity = Decimal 12 1234567890123456789
2823 , Amount.style = Amount.Style.nil
2824 { Amount.Style.fractioning = Just '.'
2825 , Amount.Style.precision = 12
2826 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
2830 "1234567.8,90,123,456,789")
2831 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
2832 ((Format.Ledger.Write.show False $
2833 Format.Ledger.Write.amount
2835 { Amount.quantity = Decimal 7 1234567890123456789
2836 , Amount.style = Amount.Style.nil
2837 { Amount.Style.fractioning = Just '.'
2838 , Amount.Style.precision = 7
2839 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
2843 "1,2,3,4,5,6,7,89,012.3456789")
2844 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
2845 ((Format.Ledger.Write.show False $
2846 Format.Ledger.Write.amount
2848 { Amount.quantity = Decimal 12 1234567890123456789
2849 , Amount.style = Amount.Style.nil
2850 { Amount.Style.fractioning = Just '.'
2851 , Amount.Style.precision = 12
2852 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
2856 "1234567.890,12,3,4,5,6,7,8,9")
2858 , "amount_length" ~: TestList
2860 ((Format.Ledger.Write.amount_length
2865 ((Format.Ledger.Write.amount_length
2867 { Amount.style = Amount.Style.nil
2868 { Amount.Style.precision = 2 }
2873 ((Format.Ledger.Write.amount_length
2875 { Amount.quantity = Decimal 0 123
2880 ((Format.Ledger.Write.amount_length
2882 { Amount.quantity = Decimal 0 (- 123)
2886 , "12.3 @ prec=0" ~:
2887 ((Format.Ledger.Write.amount_length
2889 { Amount.quantity = Decimal 1 123
2890 , Amount.style = Amount.Style.nil
2891 { Amount.Style.fractioning = Just '.'
2896 , "12.5 @ prec=0" ~:
2897 ((Format.Ledger.Write.amount_length
2899 { Amount.quantity = Decimal 1 125
2900 , Amount.style = Amount.Style.nil
2901 { Amount.Style.fractioning = Just '.'
2906 , "12.3 @ prec=1" ~:
2907 ((Format.Ledger.Write.amount_length
2909 { Amount.quantity = Decimal 1 123
2910 , Amount.style = Amount.Style.nil
2911 { Amount.Style.fractioning = Just '.'
2912 , Amount.Style.precision = 1
2917 , "1,234.56 @ prec=2" ~:
2918 ((Format.Ledger.Write.amount_length
2920 { Amount.quantity = Decimal 2 123456
2921 , Amount.style = Amount.Style.nil
2922 { Amount.Style.fractioning = Just '.'
2923 , Amount.Style.precision = 2
2924 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
2929 , "123,456,789,01,2.3456789 @ prec=7" ~:
2930 ((Format.Ledger.Write.amount_length
2932 { Amount.quantity = Decimal 7 1234567890123456789
2933 , Amount.style = Amount.Style.nil
2934 { Amount.Style.fractioning = Just '.'
2935 , Amount.Style.precision = 7
2936 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
2941 , "1234567.8,90,123,456,789 @ prec=12" ~:
2942 ((Format.Ledger.Write.amount_length
2944 { Amount.quantity = Decimal 12 1234567890123456789
2945 , Amount.style = Amount.Style.nil
2946 { Amount.Style.fractioning = Just '.'
2947 , Amount.Style.precision = 12
2948 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
2953 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
2954 ((Format.Ledger.Write.amount_length
2956 { Amount.quantity = Decimal 7 1234567890123456789
2957 , Amount.style = Amount.Style.nil
2958 { Amount.Style.fractioning = Just '.'
2959 , Amount.Style.precision = 7
2960 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
2965 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
2966 ((Format.Ledger.Write.amount_length
2968 { Amount.quantity = Decimal 12 1234567890123456789
2969 , Amount.style = Amount.Style.nil
2970 { Amount.Style.fractioning = Just '.'
2971 , Amount.Style.precision = 12
2972 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
2978 , "date" ~: TestList
2980 ((Format.Ledger.Write.show False $
2981 Format.Ledger.Write.date
2985 , "2000/01/01 12:34:51 CET" ~:
2986 (Format.Ledger.Write.show False $
2987 Format.Ledger.Write.date $
2990 (Time.fromGregorian 2000 01 01)
2991 (Time.TimeOfDay 12 34 51))
2992 (Time.TimeZone 60 False "CET"))
2994 "2000/01/01 12:34:51 CET"
2995 , "2000/01/01 12:34:51 +0100" ~:
2996 (Format.Ledger.Write.show False $
2997 Format.Ledger.Write.date $
3000 (Time.fromGregorian 2000 01 01)
3001 (Time.TimeOfDay 12 34 51))
3002 (Time.TimeZone 60 False ""))
3004 "2000/01/01 12:34:51 +0100"
3005 , "2000/01/01 01:02:03" ~:
3006 (Format.Ledger.Write.show False $
3007 Format.Ledger.Write.date $
3010 (Time.fromGregorian 2000 01 01)
3011 (Time.TimeOfDay 1 2 3))
3014 "2000/01/01 01:02:03"
3016 (Format.Ledger.Write.show False $
3017 Format.Ledger.Write.date $
3020 (Time.fromGregorian 0 01 01)
3021 (Time.TimeOfDay 1 2 0))
3026 (Format.Ledger.Write.show False $
3027 Format.Ledger.Write.date $
3030 (Time.fromGregorian 0 01 01)
3031 (Time.TimeOfDay 1 0 0))
3036 (Format.Ledger.Write.show False $
3037 Format.Ledger.Write.date $
3040 (Time.fromGregorian 0 01 01)
3041 (Time.TimeOfDay 0 1 0))
3046 (Format.Ledger.Write.show False $
3047 Format.Ledger.Write.date $
3050 (Time.fromGregorian 0 01 01)
3051 (Time.TimeOfDay 0 0 0))
3056 , "transaction" ~: TestList
3058 ((Format.Ledger.Write.show False $
3059 Format.Ledger.Write.transaction
3063 , "2000/01/01 some description\\n\\ta:b:c\\n\\t\\t; first comment\\n\\t\\t; second comment\\n\\t\\t; third comment\\n\\tA:B:C $1" ~:
3064 ((Format.Ledger.Write.show False $
3065 Format.Ledger.Write.transaction $
3067 { Transaction.dates=
3070 (Time.fromGregorian 2000 01 01)
3071 (Time.TimeOfDay 0 0 0))
3074 , Transaction.description="some description"
3075 , Transaction.postings = Posting.from_List
3076 [ (Posting.nil ("A":|["B", "C"]))
3077 { Posting.amounts = Data.Map.fromList
3079 { Amount.quantity = 1
3080 , Amount.style = Amount.Style.nil
3081 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3082 , Amount.Style.unit_spaced = Just False
3088 , (Posting.nil ("a":|["b", "c"]))
3089 { Posting.comments = ["first comment","second comment","third comment"]
3094 "2000/01/01 some description\n\ta:b:c\n\t\t; first comment\n\t\t; second comment\n\t\t; third comment\n\tA:B:C $1")
3095 , "2000/01/01 some description\\n\\tA:B:C $1\\n\\tAA:BB:CC $123" ~:
3096 ((Format.Ledger.Write.show False $
3097 Format.Ledger.Write.transaction $
3099 { Transaction.dates=
3102 (Time.fromGregorian 2000 01 01)
3103 (Time.TimeOfDay 0 0 0))
3106 , Transaction.description="some description"
3107 , Transaction.postings = Posting.from_List
3108 [ (Posting.nil ("A":|["B", "C"]))
3109 { Posting.amounts = Data.Map.fromList
3111 { Amount.quantity = 1
3112 , Amount.style = Amount.Style.nil
3113 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3114 , Amount.Style.unit_spaced = Just False
3120 , (Posting.nil ("AA":|["BB", "CC"]))
3121 { Posting.amounts = Data.Map.fromList
3123 { Amount.quantity = 123
3124 , Amount.style = Amount.Style.nil
3125 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3126 , Amount.Style.unit_spaced = Just False
3135 "2000/01/01 some description\n\tA:B:C $1\n\tAA:BB:CC $123")