1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE TupleSections #-}
5 import Test.HUnit hiding ((~?))
6 import Test.Framework.Providers.HUnit (hUnitTestToTests)
7 import Test.Framework.Runners.Console (defaultMain)
9 import Control.Applicative ((<*))
10 import Control.Arrow ((***))
11 import Control.Monad.IO.Class (liftIO)
12 import Data.Decimal (DecimalRaw(..))
13 import qualified Data.Either
14 import qualified Data.List
15 import Data.List.NonEmpty (NonEmpty(..))
16 import qualified Data.Map.Strict as Data.Map
17 import Data.Text (Text)
18 import qualified Data.Time.Calendar as Time
19 import qualified Data.Time.LocalTime as Time
20 import qualified Text.Parsec as P hiding (char, space, spaces, string)
21 import qualified Text.Parsec.Pos as P
22 -- import qualified Text.PrettyPrint.Leijen.Text as PP
24 import qualified Hcompta.Account as Account
25 import Hcompta.Account (Account)
26 import qualified Hcompta.Amount as Amount
27 import Hcompta.Amount (Amount)
28 import qualified Hcompta.Amount.Read as Amount.Read
29 import qualified Hcompta.Amount.Style as Amount.Style
30 import qualified Hcompta.Date as Date
31 import qualified Hcompta.Date.Read as Date.Read
32 import qualified Hcompta.Filter as Filter
33 import qualified Hcompta.Filter.Read as Filter.Read
34 import qualified Hcompta.Balance as Balance
35 import qualified Hcompta.Format.Ledger as Format.Ledger
36 import qualified Hcompta.Format.Ledger.Read as Format.Ledger.Read
37 import qualified Hcompta.Format.Ledger.Write as Format.Ledger.Write
38 import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
39 import qualified Hcompta.Lib.Parsec as P
40 import qualified Hcompta.Lib.Foldable as Lib.Foldable
43 main = defaultMain $ hUnitTestToTests test_Hcompta
45 (~?) :: String -> Bool -> Test
46 (~?) s b = s ~: (b ~?= True)
52 [ "TreeMap" ~: TestList
53 [ "insert" ~: TestList
55 (Lib.TreeMap.insert const ((0::Int):|[]) () Lib.TreeMap.empty)
57 (Lib.TreeMap.TreeMap $
59 [ ((0::Int), Lib.TreeMap.leaf ())
62 (Lib.TreeMap.insert const ((0::Int):|1:[]) () Lib.TreeMap.empty)
64 (Lib.TreeMap.TreeMap $
66 [ ((0::Int), Lib.TreeMap.Node
67 { Lib.TreeMap.node_value = Nothing
68 , Lib.TreeMap.node_size = 1
69 , Lib.TreeMap.node_descendants =
70 Lib.TreeMap.singleton ((1::Int):|[]) ()
77 , "map_by_depth_first" ~: TestList
80 , "flatten" ~: TestList
81 [ "[0, 0/1, 0/1/2]" ~:
82 (Lib.TreeMap.flatten id $
83 Lib.TreeMap.from_List const
84 [ (((0::Integer):|[]), ())
95 , "[1, 1/2, 1/22, 1/2/3, 1/2/33, 11, 11/2, 11/2/3, 11/2/33]" ~:
96 (Lib.TreeMap.flatten id $
97 Lib.TreeMap.from_List const
106 , ((11:|2:33:[]), ())
111 [ (((1::Integer):|[]), ())
119 , ((11:|2:33:[]), ())
123 , "Foldable" ~: TestList
124 [ "accumLeftsAndFoldrRights" ~: TestList
126 (Lib.Foldable.accumLeftsAndFoldrRights (++) [""] $
129 (([(0::Integer)], [(""::String)]))
131 ((take 1 *** take 0) $
132 Lib.Foldable.accumLeftsAndFoldrRights (++) [""] $
133 ( repeat (Left [0]) ))
135 ([(0::Integer)], ([]::[String]))
136 , "Right:Left:Right:Left" ~:
137 (Lib.Foldable.accumLeftsAndFoldrRights (++) ["0"] $
138 ( Right ["2"]:Left [1]:Right ["1"]:Left [0]:[] ))
140 (([1, 0]::[Integer]), (["2", "1", "0"]::[String]))
141 , "Right:Left:Right:repeat Left" ~:
142 ((take 1 *** take 2) $
143 Lib.Foldable.accumLeftsAndFoldrRights (++) ["0"] $
144 ( Right ["2"]:Left [1]:Right ["1"]:repeat (Left [0]) ))
146 (([1]::[Integer]), (["2", "1"]::[String]))
150 , "Account" ~: TestList
151 [ "foldr" ~: TestList
153 (reverse $ Account.foldr ("A":|[]) (:) []) ~?= ["A":|[]]
155 (reverse $ Account.foldr ("A":|["B"]) (:) []) ~?= ["A":|[], "A":|["B"]]
157 (reverse $ Account.foldr ("A":|["B", "C"]) (:) []) ~?= ["A":|[], "A":|["B"], "A":|["B", "C"]]
159 , "ascending" ~: TestList
161 Account.ascending ("A":|[]) ~?= Nothing
163 Account.ascending ("A":|["B"]) ~?= Just ("A":|[])
165 Account.ascending ("A":|["B", "C"]) ~?= Just ("A":|["B"])
168 , "Amount" ~: TestList
173 { Amount.quantity = Decimal 0 1
174 , Amount.style = Amount.Style.nil
175 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
180 { Amount.quantity = Decimal 0 1
181 , Amount.style = Amount.Style.nil
182 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
188 { Amount.quantity = Decimal 0 2
189 , Amount.style = Amount.Style.nil
190 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
195 , "from_List" ~: TestList
196 [ "from_List [$1, 1$] = $2" ~:
199 { Amount.quantity = Decimal 0 1
200 , Amount.style = Amount.Style.nil
201 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
206 { Amount.quantity = Decimal 0 1
207 , Amount.style = Amount.Style.nil
208 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
216 { Amount.quantity = Decimal 0 2
217 , Amount.style = Amount.Style.nil
218 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
225 [ "amount" ~: TestList
227 (Data.Either.rights $
229 (Amount.Read.amount <* P.eof)
233 , "\"0\" = Right 0" ~:
234 (Data.Either.rights $
236 (Amount.Read.amount <* P.eof)
240 { Amount.quantity = Decimal 0 0
242 , "\"00\" = Right 0" ~:
243 (Data.Either.rights $
245 (Amount.Read.amount <* P.eof)
249 { Amount.quantity = Decimal 0 0
251 , "\"0.\" = Right 0." ~:
252 (Data.Either.rights $
254 (Amount.Read.amount <* P.eof)
258 { Amount.quantity = Decimal 0 0
261 { Amount.Style.fractioning = Just '.'
264 , "\".0\" = Right 0.0" ~:
265 (Data.Either.rights $
267 (Amount.Read.amount <* P.eof)
271 { Amount.quantity = Decimal 0 0
274 { Amount.Style.fractioning = Just '.'
275 , Amount.Style.precision = 1
278 , "\"0,\" = Right 0," ~:
279 (Data.Either.rights $
281 (Amount.Read.amount <* P.eof)
285 { Amount.quantity = Decimal 0 0
288 { Amount.Style.fractioning = Just ','
291 , "\",0\" = Right 0,0" ~:
292 (Data.Either.rights $
294 (Amount.Read.amount <* P.eof)
298 { Amount.quantity = Decimal 0 0
301 { Amount.Style.fractioning = Just ','
302 , Amount.Style.precision = 1
306 (Data.Either.rights $
308 (Amount.Read.amount <* P.eof)
313 (Data.Either.rights $
315 (Amount.Read.amount <* P.eof)
319 , "\"0.0\" = Right 0.0" ~:
320 (Data.Either.rights $
322 (Amount.Read.amount <* P.eof)
323 () "" ("0.0"::Text)])
326 { Amount.quantity = Decimal 0 0
329 { Amount.Style.fractioning = Just '.'
330 , Amount.Style.precision = 1
333 , "\"00.00\" = Right 0.00" ~:
334 (Data.Either.rights $
336 (Amount.Read.amount <* P.eof)
337 () "" ("00.00"::Text)])
340 { Amount.quantity = Decimal 0 0
343 { Amount.Style.fractioning = Just '.'
344 , Amount.Style.precision = 2
347 , "\"0,0\" = Right 0,0" ~:
348 (Data.Either.rights $
350 (Amount.Read.amount <* P.eof)
351 () "" ("0,0"::Text)])
354 { Amount.quantity = Decimal 0 0
357 { Amount.Style.fractioning = Just ','
358 , Amount.Style.precision = 1
361 , "\"00,00\" = Right 0,00" ~:
362 (Data.Either.rights $
364 (Amount.Read.amount <* P.eof)
365 () "" ("00,00"::Text)])
368 { Amount.quantity = Decimal 0 0
371 { Amount.Style.fractioning = Just ','
372 , Amount.Style.precision = 2
375 , "\"0_0\" = Right 0" ~:
376 (Data.Either.rights $
378 (Amount.Read.amount <* P.eof)
379 () "" ("0_0"::Text)])
382 { Amount.quantity = Decimal 0 0
385 { Amount.Style.fractioning = Nothing
386 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
387 , Amount.Style.precision = 0
390 , "\"00_00\" = Right 0" ~:
391 (Data.Either.rights $
393 (Amount.Read.amount <* P.eof)
394 () "" ("00_00"::Text)])
397 { Amount.quantity = Decimal 0 0
400 { Amount.Style.fractioning = Nothing
401 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
402 , Amount.Style.precision = 0
405 , "\"0,000.00\" = Right 0,000.00" ~:
406 (Data.Either.rights $
408 (Amount.Read.amount <* P.eof)
409 () "" ("0,000.00"::Text)])
412 { Amount.quantity = Decimal 0 0
415 { Amount.Style.fractioning = Just '.'
416 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
417 , Amount.Style.precision = 2
420 , "\"0.000,00\" = Right 0.000,00" ~:
421 (Data.Either.rights $
424 () "" ("0.000,00"::Text)])
427 { Amount.quantity = Decimal 0 0
430 { Amount.Style.fractioning = Just ','
431 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
432 , Amount.Style.precision = 2
435 , "\"1,000.00\" = Right 1,000.00" ~:
436 (Data.Either.rights $
438 (Amount.Read.amount <* P.eof)
439 () "" ("1,000.00"::Text)])
442 { Amount.quantity = Decimal 0 1000
445 { Amount.Style.fractioning = Just '.'
446 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
447 , Amount.Style.precision = 2
450 , "\"1.000,00\" = Right 1.000,00" ~:
451 (Data.Either.rights $
454 () "" ("1.000,00"::Text)])
457 { Amount.quantity = Decimal 0 1000
460 { Amount.Style.fractioning = Just ','
461 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
462 , Amount.Style.precision = 2
465 , "\"1,000.00.\" = Left" ~:
466 (Data.Either.rights $
469 () "" ("1,000.00."::Text)])
472 , "\"1.000,00,\" = Left" ~:
473 (Data.Either.rights $
476 () "" ("1.000,00,"::Text)])
479 , "\"1,000.00_\" = Left" ~:
480 (Data.Either.rights $
483 () "" ("1,000.00_"::Text)])
486 , "\"12\" = Right 12" ~:
487 (Data.Either.rights $
489 (Amount.Read.amount <* P.eof)
490 () "" ("123"::Text)])
493 { Amount.quantity = Decimal 0 123
495 , "\"1.2\" = Right 1.2" ~:
496 (Data.Either.rights $
498 (Amount.Read.amount <* P.eof)
499 () "" ("1.2"::Text)])
502 { Amount.quantity = Decimal 1 12
505 { Amount.Style.fractioning = Just '.'
506 , Amount.Style.precision = 1
509 , "\"1,2\" = Right 1,2" ~:
510 (Data.Either.rights $
512 (Amount.Read.amount <* P.eof)
513 () "" ("1,2"::Text)])
516 { Amount.quantity = Decimal 1 12
519 { Amount.Style.fractioning = Just ','
520 , Amount.Style.precision = 1
523 , "\"12.23\" = Right 12.23" ~:
524 (Data.Either.rights $
526 (Amount.Read.amount <* P.eof)
527 () "" ("12.34"::Text)])
530 { Amount.quantity = Decimal 2 1234
533 { Amount.Style.fractioning = Just '.'
534 , Amount.Style.precision = 2
537 , "\"12,23\" = Right 12,23" ~:
538 (Data.Either.rights $
540 (Amount.Read.amount <* P.eof)
541 () "" ("12,34"::Text)])
544 { Amount.quantity = Decimal 2 1234
547 { Amount.Style.fractioning = Just ','
548 , Amount.Style.precision = 2
551 , "\"1_2\" = Right 1_2" ~:
552 (Data.Either.rights $
554 (Amount.Read.amount <* P.eof)
555 () "" ("1_2"::Text)])
558 { Amount.quantity = Decimal 0 12
561 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
562 , Amount.Style.precision = 0
565 , "\"1_23\" = Right 1_23" ~:
566 (Data.Either.rights $
568 (Amount.Read.amount <* P.eof)
569 () "" ("1_23"::Text)])
572 { Amount.quantity = Decimal 0 123
575 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
576 , Amount.Style.precision = 0
579 , "\"1_23_456\" = Right 1_23_456" ~:
580 (Data.Either.rights $
582 (Amount.Read.amount <* P.eof)
583 () "" ("1_23_456"::Text)])
586 { Amount.quantity = Decimal 0 123456
589 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
590 , Amount.Style.precision = 0
593 , "\"1_23_456.7890_12345_678901\" = Right 1_23_456.7890_12345_678901" ~:
594 (Data.Either.rights $
596 (Amount.Read.amount <* P.eof)
597 () "" ("1_23_456.7890_12345_678901"::Text)])
600 { Amount.quantity = Decimal 15 123456789012345678901
603 { Amount.Style.fractioning = Just '.'
604 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
605 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [4, 5, 6]
606 , Amount.Style.precision = 15
609 , "\"123456_78901_2345.678_90_1\" = Right 123456_78901_2345.678_90_1" ~:
610 (Data.Either.rights $
612 (Amount.Read.amount <* P.eof)
613 () "" ("123456_78901_2345.678_90_1"::Text)])
616 { Amount.quantity = Decimal 6 123456789012345678901
619 { Amount.Style.fractioning = Just '.'
620 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [4, 5, 6]
621 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [3, 2]
622 , Amount.Style.precision = 6
625 , "\"$1\" = Right $1" ~:
626 (Data.Either.rights $
628 (Amount.Read.amount <* P.eof)
632 { Amount.quantity = Decimal 0 1
635 { Amount.Style.fractioning = Nothing
636 , Amount.Style.grouping_integral = Nothing
637 , Amount.Style.grouping_fractional = Nothing
638 , Amount.Style.precision = 0
639 , Amount.Style.unit_side = Just Amount.Style.Side_Left
640 , Amount.Style.unit_spaced = Just False
644 , "\"1$\" = Right 1$" ~:
645 (Data.Either.rights $
647 (Amount.Read.amount <* P.eof)
651 { Amount.quantity = Decimal 0 1
654 { Amount.Style.fractioning = Nothing
655 , Amount.Style.grouping_integral = Nothing
656 , Amount.Style.grouping_fractional = Nothing
657 , Amount.Style.precision = 0
658 , Amount.Style.unit_side = Just Amount.Style.Side_Right
659 , Amount.Style.unit_spaced = Just False
663 , "\"$ 1\" = Right $ 1" ~:
664 (Data.Either.rights $
666 (Amount.Read.amount <* P.eof)
667 () "" ("$ 1"::Text)])
670 { Amount.quantity = Decimal 0 1
673 { Amount.Style.fractioning = Nothing
674 , Amount.Style.grouping_integral = Nothing
675 , Amount.Style.grouping_fractional = Nothing
676 , Amount.Style.precision = 0
677 , Amount.Style.unit_side = Just Amount.Style.Side_Left
678 , Amount.Style.unit_spaced = Just True
682 , "\"1 $\" = Right 1 $" ~:
683 (Data.Either.rights $
685 (Amount.Read.amount <* P.eof)
686 () "" ("1 $"::Text)])
689 { Amount.quantity = Decimal 0 1
692 { Amount.Style.fractioning = Nothing
693 , Amount.Style.grouping_integral = Nothing
694 , Amount.Style.grouping_fractional = Nothing
695 , Amount.Style.precision = 0
696 , Amount.Style.unit_side = Just Amount.Style.Side_Right
697 , Amount.Style.unit_spaced = Just True
701 , "\"-$1\" = Right $-1" ~:
702 (Data.Either.rights $
704 (Amount.Read.amount <* P.eof)
705 () "" ("-$1"::Text)])
708 { Amount.quantity = Decimal 0 (-1)
711 { Amount.Style.fractioning = Nothing
712 , Amount.Style.grouping_integral = Nothing
713 , Amount.Style.grouping_fractional = Nothing
714 , Amount.Style.precision = 0
715 , Amount.Style.unit_side = Just Amount.Style.Side_Left
716 , Amount.Style.unit_spaced = Just False
720 , "\"\\\"4 2\\\"1\" = Right \\\"4 2\\\"1" ~:
721 (Data.Either.rights $
723 (Amount.Read.amount <* P.eof)
724 () "" ("\"4 2\"1"::Text)])
727 { Amount.quantity = Decimal 0 1
730 { Amount.Style.fractioning = Nothing
731 , Amount.Style.grouping_integral = Nothing
732 , Amount.Style.grouping_fractional = Nothing
733 , Amount.Style.precision = 0
734 , Amount.Style.unit_side = Just Amount.Style.Side_Left
735 , Amount.Style.unit_spaced = Just False
737 , Amount.unit = "4 2"
739 , "\"1\\\"4 2\\\"\" = Right 1\\\"4 2\\\"" ~:
740 (Data.Either.rights $
742 (Amount.Read.amount <* P.eof)
743 () "" ("1\"4 2\""::Text)])
746 { Amount.quantity = Decimal 0 1
749 { Amount.Style.fractioning = Nothing
750 , Amount.Style.grouping_integral = Nothing
751 , Amount.Style.grouping_fractional = Nothing
752 , Amount.Style.precision = 0
753 , Amount.Style.unit_side = Just Amount.Style.Side_Right
754 , Amount.Style.unit_spaced = Just False
756 , Amount.unit = "4 2"
758 , "\"$1.000,00\" = Right $1.000,00" ~:
759 (Data.Either.rights $
761 (Amount.Read.amount <* P.eof)
762 () "" ("$1.000,00"::Text)])
765 { Amount.quantity = Decimal 0 1000
768 { Amount.Style.fractioning = Just ','
769 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
770 , Amount.Style.grouping_fractional = Nothing
771 , Amount.Style.precision = 2
772 , Amount.Style.unit_side = Just Amount.Style.Side_Left
773 , Amount.Style.unit_spaced = Just False
777 , "\"1.000,00$\" = Right 1.000,00$" ~:
778 (Data.Either.rights $
780 (Amount.Read.amount <* P.eof)
781 () "" ("1.000,00$"::Text)])
784 { Amount.quantity = Decimal 0 1000
787 { Amount.Style.fractioning = Just ','
788 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
789 , Amount.Style.grouping_fractional = Nothing
790 , Amount.Style.precision = 2
791 , Amount.Style.unit_side = Just Amount.Style.Side_Right
792 , Amount.Style.unit_spaced = Just False
803 (Data.Either.rights $
804 [P.runParser_with_Error
805 (Date.Read.date id Nothing <* P.eof)
806 () "" ("2000/01/01"::Text)])
808 [ Time.zonedTimeToUTC $
811 (Time.fromGregorian 2000 01 01)
812 (Time.TimeOfDay 0 0 0))
814 , "2000/01/01 some text" ~:
815 (Data.Either.rights $
816 [P.runParser_with_Error
817 (Date.Read.date id Nothing)
818 () "" ("2000/01/01 some text"::Text)])
820 [ Time.zonedTimeToUTC $
823 (Time.fromGregorian 2000 01 01)
824 (Time.TimeOfDay 0 0 0))
826 , "2000/01/01 12:34" ~:
827 (Data.Either.rights $
828 [P.runParser_with_Error
829 (Date.Read.date id Nothing <* P.eof)
830 () "" ("2000/01/01 12:34"::Text)])
832 [ Time.zonedTimeToUTC $
835 (Time.fromGregorian 2000 01 01)
836 (Time.TimeOfDay 12 34 0))
838 , "2000/01/01 12:34:56" ~:
839 (Data.Either.rights $
840 [P.runParser_with_Error
841 (Date.Read.date id Nothing <* P.eof)
842 () "" ("2000/01/01 12:34:56"::Text)])
844 [ Time.zonedTimeToUTC $
847 (Time.fromGregorian 2000 01 01)
848 (Time.TimeOfDay 12 34 56))
850 , "2000/01/01 12:34 CET" ~:
851 (Data.Either.rights $
852 [P.runParser_with_Error
853 (Date.Read.date id Nothing <* P.eof)
854 () "" ("2000/01/01 12:34 CET"::Text)])
856 [ Time.zonedTimeToUTC $
859 (Time.fromGregorian 2000 01 01)
860 (Time.TimeOfDay 12 34 0))
861 (Time.TimeZone 60 True "CET")]
862 , "2000/01/01 12:34 +0130" ~:
863 (Data.Either.rights $
864 [P.runParser_with_Error
865 (Date.Read.date id Nothing <* P.eof)
866 () "" ("2000/01/01 12:34 +0130"::Text)])
868 [ Time.zonedTimeToUTC $
871 (Time.fromGregorian 2000 01 01)
872 (Time.TimeOfDay 12 34 0))
873 (Time.TimeZone 90 False "+0130")]
874 , "2000/01/01 12:34:56 CET" ~:
875 (Data.Either.rights $
876 [P.runParser_with_Error
877 (Date.Read.date id Nothing <* P.eof)
878 () "" ("2000/01/01 12:34:56 CET"::Text)])
880 [ Time.zonedTimeToUTC $
883 (Time.fromGregorian 2000 01 01)
884 (Time.TimeOfDay 12 34 56))
885 (Time.TimeZone 60 True "CET")]
887 (Data.Either.rights $
888 [P.runParser_with_Error
889 (Date.Read.date id Nothing <* P.eof)
890 () "" ("2001/02/29"::Text)])
894 (Data.Either.rights $
895 [P.runParser_with_Error
896 (Date.Read.date id (Just 2000) <* P.eof)
897 () "" ("01/01"::Text)])
899 [ Time.zonedTimeToUTC $
902 (Time.fromGregorian 2000 01 01)
903 (Time.TimeOfDay 0 0 0))
908 , "Filter" ~: TestList
910 [ "Test_Account" ~: TestList
913 [ Filter.Test_Account_Section_Text
914 (Filter.Test_Text_Exact "A")
919 [ Filter.Test_Account_Section_Any
924 [ Filter.Test_Account_Section_Many
929 [ Filter.Test_Account_Section_Many
930 , Filter.Test_Account_Section_Text
931 (Filter.Test_Text_Exact "A")
936 [ Filter.Test_Account_Section_Text
937 (Filter.Test_Text_Exact "A")
938 , Filter.Test_Account_Section_Many
943 [ Filter.Test_Account_Section_Text
944 (Filter.Test_Text_Exact "A")
945 , Filter.Test_Account_Section_Many
947 (("A":|"B":[]::Account))
950 [ Filter.Test_Account_Section_Text
951 (Filter.Test_Text_Exact "A")
952 , Filter.Test_Account_Section_Text
953 (Filter.Test_Text_Exact "B")
955 (("A":|"B":[]::Account))
958 [ Filter.Test_Account_Section_Text
959 (Filter.Test_Text_Exact "A")
960 , Filter.Test_Account_Section_Many
961 , Filter.Test_Account_Section_Text
962 (Filter.Test_Text_Exact "B")
964 (("A":|"B":[]::Account))
967 [ Filter.Test_Account_Section_Many
968 , Filter.Test_Account_Section_Text
969 (Filter.Test_Text_Exact "B")
970 , Filter.Test_Account_Section_Many
972 (("A":|"B":"C":[]::Account))
975 [ Filter.Test_Account_Section_Many
976 , Filter.Test_Account_Section_Text
977 (Filter.Test_Text_Exact "C")
979 (("A":|"B":"C":[]::Account))
981 , "Test_Bool" ~: TestList
984 (Filter.Any::Filter.Test_Bool Filter.Test_Account)
989 [ "test_account_section" ~: TestList
991 (Data.Either.rights $
993 (Filter.Read.test_account <* P.eof)
996 [ [Filter.Test_Account_Section_Any]
999 (Data.Either.rights $
1001 (Filter.Read.test_account <* P.eof)
1004 [ [Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")]
1007 (Data.Either.rights $
1009 (Filter.Read.test_account <* P.eof)
1010 () "" ("AA"::Text)])
1012 [ [Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "AA")]
1015 (Data.Either.rights $
1017 (Filter.Read.test_account <* P.eof)
1018 () "" ("::A"::Text)])
1020 [ [ Filter.Test_Account_Section_Many
1021 , Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1025 (Data.Either.rights $
1027 (Filter.Read.test_account <* P.eof)
1028 () "" (":A"::Text)])
1030 [ [ Filter.Test_Account_Section_Many
1031 , Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1035 (Data.Either.rights $
1037 (Filter.Read.test_account <* P.eof)
1038 () "" ("A:"::Text)])
1040 [ [ Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1041 , Filter.Test_Account_Section_Many
1045 (Data.Either.rights $
1047 (Filter.Read.test_account <* P.eof)
1048 () "" ("A::"::Text)])
1050 [ [ Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1051 , Filter.Test_Account_Section_Many
1055 (Data.Either.rights $
1057 (Filter.Read.test_account <* P.eof)
1058 () "" ("A:B"::Text)])
1060 [ [ Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1061 , Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "B") ]
1064 (Data.Either.rights $
1066 (Filter.Read.test_account <* P.eof)
1067 () "" ("A::B"::Text)])
1069 [ [ Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1070 , Filter.Test_Account_Section_Many
1071 , Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "B")
1075 (Data.Either.rights $
1077 (Filter.Read.test_account <* P.eof)
1078 () "" ("A:::B"::Text)])
1080 [ [ Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1081 , Filter.Test_Account_Section_Many
1082 , Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "B")
1086 (Data.Either.rights $
1088 (Filter.Read.test_account <* P.char ' ' <* P.eof)
1089 () "" ("A: "::Text)])
1091 [ [ Filter.Test_Account_Section_Text (Filter.Test_Text_Exact "A")
1092 , Filter.Test_Account_Section_Many
1096 , "test_bool" ~: TestList
1098 (Data.Either.rights $
1100 (Filter.Read.test_bool
1101 [ P.char 'E' >> return (return True) ]
1103 () "" ("( E )"::Text)])
1105 [ Filter.And (Filter.Bool True) Filter.Any
1108 (Data.Either.rights $
1110 (Filter.Read.test_bool
1111 [ P.char 'E' >> return (return True) ]
1113 () "" ("( ( E ) )"::Text)])
1115 [ Filter.And (Filter.And (Filter.Bool True) Filter.Any) Filter.Any
1117 , "( E ) & ( E )" ~:
1118 (Data.Either.rights $
1120 (Filter.Read.test_bool
1121 [ P.char 'E' >> return (return True) ]
1123 () "" ("( E ) & ( E )"::Text)])
1126 (Filter.And (Filter.Bool True) Filter.Any)
1127 (Filter.And (Filter.Bool True) Filter.Any)
1129 , "( E ) + ( E )" ~:
1130 (Data.Either.rights $
1132 (Filter.Read.test_bool
1133 [ P.char 'E' >> return (return True) ]
1135 () "" ("( E ) + ( E )"::Text)])
1138 (Filter.And (Filter.Bool True) Filter.Any)
1139 (Filter.And (Filter.Bool True) Filter.Any)
1141 , "( E ) - ( E )" ~:
1142 (Data.Either.rights $
1144 (Filter.Read.test_bool
1145 [ P.char 'E' >> return (return True) ]
1147 () "" ("( E ) - ( E )"::Text)])
1150 (Filter.And (Filter.Bool True) Filter.Any)
1151 (Filter.Not (Filter.And (Filter.Bool True) Filter.Any))
1154 (Data.Either.rights $
1156 (Filter.Read.test_bool
1157 [ P.char 'E' >> return (return True) ]
1159 () "" ("(- E )"::Text)])
1161 [ Filter.And (Filter.Not (Filter.Bool True)) Filter.Any
1166 , "Balance" ~: TestList
1167 [ "balance" ~: TestList
1168 [ "[A+$1] = A+$1 & $+1" ~:
1170 (Format.Ledger.posting ("A":|[]))
1171 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1176 { Balance.balance_by_account =
1177 Lib.TreeMap.from_List const $
1178 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1179 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1180 , Balance.balance_by_unit =
1182 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1184 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1185 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1190 , "[A+$1, A-$1] = {A+$0, $+0}" ~:
1192 (flip Balance.balance)
1194 [ (Format.Ledger.posting ("A":|[]))
1195 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1197 , (Format.Ledger.posting ("A":|[]))
1198 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ]
1203 { Balance.balance_by_account =
1204 Lib.TreeMap.from_List const $
1206 , Data.Map.fromListWith const $
1207 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance s, s))
1208 [ Balance.Amount_Sum
1209 { Balance.amount_sum_negative = Just $ Amount.usd $ -1
1210 , Balance.amount_sum_positive = Just $ Amount.usd $ 1
1211 , Balance.amount_sum_balance = Amount.usd $ 0
1215 , Balance.balance_by_unit =
1217 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1219 { Balance.unit_sum_amount = Balance.Amount_Sum
1220 { Balance.amount_sum_negative = Just $ Amount.usd $ -1
1221 , Balance.amount_sum_positive = Just $ Amount.usd $ 1
1222 , Balance.amount_sum_balance = Amount.usd $ 0
1224 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1229 , "[A+$1, A-€1] = {A+$1-€1, $+1 €-1}" ~:
1231 (flip Balance.balance)
1233 [ (Format.Ledger.posting ("A":|[]))
1234 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1236 , (Format.Ledger.posting ("A":|[]))
1237 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1 ]
1242 { Balance.balance_by_account =
1243 Lib.TreeMap.from_List const $
1244 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1245 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ -1 ]) ]
1246 , Balance.balance_by_unit =
1248 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1250 { Balance.unit_sum_amount = Balance.Amount_Sum
1251 { Balance.amount_sum_negative = Nothing
1252 , Balance.amount_sum_positive = Just $ Amount.usd $ 1
1253 , Balance.amount_sum_balance = Amount.usd $ 1
1255 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1259 { Balance.unit_sum_amount = Balance.Amount_Sum
1260 { Balance.amount_sum_negative = Just $ Amount.eur $ -1
1261 , Balance.amount_sum_positive = Nothing
1262 , Balance.amount_sum_balance = Amount.eur $ -1
1264 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1269 , "[A+$1, B-$1] = {A+$1 B-$1, $+0}" ~:
1271 (flip Balance.balance)
1273 [ (Format.Ledger.posting ("A":|[]))
1274 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1276 , (Format.Ledger.posting ("B":|[]))
1277 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ]
1282 { Balance.balance_by_account =
1283 Lib.TreeMap.from_List const $
1284 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1285 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1286 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
1288 , Balance.balance_by_unit =
1290 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1292 { Balance.unit_sum_amount = Balance.Amount_Sum
1293 { Balance.amount_sum_negative = Just $ Amount.usd $ -1
1294 , Balance.amount_sum_positive = Just $ Amount.usd $ 1
1295 , Balance.amount_sum_balance = Amount.usd $ 0
1297 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1304 (flip Balance.balance)
1306 [ (Format.Ledger.posting ("A":|[]))
1307 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1309 , (Format.Ledger.posting ("B":|[]))
1310 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1315 { Balance.balance_by_account =
1316 Lib.TreeMap.from_List const $
1317 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1318 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1319 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
1321 , Balance.balance_by_unit =
1323 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1325 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1326 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1331 , "[A+$1+€2, A-$1-€2] = {A+$0+€0, $+0 €+0}" ~:
1333 (flip Balance.balance)
1335 [ (Format.Ledger.posting ("A":|[]))
1336 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2 ]
1338 , (Format.Ledger.posting ("A":|[]))
1339 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2 ]
1344 { Balance.balance_by_account =
1345 Lib.TreeMap.from_List const $
1347 , Data.Map.fromListWith const $
1348 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance s, s))
1349 [ Balance.Amount_Sum
1350 { Balance.amount_sum_negative = Just $ Amount.usd $ -1
1351 , Balance.amount_sum_positive = Just $ Amount.usd $ 1
1352 , Balance.amount_sum_balance = Amount.usd $ 0
1354 , Balance.Amount_Sum
1355 { Balance.amount_sum_negative = Just $ Amount.eur $ -2
1356 , Balance.amount_sum_positive = Just $ Amount.eur $ 2
1357 , Balance.amount_sum_balance = Amount.eur $ 0
1362 , Balance.balance_by_unit =
1364 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1366 { Balance.unit_sum_amount = Balance.Amount_Sum
1367 { Balance.amount_sum_negative = Just $ Amount.usd $ -1
1368 , Balance.amount_sum_positive = Just $ Amount.usd $ 1
1369 , Balance.amount_sum_balance = Amount.usd $ 0
1371 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1375 { Balance.unit_sum_amount = Balance.Amount_Sum
1376 { Balance.amount_sum_negative = Just $ Amount.eur $ -2
1377 , Balance.amount_sum_positive = Just $ Amount.eur $ 2
1378 , Balance.amount_sum_balance = Amount.eur $ 0
1380 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1385 , "[A+$1+€2+£3, B-$1-2€-£3] = {A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~:
1387 (flip Balance.balance)
1389 [ (Format.Ledger.posting ("A":|[]))
1390 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ]
1392 , (Format.Ledger.posting ("B":|[]))
1393 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ]
1398 { Balance.balance_by_account =
1399 Lib.TreeMap.from_List const $
1400 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1401 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
1402 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
1404 , Balance.balance_by_unit =
1406 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1408 { Balance.unit_sum_amount = Balance.Amount_Sum
1409 { Balance.amount_sum_negative = Just $ Amount.usd $ -1
1410 , Balance.amount_sum_positive = Just $ Amount.usd $ 1
1411 , Balance.amount_sum_balance = Amount.usd $ 0
1413 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1417 { Balance.unit_sum_amount = Balance.Amount_Sum
1418 { Balance.amount_sum_negative = Just $ Amount.eur $ -2
1419 , Balance.amount_sum_positive = Just $ Amount.eur $ 2
1420 , Balance.amount_sum_balance = Amount.eur $ 0
1422 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1426 { Balance.unit_sum_amount = Balance.Amount_Sum
1427 { Balance.amount_sum_negative = Just $ Amount.gbp $ -3
1428 , Balance.amount_sum_positive = Just $ Amount.gbp $ 3
1429 , Balance.amount_sum_balance = Amount.gbp $ 0
1431 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1437 , "union" ~: TestList
1438 [ "nil nil = nil" ~:
1439 Balance.union Balance.nil Balance.nil
1441 (Balance.nil::Balance.Balance Amount)
1442 , "{A+$1, $+1} {A+$1, $+1} = {A+$2, $+2}" ~:
1445 { Balance.balance_by_account =
1446 Lib.TreeMap.from_List const $
1447 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1448 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1449 , Balance.balance_by_unit =
1451 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1453 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1454 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1460 { Balance.balance_by_account =
1461 Lib.TreeMap.from_List const $
1462 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1463 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1464 , Balance.balance_by_unit =
1466 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1468 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1469 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1476 { Balance.balance_by_account =
1477 Lib.TreeMap.from_List const $
1478 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1479 [ ("A":|[], Amount.from_List [ Amount.usd $ 2 ]) ]
1480 , Balance.balance_by_unit =
1482 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1484 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1485 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1490 , "{A+$1, $+1} {B+$1, $+1} = {A+$1 B+$1, $+2}" ~:
1493 { Balance.balance_by_account =
1494 Lib.TreeMap.from_List const $
1495 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1496 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1497 , Balance.balance_by_unit =
1499 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1501 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1502 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1508 { Balance.balance_by_account =
1509 Lib.TreeMap.from_List const $
1510 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1511 [ ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1512 , Balance.balance_by_unit =
1514 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1516 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1517 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1524 { Balance.balance_by_account =
1525 Lib.TreeMap.from_List const $
1526 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1527 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1528 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1529 , Balance.balance_by_unit =
1531 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1533 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1534 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1539 , "{A+$1, $+1} {B+€1, €+1} = {A+$1 B+€1, $+1 €+1}" ~:
1542 { Balance.balance_by_account =
1543 Lib.TreeMap.from_List const $
1544 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1545 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1546 , Balance.balance_by_unit =
1548 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1550 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1551 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1557 { Balance.balance_by_account =
1558 Lib.TreeMap.from_List const $
1559 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1560 [ ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
1561 , Balance.balance_by_unit =
1563 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1565 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
1566 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1573 { Balance.balance_by_account =
1574 Lib.TreeMap.from_List const $
1575 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1576 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1577 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
1578 , Balance.balance_by_unit =
1580 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1582 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1583 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1587 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
1588 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1594 , "expanded" ~: TestList
1595 [ "nil_By_Account" ~:
1599 (Lib.TreeMap.empty::Balance.Expanded Amount)
1602 (Lib.TreeMap.from_List const $
1603 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1604 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ])
1606 (Lib.TreeMap.from_List const $
1607 [ ("A":|[], Balance.Account_Sum_Expanded
1608 { Balance.inclusive =
1609 Data.Map.map Balance.amount_sum $
1610 Amount.from_List [ Amount.usd $ 1 ]
1611 , Balance.exclusive =
1612 Data.Map.map Balance.amount_sum $
1613 Amount.from_List [ Amount.usd $ 1 ]
1616 , "A/A+$1 = A+$1 A/A+$1" ~:
1618 (Lib.TreeMap.from_List const $
1619 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1620 [ ("A":|["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
1622 (Lib.TreeMap.from_List const
1623 [ ("A":|[], Balance.Account_Sum_Expanded
1624 { Balance.inclusive =
1625 Data.Map.map Balance.amount_sum $
1626 Amount.from_List [ Amount.usd $ 1 ]
1627 , Balance.exclusive =
1628 Data.Map.map Balance.amount_sum $
1631 , ("A":|["A"], Balance.Account_Sum_Expanded
1632 { Balance.inclusive =
1633 Data.Map.map Balance.amount_sum $
1634 Amount.from_List [ Amount.usd $ 1 ]
1635 , Balance.exclusive =
1636 Data.Map.map Balance.amount_sum $
1637 Amount.from_List [ Amount.usd $ 1 ]
1640 , "A/B+$1 = A+$1 A/B+$1" ~:
1642 (Lib.TreeMap.from_List const $
1643 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1644 [ ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ]) ])
1646 (Lib.TreeMap.from_List const
1647 [ ("A":|[], Balance.Account_Sum_Expanded
1648 { Balance.inclusive =
1649 Data.Map.map Balance.amount_sum $
1650 Amount.from_List [ Amount.usd $ 1 ]
1651 , Balance.exclusive =
1652 Data.Map.map Balance.amount_sum $
1655 , ("A":|["B"], Balance.Account_Sum_Expanded
1656 { Balance.inclusive =
1657 Data.Map.map Balance.amount_sum $
1658 Amount.from_List [ Amount.usd $ 1 ]
1659 , Balance.exclusive =
1660 Data.Map.map Balance.amount_sum $
1661 Amount.from_List [ Amount.usd $ 1 ]
1664 , "A/B/C+$1 = A+$1 A/B+$1 A/B/C+$1" ~:
1666 (Lib.TreeMap.from_List const $
1667 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1668 [ ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
1670 (Lib.TreeMap.from_List const $
1671 [ ("A":|[], Balance.Account_Sum_Expanded
1672 { Balance.inclusive =
1673 Data.Map.map Balance.amount_sum $
1674 Amount.from_List [ Amount.usd $ 1 ]
1675 , Balance.exclusive =
1676 Data.Map.map Balance.amount_sum $
1679 , ("A":|["B"], Balance.Account_Sum_Expanded
1680 { Balance.inclusive =
1681 Data.Map.map Balance.amount_sum $
1682 Amount.from_List [ Amount.usd $ 1 ]
1683 , Balance.exclusive =
1684 Data.Map.map Balance.amount_sum $
1687 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
1688 { Balance.inclusive =
1689 Data.Map.map Balance.amount_sum $
1690 Amount.from_List [ Amount.usd $ 1 ]
1691 , Balance.exclusive =
1692 Data.Map.map Balance.amount_sum $
1693 Amount.from_List [ Amount.usd $ 1 ]
1696 , "A+$1 A/B+$1 = A+$2 A/B+$1" ~:
1698 (Lib.TreeMap.from_List const $
1699 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1700 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1701 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1704 (Lib.TreeMap.from_List const
1705 [ ("A":|[], Balance.Account_Sum_Expanded
1706 { Balance.inclusive =
1707 Data.Map.map Balance.amount_sum $
1708 Amount.from_List [ Amount.usd $ 2 ]
1709 , Balance.exclusive =
1710 Data.Map.map Balance.amount_sum $
1711 Amount.from_List [ Amount.usd $ 1 ]
1713 , ("A":|["B"], Balance.Account_Sum_Expanded
1714 { Balance.inclusive =
1715 Data.Map.map Balance.amount_sum $
1716 Amount.from_List [ Amount.usd $ 1 ]
1717 , Balance.exclusive =
1718 Data.Map.map Balance.amount_sum $
1719 Amount.from_List [ Amount.usd $ 1 ]
1722 , "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
1724 (Lib.TreeMap.from_List const $
1725 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1726 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1727 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1728 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
1731 (Lib.TreeMap.from_List const
1732 [ ("A":|[], Balance.Account_Sum_Expanded
1733 { Balance.inclusive =
1734 Data.Map.map Balance.amount_sum $
1735 Amount.from_List [ Amount.usd $ 3 ]
1736 , Balance.exclusive =
1737 Data.Map.map Balance.amount_sum $
1738 Amount.from_List [ Amount.usd $ 1 ]
1740 , ("A":|["B"], Balance.Account_Sum_Expanded
1741 { Balance.inclusive =
1742 Data.Map.map Balance.amount_sum $
1743 Amount.from_List [ Amount.usd $ 2 ]
1744 , Balance.exclusive =
1745 Data.Map.map Balance.amount_sum $
1746 Amount.from_List [ Amount.usd $ 1 ]
1748 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
1749 { Balance.inclusive =
1750 Data.Map.map Balance.amount_sum $
1751 Amount.from_List [ Amount.usd $ 1 ]
1752 , Balance.exclusive =
1753 Data.Map.map Balance.amount_sum $
1754 Amount.from_List [ Amount.usd $ 1 ]
1757 , "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" ~:
1759 (Lib.TreeMap.from_List const $
1760 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1761 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1762 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1763 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
1764 , ("A":|["B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
1767 (Lib.TreeMap.from_List const
1768 [ ("A":|[], Balance.Account_Sum_Expanded
1769 { Balance.inclusive =
1770 Data.Map.map Balance.amount_sum $
1771 Amount.from_List [ Amount.usd $ 4 ]
1772 , Balance.exclusive =
1773 Data.Map.map Balance.amount_sum $
1774 Amount.from_List [ Amount.usd $ 1 ]
1776 , ("A":|["B"], Balance.Account_Sum_Expanded
1777 { Balance.inclusive =
1778 Data.Map.map Balance.amount_sum $
1779 Amount.from_List [ Amount.usd $ 3 ]
1780 , Balance.exclusive =
1781 Data.Map.map Balance.amount_sum $
1782 Amount.from_List [ Amount.usd $ 1 ]
1784 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
1785 { Balance.inclusive =
1786 Data.Map.map Balance.amount_sum $
1787 Amount.from_List [ Amount.usd $ 2 ]
1788 , Balance.exclusive =
1789 Data.Map.map Balance.amount_sum $
1790 Amount.from_List [ Amount.usd $ 1 ]
1792 , ("A":|["B", "C", "D"], Balance.Account_Sum_Expanded
1793 { Balance.inclusive =
1794 Data.Map.map Balance.amount_sum $
1795 Amount.from_List [ Amount.usd $ 1 ]
1796 , Balance.exclusive =
1797 Data.Map.map Balance.amount_sum $
1798 Amount.from_List [ Amount.usd $ 1 ]
1801 , "A+$1 A/B+$1 A/BB+$1 AA/B+$1 = A+$3 A/B+$1 A/BB+$1 AA+$1 AA/B+$1" ~:
1803 (Lib.TreeMap.from_List const $
1804 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1805 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1806 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1807 , ("A":|["BB"], Amount.from_List [ Amount.usd $ 1 ])
1808 , ("AA":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1811 (Lib.TreeMap.from_List const
1812 [ ("A":|[], Balance.Account_Sum_Expanded
1813 { Balance.inclusive =
1814 Data.Map.map Balance.amount_sum $
1815 Amount.from_List [ Amount.usd $ 3 ]
1816 , Balance.exclusive =
1817 Data.Map.map Balance.amount_sum $
1818 Amount.from_List [ Amount.usd $ 1 ]
1820 , ("A":|["B"], Balance.Account_Sum_Expanded
1821 { Balance.inclusive =
1822 Data.Map.map Balance.amount_sum $
1823 Amount.from_List [ Amount.usd $ 1 ]
1824 , Balance.exclusive =
1825 Data.Map.map Balance.amount_sum $
1826 Amount.from_List [ Amount.usd $ 1 ]
1828 , ("A":|["BB"], Balance.Account_Sum_Expanded
1829 { Balance.inclusive =
1830 Data.Map.map Balance.amount_sum $
1831 Amount.from_List [ Amount.usd $ 1 ]
1832 , Balance.exclusive =
1833 Data.Map.map Balance.amount_sum $
1834 Amount.from_List [ Amount.usd $ 1 ]
1836 , ("AA":|[], Balance.Account_Sum_Expanded
1837 { Balance.inclusive =
1838 Data.Map.map Balance.amount_sum $
1839 Amount.from_List [ Amount.usd $ 1 ]
1840 , Balance.exclusive =
1841 Data.Map.map Balance.amount_sum $
1844 , ("AA":|["B"], Balance.Account_Sum_Expanded
1845 { Balance.inclusive =
1846 Data.Map.map Balance.amount_sum $
1847 Amount.from_List [ Amount.usd $ 1 ]
1848 , Balance.exclusive =
1849 Data.Map.map Balance.amount_sum $
1850 Amount.from_List [ Amount.usd $ 1 ]
1854 , "deviation" ~: TestList
1856 (Balance.deviation $
1858 { Balance.balance_by_account =
1859 Lib.TreeMap.from_List const $
1860 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1861 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1862 , ("B":|[], Amount.from_List [])
1864 , Balance.balance_by_unit =
1866 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1868 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1869 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1875 (Balance.Deviation $
1877 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1879 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1880 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1884 , "{A+$1 B+$1, $2}" ~:
1885 (Balance.deviation $
1887 { Balance.balance_by_account =
1888 Lib.TreeMap.from_List const $
1889 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1890 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1891 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
1893 , Balance.balance_by_unit =
1895 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1897 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1898 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1906 (Balance.Deviation $
1908 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1910 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1911 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1917 , "is_equilibrium_inferrable" ~: TestList
1918 [ "nil" ~: TestCase $
1920 Balance.is_equilibrium_inferrable $
1922 (Balance.nil::Balance.Balance Amount.Amount)
1923 , "{A+$0, $+0}" ~: TestCase $
1925 Balance.is_equilibrium_inferrable $
1928 { Balance.balance_by_account =
1929 Lib.TreeMap.from_List const $
1930 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1931 [ ("A":|[], Amount.from_List [ Amount.usd $ 0 ])
1933 , Balance.balance_by_unit =
1935 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1937 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
1938 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1943 , "{A+$1, $+1}" ~: TestCase $
1945 Balance.is_equilibrium_inferrable $
1948 { Balance.balance_by_account =
1949 Lib.TreeMap.from_List const $
1950 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1951 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1953 , Balance.balance_by_unit =
1955 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1957 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1958 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1963 , "{A+$0+€0, $0 €+0}" ~: TestCase $
1965 Balance.is_equilibrium_inferrable $
1968 { Balance.balance_by_account =
1969 Lib.TreeMap.from_List const $
1970 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1971 [ ("A":|[], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
1973 , Balance.balance_by_unit =
1975 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1977 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
1978 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1982 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 0
1983 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1988 , "{A+$1, B-$1, $+0}" ~: TestCase $
1990 Balance.is_equilibrium_inferrable $
1993 { Balance.balance_by_account =
1994 Lib.TreeMap.from_List const $
1995 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1996 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1997 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
1999 , Balance.balance_by_unit =
2001 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
2003 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
2004 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2009 , "{A+$1 B, $+1}" ~: TestCase $
2011 Balance.is_equilibrium_inferrable $
2014 { Balance.balance_by_account =
2015 Lib.TreeMap.from_List const $
2016 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
2017 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2018 , ("B":|[], Amount.from_List [])
2020 , Balance.balance_by_unit =
2022 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
2024 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
2025 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2030 , "{A+$1 B+€1, $+1 €+1}" ~: TestCase $
2032 Balance.is_equilibrium_inferrable $
2035 { Balance.balance_by_account =
2036 Lib.TreeMap.from_List const $
2037 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
2038 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2039 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ])
2041 , Balance.balance_by_unit =
2043 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
2045 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
2046 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2050 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
2051 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2056 , "{A+$1 B-$1+€1, $+0 €+1}" ~: TestCase $
2058 Balance.is_equilibrium_inferrable $
2061 { Balance.balance_by_account =
2062 Lib.TreeMap.from_List const $
2063 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
2064 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2065 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ 1 ])
2067 , Balance.balance_by_unit =
2069 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
2071 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
2072 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2076 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
2077 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2082 , "{A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~: TestCase $
2084 Balance.is_equilibrium_inferrable $
2087 { Balance.balance_by_account =
2088 Lib.TreeMap.from_List const $
2089 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
2090 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
2091 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
2093 , Balance.balance_by_unit =
2095 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
2097 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
2098 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2102 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 0
2103 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2107 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.gbp $ 0
2108 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2114 , "infer_equilibrium" ~: TestList
2116 (snd $ Balance.infer_equilibrium $
2117 Format.Ledger.posting_by_Account
2118 [ (Format.Ledger.posting ("A":|[]))
2119 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2120 , (Format.Ledger.posting ("B":|[]))
2121 { Format.Ledger.posting_amounts=Amount.from_List [] }
2125 Format.Ledger.posting_by_Account
2126 [ (Format.Ledger.posting ("A":|[]))
2127 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2128 , (Format.Ledger.posting ("B":|[]))
2129 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ] }
2132 (snd $ Balance.infer_equilibrium $
2133 Format.Ledger.posting_by_Account
2134 [ (Format.Ledger.posting ("A":|[]))
2135 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2136 , (Format.Ledger.posting ("B":|[]))
2137 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1 ] }
2141 Format.Ledger.posting_by_Account
2142 [ (Format.Ledger.posting ("A":|[]))
2143 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 1] }
2144 , (Format.Ledger.posting ("B":|[]))
2145 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1, Amount.usd $ -1 ] }
2148 (snd $ Balance.infer_equilibrium $
2149 Format.Ledger.posting_by_Account
2150 [ (Format.Ledger.posting ("A":|[]))
2151 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2152 , (Format.Ledger.posting ("B":|[]))
2153 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2158 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
2159 , Balance.unit_sum_accounts = Data.Map.fromList []}
2161 , "{A+$1 B-$1 B-1€}" ~:
2162 (snd $ Balance.infer_equilibrium $
2163 Format.Ledger.posting_by_Account
2164 [ (Format.Ledger.posting ("A":|[]))
2165 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2166 , (Format.Ledger.posting ("B":|[]))
2167 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -1 ] }
2171 Format.Ledger.posting_by_Account
2172 [ (Format.Ledger.posting ("A":|[]))
2173 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 1 ] }
2174 , (Format.Ledger.posting ("B":|[]))
2175 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -1 ] }
2179 , "Format" ~: TestList
2180 [ "Ledger" ~: TestList
2181 [ "Read" ~: TestList
2182 [ "account_name" ~: TestList
2184 (Data.Either.rights $
2186 (Format.Ledger.Read.account_name <* P.eof)
2191 (Data.Either.rights $
2193 (Format.Ledger.Read.account_name <* P.eof)
2198 (Data.Either.rights $
2200 (Format.Ledger.Read.account_name <* P.eof)
2201 () "" ("AA"::Text)])
2205 (Data.Either.rights $
2207 (Format.Ledger.Read.account_name <* P.eof)
2212 (Data.Either.rights $
2214 (Format.Ledger.Read.account_name <* P.eof)
2219 (Data.Either.rights $
2221 (Format.Ledger.Read.account_name <* P.eof)
2222 () "" ("A:"::Text)])
2226 (Data.Either.rights $
2228 (Format.Ledger.Read.account_name <* P.eof)
2229 () "" (":A"::Text)])
2233 (Data.Either.rights $
2235 (Format.Ledger.Read.account_name <* P.eof)
2236 () "" ("A "::Text)])
2240 (Data.Either.rights $
2242 (Format.Ledger.Read.account_name)
2243 () "" ("A "::Text)])
2247 (Data.Either.rights $
2249 (Format.Ledger.Read.account_name <* P.eof)
2250 () "" ("A A"::Text)])
2254 (Data.Either.rights $
2256 (Format.Ledger.Read.account_name <* P.eof)
2257 () "" ("A "::Text)])
2261 (Data.Either.rights $
2263 (Format.Ledger.Read.account_name <* P.eof)
2264 () "" ("A \n"::Text)])
2268 (Data.Either.rights $
2270 (Format.Ledger.Read.account_name <* P.eof)
2271 () "" ("(A)A"::Text)])
2275 (Data.Either.rights $
2277 (Format.Ledger.Read.account_name <* P.eof)
2278 () "" ("( )A"::Text)])
2282 (Data.Either.rights $
2284 (Format.Ledger.Read.account_name <* P.eof)
2285 () "" ("(A) A"::Text)])
2289 (Data.Either.rights $
2291 (Format.Ledger.Read.account_name <* P.eof)
2292 () "" ("[ ]A"::Text)])
2296 (Data.Either.rights $
2298 (Format.Ledger.Read.account_name <* P.eof)
2299 () "" ("(A) "::Text)])
2303 (Data.Either.rights $
2305 (Format.Ledger.Read.account_name <* P.eof)
2306 () "" ("(A)"::Text)])
2310 (Data.Either.rights $
2312 (Format.Ledger.Read.account_name <* P.eof)
2313 () "" ("A(A)"::Text)])
2317 (Data.Either.rights $
2319 (Format.Ledger.Read.account_name <* P.eof)
2320 () "" ("[A]A"::Text)])
2324 (Data.Either.rights $
2326 (Format.Ledger.Read.account_name <* P.eof)
2327 () "" ("[A] A"::Text)])
2331 (Data.Either.rights $
2333 (Format.Ledger.Read.account_name <* P.eof)
2334 () "" ("[A] "::Text)])
2338 (Data.Either.rights $
2340 (Format.Ledger.Read.account_name <* P.eof)
2341 () "" ("[A]"::Text)])
2345 , "account" ~: TestList
2347 (Data.Either.rights $
2349 (Format.Ledger.Read.account <* P.eof)
2354 (Data.Either.rights $
2356 (Format.Ledger.Read.account <* P.eof)
2361 (Data.Either.rights $
2363 (Format.Ledger.Read.account <* P.eof)
2364 () "" ("A:"::Text)])
2368 (Data.Either.rights $
2370 (Format.Ledger.Read.account <* P.eof)
2371 () "" (":A"::Text)])
2375 (Data.Either.rights $
2377 (Format.Ledger.Read.account <* P.eof)
2378 () "" ("A "::Text)])
2382 (Data.Either.rights $
2384 (Format.Ledger.Read.account <* P.eof)
2385 () "" (" A"::Text)])
2389 (Data.Either.rights $
2391 (Format.Ledger.Read.account <* P.eof)
2392 () "" ("A:B"::Text)])
2396 (Data.Either.rights $
2398 (Format.Ledger.Read.account <* P.eof)
2399 () "" ("A:B:C"::Text)])
2402 , "\"Aa:Bbb:Cccc\"" ~:
2403 (Data.Either.rights $
2405 (Format.Ledger.Read.account <* P.eof)
2406 () "" ("Aa:Bbb:Cccc"::Text)])
2408 ["Aa":|["Bbb", "Cccc"]]
2409 , "\"A a : B b b : C c c c\"" ~:
2410 (Data.Either.rights $
2412 (Format.Ledger.Read.account <* P.eof)
2413 () "" ("A a : B b b : C c c c"::Text)])
2415 ["A a ":|[" B b b ", " C c c c"]]
2417 (Data.Either.rights $
2419 (Format.Ledger.Read.account <* P.eof)
2420 () "" ("A: :C"::Text)])
2424 (Data.Either.rights $
2426 (Format.Ledger.Read.account <* P.eof)
2427 () "" ("A::C"::Text)])
2431 (Data.Either.rights $
2433 (Format.Ledger.Read.account <* P.eof)
2434 () "" ("A:B:(C)"::Text)])
2438 , "posting_type" ~: TestList
2440 Format.Ledger.Read.posting_type
2443 (Format.Ledger.Posting_Type_Regular, "A":|[])
2445 Format.Ledger.Read.posting_type
2448 (Format.Ledger.Posting_Type_Regular, "(":|[])
2450 Format.Ledger.Read.posting_type
2453 (Format.Ledger.Posting_Type_Regular, ")":|[])
2455 Format.Ledger.Read.posting_type
2458 (Format.Ledger.Posting_Type_Regular, "()":|[])
2460 Format.Ledger.Read.posting_type
2463 (Format.Ledger.Posting_Type_Regular, "( )":|[])
2465 Format.Ledger.Read.posting_type
2468 (Format.Ledger.Posting_Type_Virtual, "A":|[])
2470 Format.Ledger.Read.posting_type
2473 (Format.Ledger.Posting_Type_Virtual, "A":|["B", "C"])
2475 Format.Ledger.Read.posting_type
2478 (Format.Ledger.Posting_Type_Regular, "A":|["B", "C"])
2480 Format.Ledger.Read.posting_type
2483 (Format.Ledger.Posting_Type_Regular, "(A)":|["B", "C"])
2485 Format.Ledger.Read.posting_type
2488 (Format.Ledger.Posting_Type_Regular, "A":|["(B)", "C"])
2490 Format.Ledger.Read.posting_type
2493 (Format.Ledger.Posting_Type_Regular, "A":|["B", "(C)"])
2495 Format.Ledger.Read.posting_type
2498 (Format.Ledger.Posting_Type_Regular, "[":|[])
2500 Format.Ledger.Read.posting_type
2503 (Format.Ledger.Posting_Type_Regular, "]":|[])
2505 Format.Ledger.Read.posting_type
2508 (Format.Ledger.Posting_Type_Regular, "[]":|[])
2510 Format.Ledger.Read.posting_type
2513 (Format.Ledger.Posting_Type_Regular, "[ ]":|[])
2515 Format.Ledger.Read.posting_type
2518 (Format.Ledger.Posting_Type_Virtual_Balanced, "A":|[])
2520 Format.Ledger.Read.posting_type
2523 (Format.Ledger.Posting_Type_Virtual_Balanced, "A":|["B", "C"])
2525 Format.Ledger.Read.posting_type
2528 (Format.Ledger.Posting_Type_Regular, "A":|["B", "C"])
2530 Format.Ledger.Read.posting_type
2533 (Format.Ledger.Posting_Type_Regular, "[A]":|["B", "C"])
2535 Format.Ledger.Read.posting_type
2538 (Format.Ledger.Posting_Type_Regular, "A":|["[B]", "C"])
2540 Format.Ledger.Read.posting_type
2543 (Format.Ledger.Posting_Type_Regular, "A":|["B", "[C]"])
2545 , "comment" ~: TestList
2546 [ "; some comment = Right \" some comment\"" ~:
2547 (Data.Either.rights $
2549 (Format.Ledger.Read.comment <* P.eof)
2550 () "" ("; some comment"::Text)])
2553 , "; some comment \\n = Right \" some comment \"" ~:
2554 (Data.Either.rights $
2556 (Format.Ledger.Read.comment <* P.newline <* P.eof)
2557 () "" ("; some comment \n"::Text)])
2559 [ " some comment " ]
2560 , "; some comment \\r\\n = Right \" some comment \"" ~:
2561 (Data.Either.rights $
2563 (Format.Ledger.Read.comment <* P.string "\r\n" <* P.eof)
2564 () "" ("; some comment \r\n"::Text)])
2566 [ " some comment " ]
2568 , "comments" ~: TestList
2569 [ "; some comment\\n ; some other comment = Right [\" some comment\", \" some other comment\"]" ~:
2570 (Data.Either.rights $
2572 (Format.Ledger.Read.comments <* P.eof)
2573 () "" ("; some comment\n ; some other comment"::Text)])
2575 [ [" some comment", " some other comment"] ]
2576 , "; some comment \\n = Right \" some comment \"" ~:
2577 (Data.Either.rights $
2579 (Format.Ledger.Read.comments <* P.string "\n" <* P.eof)
2580 () "" ("; some comment \n"::Text)])
2582 [ [" some comment "] ]
2584 , "tag_value" ~: TestList
2586 (Data.Either.rights $
2588 (Format.Ledger.Read.tag_value <* P.eof)
2593 (Data.Either.rights $
2595 (Format.Ledger.Read.tag_value <* P.char '\n' <* P.eof)
2596 () "" (",\n"::Text)])
2600 (Data.Either.rights $
2602 (Format.Ledger.Read.tag_value <* P.eof)
2603 () "" (",x"::Text)])
2607 (Data.Either.rights $
2609 (Format.Ledger.Read.tag_value <* P.string ",x:" <* P.eof)
2610 () "" (",x:"::Text)])
2614 (Data.Either.rights $
2616 (Format.Ledger.Read.tag_value <* P.string ", n:" <* P.eof)
2617 () "" ("v, v, n:"::Text)])
2623 (Data.Either.rights $
2625 (Format.Ledger.Read.tag <* P.eof)
2626 () "" ("Name:"::Text)])
2630 (Data.Either.rights $
2632 (Format.Ledger.Read.tag <* P.eof)
2633 () "" ("Name:Value"::Text)])
2636 , "Name:Value\\n" ~:
2637 (Data.Either.rights $
2639 (Format.Ledger.Read.tag <* P.string "\n" <* P.eof)
2640 () "" ("Name:Value\n"::Text)])
2644 (Data.Either.rights $
2646 (Format.Ledger.Read.tag <* P.eof)
2647 () "" ("Name:Val ue"::Text)])
2649 [("Name", "Val ue")]
2651 (Data.Either.rights $
2653 (Format.Ledger.Read.tag <* P.eof)
2654 () "" ("Name:,"::Text)])
2658 (Data.Either.rights $
2660 (Format.Ledger.Read.tag <* P.eof)
2661 () "" ("Name:Val,ue"::Text)])
2663 [("Name", "Val,ue")]
2665 (Data.Either.rights $
2667 (Format.Ledger.Read.tag <* P.string ",ue:" <* P.eof)
2668 () "" ("Name:Val,ue:"::Text)])
2672 , "tags" ~: TestList
2674 (Data.Either.rights $
2676 (Format.Ledger.Read.tags <* P.eof)
2677 () "" ("Name:"::Text)])
2684 (Data.Either.rights $
2686 (Format.Ledger.Read.tags <* P.eof)
2687 () "" ("Name:,"::Text)])
2694 (Data.Either.rights $
2696 (Format.Ledger.Read.tags <* P.eof)
2697 () "" ("Name:,Name:"::Text)])
2700 [ ("Name", ["", ""])
2704 (Data.Either.rights $
2706 (Format.Ledger.Read.tags <* P.eof)
2707 () "" ("Name:,Name2:"::Text)])
2714 , "Name: , Name2:" ~:
2715 (Data.Either.rights $
2717 (Format.Ledger.Read.tags <* P.eof)
2718 () "" ("Name: , Name2:"::Text)])
2725 , "Name:,Name2:,Name3:" ~:
2726 (Data.Either.rights $
2728 (Format.Ledger.Read.tags <* P.eof)
2729 () "" ("Name:,Name2:,Name3:"::Text)])
2737 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ~:
2738 (Data.Either.rights $
2740 (Format.Ledger.Read.tags <* P.eof)
2741 () "" ("Name:Val ue,Name2:V a l u e,Name3:V al ue"::Text)])
2744 [ ("Name", ["Val ue"])
2745 , ("Name2", ["V a l u e"])
2746 , ("Name3", ["V al ue"])
2750 , "posting" ~: TestList
2751 [ " A:B:C = Right A:B:C" ~:
2752 (Data.Either.rights $
2753 [P.runParser_with_Error
2754 (Format.Ledger.Read.posting <* P.eof)
2755 Format.Ledger.Read.nil_Context "" (" A:B:C"::Text)])
2757 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
2758 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2760 , Format.Ledger.Posting_Type_Regular
2763 , " !A:B:C = Right !A:B:C" ~:
2764 (Data.List.map fst $
2765 Data.Either.rights $
2766 [P.runParser_with_Error
2767 (Format.Ledger.Read.posting <* P.eof)
2768 Format.Ledger.Read.nil_Context "" (" !A:B:C"::Text)])
2770 [ (Format.Ledger.posting ("A":|["B", "C"]))
2771 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2772 , Format.Ledger.posting_status = True
2775 , " *A:B:C = Right *A:B:C" ~:
2776 (Data.List.map fst $
2777 Data.Either.rights $
2778 [P.runParser_with_Error
2779 (Format.Ledger.Read.posting <* P.eof)
2780 Format.Ledger.Read.nil_Context "" (" *A:B:C"::Text)])
2782 [ (Format.Ledger.posting ("A":|["B", "C"]))
2783 { Format.Ledger.posting_amounts = Data.Map.fromList []
2784 , Format.Ledger.posting_comments = []
2785 , Format.Ledger.posting_dates = []
2786 , Format.Ledger.posting_status = True
2787 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2788 , Format.Ledger.posting_tags = Data.Map.fromList []
2791 , " A:B:C $1 = Right A:B:C $1" ~:
2792 (Data.List.map fst $
2793 Data.Either.rights $
2794 [P.runParser_with_Error
2795 (Format.Ledger.Read.posting <* P.eof)
2796 Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
2798 [ (Format.Ledger.posting ("A":|["B","C $1"]))
2799 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2802 , " A:B:C $1 = Right A:B:C $1" ~:
2803 (Data.List.map fst $
2804 Data.Either.rights $
2805 [P.runParser_with_Error
2806 (Format.Ledger.Read.posting <* P.eof)
2807 Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
2809 [ (Format.Ledger.posting ("A":|["B", "C"]))
2810 { Format.Ledger.posting_amounts = Data.Map.fromList
2812 { Amount.quantity = 1
2813 , Amount.style = Amount.Style.nil
2814 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2815 , Amount.Style.unit_spaced = Just False
2820 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2823 , " A:B:C $1 + 1€ = Right A:B:C $1 + 1€" ~:
2824 (Data.List.map fst $
2825 Data.Either.rights $
2826 [P.runParser_with_Error
2827 (Format.Ledger.Read.posting <* P.eof)
2828 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1€"::Text)])
2830 [ (Format.Ledger.posting ("A":|["B", "C"]))
2831 { Format.Ledger.posting_amounts = Data.Map.fromList
2833 { Amount.quantity = 1
2834 , Amount.style = Amount.Style.nil
2835 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2836 , Amount.Style.unit_spaced = Just False
2841 { Amount.quantity = 1
2842 , Amount.style = Amount.Style.nil
2843 { Amount.Style.unit_side = Just Amount.Style.Side_Right
2844 , Amount.Style.unit_spaced = Just False
2849 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2852 , " A:B:C $1 + 1$ = Right A:B:C $2" ~:
2853 (Data.List.map fst $
2854 Data.Either.rights $
2855 [P.runParser_with_Error
2856 (Format.Ledger.Read.posting <* P.eof)
2857 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1$"::Text)])
2859 [ (Format.Ledger.posting ("A":|["B", "C"]))
2860 { Format.Ledger.posting_amounts = Data.Map.fromList
2862 { Amount.quantity = 2
2863 , Amount.style = Amount.Style.nil
2864 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2865 , Amount.Style.unit_spaced = Just False
2870 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2873 , " A:B:C $1 + 1$ + 1$ = Right A:B:C $3" ~:
2874 (Data.List.map fst $
2875 Data.Either.rights $
2876 [P.runParser_with_Error
2877 (Format.Ledger.Read.posting <* P.eof)
2878 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1$ + 1$"::Text)])
2880 [ (Format.Ledger.posting ("A":|["B", "C"]))
2881 { Format.Ledger.posting_amounts = Data.Map.fromList
2883 { Amount.quantity = 3
2884 , Amount.style = Amount.Style.nil
2885 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2886 , Amount.Style.unit_spaced = Just False
2891 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2894 , " A:B:C ; some comment = Right A:B:C ; some comment" ~:
2895 (Data.List.map fst $
2896 Data.Either.rights $
2897 [P.runParser_with_Error
2898 (Format.Ledger.Read.posting <* P.eof)
2899 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment"::Text)])
2901 [ (Format.Ledger.posting ("A":|["B", "C"]))
2902 { Format.Ledger.posting_amounts = Data.Map.fromList []
2903 , Format.Ledger.posting_comments = [" some comment"]
2904 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2907 , " A:B:C ; some comment\\n ; some other comment = Right A:B:C ; some comment\\n ; some other comment" ~:
2908 (Data.List.map fst $
2909 Data.Either.rights $
2910 [P.runParser_with_Error
2911 (Format.Ledger.Read.posting <* P.eof)
2912 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment\n ; some other comment"::Text)])
2914 [ (Format.Ledger.posting ("A":|["B", "C"]))
2915 { Format.Ledger.posting_amounts = Data.Map.fromList []
2916 , Format.Ledger.posting_comments = [" some comment", " some other comment"]
2917 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2920 , " A:B:C $1 ; some comment = Right A:B:C $1 ; some comment" ~:
2921 (Data.List.map fst $
2922 Data.Either.rights $
2923 [P.runParser_with_Error
2924 (Format.Ledger.Read.posting)
2925 Format.Ledger.Read.nil_Context "" (" A:B:C $1 ; some comment"::Text)])
2927 [ (Format.Ledger.posting ("A":|["B", "C"]))
2928 { Format.Ledger.posting_amounts = Data.Map.fromList
2930 { Amount.quantity = 1
2931 , Amount.style = Amount.Style.nil
2932 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2933 , Amount.Style.unit_spaced = Just False
2938 , Format.Ledger.posting_comments = [" some comment"]
2939 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2942 , " A:B:C ; N:V = Right A:B:C ; N:V" ~:
2943 (Data.List.map fst $
2944 Data.Either.rights $
2945 [P.runParser_with_Error
2946 (Format.Ledger.Read.posting <* P.eof)
2947 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V"::Text)])
2949 [ (Format.Ledger.posting ("A":|["B", "C"]))
2950 { Format.Ledger.posting_comments = [" N:V"]
2951 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2952 , Format.Ledger.posting_tags = Data.Map.fromList
2957 , " A:B:C ; some comment N:V = Right A:B:C ; some comment N:V" ~:
2958 (Data.List.map fst $
2959 Data.Either.rights $
2960 [P.runParser_with_Error
2961 (Format.Ledger.Read.posting <* P.eof)
2962 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V"::Text)])
2964 [ (Format.Ledger.posting ("A":|["B", "C"]))
2965 { Format.Ledger.posting_comments = [" some comment N:V"]
2966 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2967 , Format.Ledger.posting_tags = Data.Map.fromList
2972 , " A:B:C ; some comment N:V v, N2:V2 v2 = Right A:B:C ; some comment N:V v, N2:V2 v2" ~:
2973 (Data.List.map fst $
2974 Data.Either.rights $
2975 [P.runParser_with_Error
2976 (Format.Ledger.Read.posting )
2977 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V v, N2:V2 v2"::Text)])
2979 [ (Format.Ledger.posting ("A":|["B", "C"]))
2980 { Format.Ledger.posting_comments = [" some comment N:V v, N2:V2 v2"]
2981 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2982 , Format.Ledger.posting_tags = Data.Map.fromList
2988 , " A:B:C ; N:V\\n ; N:V2 = Right A:B:C ; N:V\\n ; N:V2" ~:
2989 (Data.List.map fst $
2990 Data.Either.rights $
2991 [P.runParser_with_Error
2992 (Format.Ledger.Read.posting <* P.eof)
2993 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N:V2"::Text)])
2995 [ (Format.Ledger.posting ("A":|["B", "C"]))
2996 { Format.Ledger.posting_comments = [" N:V", " N:V2"]
2997 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2998 , Format.Ledger.posting_tags = Data.Map.fromList
2999 [ ("N", ["V", "V2"])
3003 , " A:B:C ; N:V\\n ; N2:V = Right A:B:C ; N:V\\n ; N2:V" ~:
3004 (Data.List.map fst $
3005 Data.Either.rights $
3006 [P.runParser_with_Error
3007 (Format.Ledger.Read.posting <* P.eof)
3008 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N2:V"::Text)])
3010 [ (Format.Ledger.posting ("A":|["B", "C"]))
3011 { Format.Ledger.posting_comments = [" N:V", " N2:V"]
3012 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3013 , Format.Ledger.posting_tags = Data.Map.fromList
3019 , " A:B:C ; date:2001/01/01 = Right A:B:C ; date:2001/01/01" ~:
3020 (Data.List.map fst $
3021 Data.Either.rights $
3022 [P.runParser_with_Error
3023 (Format.Ledger.Read.posting <* P.eof)
3024 Format.Ledger.Read.nil_Context "" (" A:B:C ; date:2001/01/01"::Text)])
3026 [ (Format.Ledger.posting ("A":|["B", "C"]))
3027 { Format.Ledger.posting_comments = [" date:2001/01/01"]
3028 , Format.Ledger.posting_dates =
3029 [ Time.zonedTimeToUTC $
3032 (Time.fromGregorian 2001 01 01)
3033 (Time.TimeOfDay 0 0 0))
3036 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3037 , Format.Ledger.posting_tags = Data.Map.fromList
3038 [ ("date", ["2001/01/01"])
3042 , " (A:B:C) = Right (A:B:C)" ~:
3043 (Data.Either.rights $
3044 [P.runParser_with_Error
3045 (Format.Ledger.Read.posting <* P.eof)
3046 Format.Ledger.Read.nil_Context "" (" (A:B:C)"::Text)])
3048 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
3049 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3051 , Format.Ledger.Posting_Type_Virtual
3054 , " [A:B:C] = Right [A:B:C]" ~:
3055 (Data.Either.rights $
3056 [P.runParser_with_Error
3057 (Format.Ledger.Read.posting <* P.eof)
3058 Format.Ledger.Read.nil_Context "" (" [A:B:C]"::Text)])
3060 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
3061 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3063 , Format.Ledger.Posting_Type_Virtual_Balanced
3067 , "transaction" ~: TestList
3068 [ "2000/01/01 some description\\n A:B:C $1\\n a:b:c" ~:
3069 (Data.Either.rights $
3070 [P.runParser_with_Error
3071 (Format.Ledger.Read.transaction <* P.eof)
3072 Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C $1\n a:b:c"::Text)])
3074 [ Format.Ledger.transaction
3075 { Format.Ledger.transaction_dates=
3076 ( Time.zonedTimeToUTC $
3079 (Time.fromGregorian 2000 01 01)
3080 (Time.TimeOfDay 0 0 0))
3083 , Format.Ledger.transaction_description="some description"
3084 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3085 [ (Format.Ledger.posting ("A":|["B", "C"]))
3086 { Format.Ledger.posting_amounts = Data.Map.fromList
3088 { Amount.quantity = 1
3089 , Amount.style = Amount.Style.nil
3090 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3091 , Amount.Style.unit_spaced = Just False
3096 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
3098 , (Format.Ledger.posting ("a":|["b", "c"]))
3099 { Format.Ledger.posting_amounts = Data.Map.fromList
3101 { Amount.quantity = -1
3102 , Amount.style = Amount.Style.nil
3103 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3104 , Amount.Style.unit_spaced = Just False
3109 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
3112 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3115 , "2000/01/01 some description\\n A:B:C $1\\n a:b:c\\n" ~:
3116 (Data.Either.rights $
3117 [P.runParser_with_Error
3118 (Format.Ledger.Read.transaction <* P.newline <* P.eof)
3119 Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C $1\n a:b:c\n"::Text)])
3121 [ Format.Ledger.transaction
3122 { Format.Ledger.transaction_dates=
3123 ( Time.zonedTimeToUTC $
3126 (Time.fromGregorian 2000 01 01)
3127 (Time.TimeOfDay 0 0 0))
3130 , Format.Ledger.transaction_description="some description"
3131 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3132 [ (Format.Ledger.posting ("A":|["B", "C"]))
3133 { Format.Ledger.posting_amounts = Data.Map.fromList
3135 { Amount.quantity = 1
3136 , Amount.style = Amount.Style.nil
3137 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3138 , Amount.Style.unit_spaced = Just False
3143 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
3145 , (Format.Ledger.posting ("a":|["b", "c"]))
3146 { Format.Ledger.posting_amounts = Data.Map.fromList
3148 { Amount.quantity = -1
3149 , Amount.style = Amount.Style.nil
3150 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3151 , Amount.Style.unit_spaced = Just False
3156 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
3159 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3162 , "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" ~:
3163 (Data.Either.rights $
3164 [P.runParser_with_Error
3165 (Format.Ledger.Read.transaction <* P.eof)
3166 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)])
3168 [ Format.Ledger.transaction
3169 { Format.Ledger.transaction_comments_after =
3171 , " some other;comment"
3173 , " some last comment"
3175 , Format.Ledger.transaction_dates=
3176 ( Time.zonedTimeToUTC $
3179 (Time.fromGregorian 2000 01 01)
3180 (Time.TimeOfDay 0 0 0))
3183 , Format.Ledger.transaction_description="some description"
3184 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3185 [ (Format.Ledger.posting ("A":|["B", "C"]))
3186 { Format.Ledger.posting_amounts = Data.Map.fromList
3188 { Amount.quantity = 1
3189 , Amount.style = Amount.Style.nil
3190 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3191 , Amount.Style.unit_spaced = Just False
3196 , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
3198 , (Format.Ledger.posting ("a":|["b", "c"]))
3199 { Format.Ledger.posting_amounts = Data.Map.fromList
3201 { Amount.quantity = -1
3202 , Amount.style = Amount.Style.nil
3203 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3204 , Amount.Style.unit_spaced = Just False
3209 , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
3212 , Format.Ledger.transaction_tags = Data.Map.fromList
3215 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3219 , "journal" ~: TestList
3220 [ "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
3222 P.runParserT_with_Error
3223 (Format.Ledger.Read.journal "" {-<* P.eof-})
3224 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)
3226 (\j -> j{Format.Ledger.journal_last_read_time=
3227 Format.Ledger.journal_last_read_time Format.Ledger.journal}) $
3228 Data.Either.rights [jnl])
3230 [ Format.Ledger.journal
3231 { Format.Ledger.journal_transactions =
3232 Format.Ledger.transaction_by_Date
3233 [ Format.Ledger.transaction
3234 { Format.Ledger.transaction_dates=
3235 ( Time.zonedTimeToUTC $
3238 (Time.fromGregorian 2000 01 01)
3239 (Time.TimeOfDay 0 0 0))
3242 , Format.Ledger.transaction_description="1° description"
3243 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3244 [ (Format.Ledger.posting ("A":|["B", "C"]))
3245 { Format.Ledger.posting_amounts = Data.Map.fromList
3247 { Amount.quantity = 1
3248 , Amount.style = Amount.Style.nil
3249 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3250 , Amount.Style.unit_spaced = Just False
3255 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
3257 , (Format.Ledger.posting ("a":|["b", "c"]))
3258 { Format.Ledger.posting_amounts = Data.Map.fromList
3260 { Amount.quantity = -1
3261 , Amount.style = Amount.Style.nil
3262 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3263 , Amount.Style.unit_spaced = Just False
3268 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
3271 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3273 , Format.Ledger.transaction
3274 { Format.Ledger.transaction_dates=
3275 ( Time.zonedTimeToUTC $
3278 (Time.fromGregorian 2000 01 02)
3279 (Time.TimeOfDay 0 0 0))
3282 , Format.Ledger.transaction_description="2° description"
3283 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3284 [ (Format.Ledger.posting ("A":|["B", "C"]))
3285 { Format.Ledger.posting_amounts = Data.Map.fromList
3287 { Amount.quantity = 1
3288 , Amount.style = Amount.Style.nil
3289 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3290 , Amount.Style.unit_spaced = Just False
3295 , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
3297 , (Format.Ledger.posting ("x":|["y", "z"]))
3298 { Format.Ledger.posting_amounts = Data.Map.fromList
3300 { Amount.quantity = -1
3301 , Amount.style = Amount.Style.nil
3302 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3303 , Amount.Style.unit_spaced = Just False
3308 , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
3311 , Format.Ledger.transaction_sourcepos = P.newPos "" 4 1
3318 , "Write" ~: TestList
3319 [ "account" ~: TestList
3321 ((Format.Ledger.Write.show
3322 Format.Ledger.Write.Style
3323 { Format.Ledger.Write.style_color=False
3324 , Format.Ledger.Write.style_align=True
3326 Format.Ledger.Write.account Format.Ledger.Posting_Type_Regular $
3331 ((Format.Ledger.Write.show
3332 Format.Ledger.Write.Style
3333 { Format.Ledger.Write.style_color=False
3334 , Format.Ledger.Write.style_align=True
3336 Format.Ledger.Write.account Format.Ledger.Posting_Type_Regular $
3341 ((Format.Ledger.Write.show
3342 Format.Ledger.Write.Style
3343 { Format.Ledger.Write.style_color=False
3344 , Format.Ledger.Write.style_align=True
3346 Format.Ledger.Write.account Format.Ledger.Posting_Type_Virtual $
3351 ((Format.Ledger.Write.show
3352 Format.Ledger.Write.Style
3353 { Format.Ledger.Write.style_color=False
3354 , Format.Ledger.Write.style_align=True
3356 Format.Ledger.Write.account Format.Ledger.Posting_Type_Virtual_Balanced $
3361 , "amount" ~: TestList
3363 ((Format.Ledger.Write.show
3364 Format.Ledger.Write.Style
3365 { Format.Ledger.Write.style_color=False
3366 , Format.Ledger.Write.style_align=True
3368 Format.Ledger.Write.amount
3373 ((Format.Ledger.Write.show
3374 Format.Ledger.Write.Style
3375 { Format.Ledger.Write.style_color=False
3376 , Format.Ledger.Write.style_align=True
3378 Format.Ledger.Write.amount
3380 { Amount.style = Amount.Style.nil
3381 { Amount.Style.precision = 2 }
3386 ((Format.Ledger.Write.show
3387 Format.Ledger.Write.Style
3388 { Format.Ledger.Write.style_color=False
3389 , Format.Ledger.Write.style_align=True
3391 Format.Ledger.Write.amount
3393 { Amount.quantity = Decimal 0 123
3398 ((Format.Ledger.Write.show
3399 Format.Ledger.Write.Style
3400 { Format.Ledger.Write.style_color=False
3401 , Format.Ledger.Write.style_align=True
3403 Format.Ledger.Write.amount
3405 { Amount.quantity = Decimal 0 (- 123)
3409 , "12.3 @ prec=0" ~:
3410 ((Format.Ledger.Write.show
3411 Format.Ledger.Write.Style
3412 { Format.Ledger.Write.style_color=False
3413 , Format.Ledger.Write.style_align=True
3415 Format.Ledger.Write.amount
3417 { Amount.quantity = Decimal 1 123
3418 , Amount.style = Amount.Style.nil
3419 { Amount.Style.fractioning = Just '.'
3424 , "12.5 @ prec=0" ~:
3425 ((Format.Ledger.Write.show
3426 Format.Ledger.Write.Style
3427 { Format.Ledger.Write.style_color=False
3428 , Format.Ledger.Write.style_align=True
3430 Format.Ledger.Write.amount
3432 { Amount.quantity = Decimal 1 125
3433 , Amount.style = Amount.Style.nil
3434 { Amount.Style.fractioning = Just '.'
3439 , "12.3 @ prec=1" ~:
3440 ((Format.Ledger.Write.show
3441 Format.Ledger.Write.Style
3442 { Format.Ledger.Write.style_color=False
3443 , Format.Ledger.Write.style_align=True
3445 Format.Ledger.Write.amount
3447 { Amount.quantity = Decimal 1 123
3448 , Amount.style = Amount.Style.nil
3449 { Amount.Style.fractioning = Just '.'
3450 , Amount.Style.precision = 1
3455 , "1,234.56 @ prec=2" ~:
3456 ((Format.Ledger.Write.show
3457 Format.Ledger.Write.Style
3458 { Format.Ledger.Write.style_color=False
3459 , Format.Ledger.Write.style_align=True
3461 Format.Ledger.Write.amount
3463 { Amount.quantity = Decimal 2 123456
3464 , Amount.style = Amount.Style.nil
3465 { Amount.Style.fractioning = Just '.'
3466 , Amount.Style.precision = 2
3467 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
3472 , "123,456,789,01,2.3456789 @ prec=7" ~:
3473 ((Format.Ledger.Write.show
3474 Format.Ledger.Write.Style
3475 { Format.Ledger.Write.style_color=False
3476 , Format.Ledger.Write.style_align=True
3478 Format.Ledger.Write.amount
3480 { Amount.quantity = Decimal 7 1234567890123456789
3481 , Amount.style = Amount.Style.nil
3482 { Amount.Style.fractioning = Just '.'
3483 , Amount.Style.precision = 7
3484 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3488 "123,456,789,01,2.3456789")
3489 , "1234567.8,90,123,456,789 @ prec=12" ~:
3490 ((Format.Ledger.Write.show
3491 Format.Ledger.Write.Style
3492 { Format.Ledger.Write.style_color=False
3493 , Format.Ledger.Write.style_align=True
3495 Format.Ledger.Write.amount
3497 { Amount.quantity = Decimal 12 1234567890123456789
3498 , Amount.style = Amount.Style.nil
3499 { Amount.Style.fractioning = Just '.'
3500 , Amount.Style.precision = 12
3501 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3505 "1234567.8,90,123,456,789")
3506 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
3507 ((Format.Ledger.Write.show
3508 Format.Ledger.Write.Style
3509 { Format.Ledger.Write.style_color=False
3510 , Format.Ledger.Write.style_align=True
3512 Format.Ledger.Write.amount
3514 { Amount.quantity = Decimal 7 1234567890123456789
3515 , Amount.style = Amount.Style.nil
3516 { Amount.Style.fractioning = Just '.'
3517 , Amount.Style.precision = 7
3518 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3522 "1,2,3,4,5,6,7,89,012.3456789")
3523 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
3524 ((Format.Ledger.Write.show
3525 Format.Ledger.Write.Style
3526 { Format.Ledger.Write.style_color=False
3527 , Format.Ledger.Write.style_align=True
3529 Format.Ledger.Write.amount
3531 { Amount.quantity = Decimal 12 1234567890123456789
3532 , Amount.style = Amount.Style.nil
3533 { Amount.Style.fractioning = Just '.'
3534 , Amount.Style.precision = 12
3535 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3539 "1234567.890,12,3,4,5,6,7,8,9")
3541 , "amount_length" ~: TestList
3543 ((Format.Ledger.Write.amount_length
3548 ((Format.Ledger.Write.amount_length
3550 { Amount.style = Amount.Style.nil
3551 { Amount.Style.precision = 2 }
3556 ((Format.Ledger.Write.amount_length
3558 { Amount.quantity = Decimal 0 123
3563 ((Format.Ledger.Write.amount_length
3565 { Amount.quantity = Decimal 0 (- 123)
3569 , "12.3 @ prec=0" ~:
3570 ((Format.Ledger.Write.amount_length
3572 { Amount.quantity = Decimal 1 123
3573 , Amount.style = Amount.Style.nil
3574 { Amount.Style.fractioning = Just '.'
3579 , "12.5 @ prec=0" ~:
3580 ((Format.Ledger.Write.amount_length
3582 { Amount.quantity = Decimal 1 125
3583 , Amount.style = Amount.Style.nil
3584 { Amount.Style.fractioning = Just '.'
3589 , "12.3 @ prec=1" ~:
3590 ((Format.Ledger.Write.amount_length
3592 { Amount.quantity = Decimal 1 123
3593 , Amount.style = Amount.Style.nil
3594 { Amount.Style.fractioning = Just '.'
3595 , Amount.Style.precision = 1
3600 , "1,234.56 @ prec=2" ~:
3601 ((Format.Ledger.Write.amount_length
3603 { Amount.quantity = Decimal 2 123456
3604 , Amount.style = Amount.Style.nil
3605 { Amount.Style.fractioning = Just '.'
3606 , Amount.Style.precision = 2
3607 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
3612 , "123,456,789,01,2.3456789 @ prec=7" ~:
3613 ((Format.Ledger.Write.amount_length
3615 { Amount.quantity = Decimal 7 1234567890123456789
3616 , Amount.style = Amount.Style.nil
3617 { Amount.Style.fractioning = Just '.'
3618 , Amount.Style.precision = 7
3619 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3624 , "1234567.8,90,123,456,789 @ prec=12" ~:
3625 ((Format.Ledger.Write.amount_length
3627 { Amount.quantity = Decimal 12 1234567890123456789
3628 , Amount.style = Amount.Style.nil
3629 { Amount.Style.fractioning = Just '.'
3630 , Amount.Style.precision = 12
3631 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3636 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
3637 ((Format.Ledger.Write.amount_length
3639 { Amount.quantity = Decimal 7 1234567890123456789
3640 , Amount.style = Amount.Style.nil
3641 { Amount.Style.fractioning = Just '.'
3642 , Amount.Style.precision = 7
3643 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3648 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
3649 ((Format.Ledger.Write.amount_length
3651 { Amount.quantity = Decimal 12 1234567890123456789
3652 , Amount.style = Amount.Style.nil
3653 { Amount.Style.fractioning = Just '.'
3654 , Amount.Style.precision = 12
3655 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3660 , "1000000.000,00,0,0,0,0,0,0,0 @ prec=12" ~:
3661 ((Format.Ledger.Write.amount_length
3663 { Amount.quantity = Decimal 12 1000000000000000000
3664 , Amount.style = Amount.Style.nil
3665 { Amount.Style.fractioning = Just '.'
3666 , Amount.Style.precision = 12
3667 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3673 ((Format.Ledger.Write.amount_length $
3675 { Amount.quantity = Decimal 0 999
3676 , Amount.style = Amount.Style.nil
3677 { Amount.Style.precision = 0
3682 , "1000 @ prec=0" ~:
3683 ((Format.Ledger.Write.amount_length $
3685 { Amount.quantity = Decimal 0 1000
3686 , Amount.style = Amount.Style.nil
3687 { Amount.Style.precision = 0
3692 , "10,00€ @ prec=2" ~:
3693 ((Format.Ledger.Write.amount_length $ Amount.eur 10)
3697 , "date" ~: TestList
3699 ((Format.Ledger.Write.show
3700 Format.Ledger.Write.Style
3701 { Format.Ledger.Write.style_color=False
3702 , Format.Ledger.Write.style_align=True
3704 Format.Ledger.Write.date
3708 , "2000/01/01 12:34:51 CET" ~:
3709 (Format.Ledger.Write.show
3710 Format.Ledger.Write.Style
3711 { Format.Ledger.Write.style_color=False
3712 , Format.Ledger.Write.style_align=True
3714 Format.Ledger.Write.date $
3715 Time.zonedTimeToUTC $
3718 (Time.fromGregorian 2000 01 01)
3719 (Time.TimeOfDay 12 34 51))
3720 (Time.TimeZone 60 False "CET"))
3722 "2000/01/01 11:34:51"
3723 , "2000/01/01 12:34:51 +0100" ~:
3724 (Format.Ledger.Write.show
3725 Format.Ledger.Write.Style
3726 { Format.Ledger.Write.style_color=False
3727 , Format.Ledger.Write.style_align=True
3729 Format.Ledger.Write.date $
3730 Time.zonedTimeToUTC $
3733 (Time.fromGregorian 2000 01 01)
3734 (Time.TimeOfDay 12 34 51))
3735 (Time.TimeZone 60 False ""))
3737 "2000/01/01 11:34:51"
3738 , "2000/01/01 01:02:03" ~:
3739 (Format.Ledger.Write.show
3740 Format.Ledger.Write.Style
3741 { Format.Ledger.Write.style_color=False
3742 , Format.Ledger.Write.style_align=True
3744 Format.Ledger.Write.date $
3745 Time.zonedTimeToUTC $
3748 (Time.fromGregorian 2000 01 01)
3749 (Time.TimeOfDay 1 2 3))
3752 "2000/01/01 01:02:03"
3754 (Format.Ledger.Write.show
3755 Format.Ledger.Write.Style
3756 { Format.Ledger.Write.style_color=False
3757 , Format.Ledger.Write.style_align=True
3759 Format.Ledger.Write.date $
3760 Time.zonedTimeToUTC $
3763 (Time.fromGregorian 0 01 01)
3764 (Time.TimeOfDay 1 2 0))
3769 (Format.Ledger.Write.show
3770 Format.Ledger.Write.Style
3771 { Format.Ledger.Write.style_color=False
3772 , Format.Ledger.Write.style_align=True
3774 Format.Ledger.Write.date $
3775 Time.zonedTimeToUTC $
3778 (Time.fromGregorian 0 01 01)
3779 (Time.TimeOfDay 1 0 0))
3784 (Format.Ledger.Write.show
3785 Format.Ledger.Write.Style
3786 { Format.Ledger.Write.style_color=False
3787 , Format.Ledger.Write.style_align=True
3789 Format.Ledger.Write.date $
3790 Time.zonedTimeToUTC $
3793 (Time.fromGregorian 0 01 01)
3794 (Time.TimeOfDay 0 1 0))
3799 (Format.Ledger.Write.show
3800 Format.Ledger.Write.Style
3801 { Format.Ledger.Write.style_color=False
3802 , Format.Ledger.Write.style_align=True
3804 Format.Ledger.Write.date $
3805 Time.zonedTimeToUTC $
3808 (Time.fromGregorian 0 01 01)
3809 (Time.TimeOfDay 0 0 0))
3814 , "transaction" ~: TestList
3816 ((Format.Ledger.Write.show
3817 Format.Ledger.Write.Style
3818 { Format.Ledger.Write.style_color=False
3819 , Format.Ledger.Write.style_align=True
3821 Format.Ledger.Write.transaction
3822 Format.Ledger.transaction)
3825 , "2000/01/01 some description\\n\\ta:b:c\\n\\t ; first comment\\n\\t ; second comment\\n\\t ; third comment\\n\\tA:B:C $1" ~:
3826 ((Format.Ledger.Write.show
3827 Format.Ledger.Write.Style
3828 { Format.Ledger.Write.style_color=False
3829 , Format.Ledger.Write.style_align=True
3831 Format.Ledger.Write.transaction $
3832 Format.Ledger.transaction
3833 { Format.Ledger.transaction_dates=
3834 ( Time.zonedTimeToUTC $
3837 (Time.fromGregorian 2000 01 01)
3838 (Time.TimeOfDay 0 0 0))
3841 , Format.Ledger.transaction_description="some description"
3842 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3843 [ (Format.Ledger.posting ("A":|["B", "C"]))
3844 { Format.Ledger.posting_amounts = Data.Map.fromList
3846 { Amount.quantity = 1
3847 , Amount.style = Amount.Style.nil
3848 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3849 , Amount.Style.unit_spaced = Just False
3855 , (Format.Ledger.posting ("a":|["b", "c"]))
3856 { Format.Ledger.posting_comments = ["first comment","second comment","third comment"]
3861 "2000/01/01 some description\n\ta:b:c\n\t ; first comment\n\t ; second comment\n\t ; third comment\n\tA:B:C $1")
3862 , "2000/01/01 some description\\n\\tA:B:C $1\\n\\tAA:BB:CC $123" ~:
3863 ((Format.Ledger.Write.show
3864 Format.Ledger.Write.Style
3865 { Format.Ledger.Write.style_color=False
3866 , Format.Ledger.Write.style_align=True
3868 Format.Ledger.Write.transaction $
3869 Format.Ledger.transaction
3870 { Format.Ledger.transaction_dates=
3871 ( Time.zonedTimeToUTC $
3874 (Time.fromGregorian 2000 01 01)
3875 (Time.TimeOfDay 0 0 0))
3878 , Format.Ledger.transaction_description="some description"
3879 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3880 [ (Format.Ledger.posting ("A":|["B", "C"]))
3881 { Format.Ledger.posting_amounts = Data.Map.fromList
3883 { Amount.quantity = 1
3884 , Amount.style = Amount.Style.nil
3885 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3886 , Amount.Style.unit_spaced = Just False
3892 , (Format.Ledger.posting ("AA":|["BB", "CC"]))
3893 { Format.Ledger.posting_amounts = Data.Map.fromList
3895 { Amount.quantity = 123
3896 , Amount.style = Amount.Style.nil
3897 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3898 , Amount.Style.unit_spaced = Just False
3907 "2000/01/01 some description\n\tA:B:C $1\n\tAA:BB:CC $123")