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_Both
1213 , Balance.balance_by_unit =
1215 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1217 { Balance.unit_sum_amount = Balance.Amount_Sum_Both
1220 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1225 , "[A+$1, A-€1] = {A+$1-€1, $+1 €-1}" ~:
1227 (flip Balance.balance)
1229 [ (Format.Ledger.posting ("A":|[]))
1230 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1232 , (Format.Ledger.posting ("A":|[]))
1233 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1 ]
1238 { Balance.balance_by_account =
1239 Lib.TreeMap.from_List const $
1240 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1241 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ -1 ]) ]
1242 , Balance.balance_by_unit =
1244 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1246 { Balance.unit_sum_amount = Balance.Amount_Sum_Positive (Amount.usd $ 1)
1247 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1251 { Balance.unit_sum_amount = Balance.Amount_Sum_Negative (Amount.eur $ -1)
1252 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1257 , "[A+$1, B-$1] = {A+$1 B-$1, $+0}" ~:
1259 (flip Balance.balance)
1261 [ (Format.Ledger.posting ("A":|[]))
1262 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1264 , (Format.Ledger.posting ("B":|[]))
1265 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ]
1270 { Balance.balance_by_account =
1271 Lib.TreeMap.from_List const $
1272 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1273 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1274 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
1276 , Balance.balance_by_unit =
1278 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1280 { Balance.unit_sum_amount = Balance.Amount_Sum_Both
1283 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1290 (flip Balance.balance)
1292 [ (Format.Ledger.posting ("A":|[]))
1293 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1295 , (Format.Ledger.posting ("B":|[]))
1296 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
1301 { Balance.balance_by_account =
1302 Lib.TreeMap.from_List const $
1303 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1304 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1305 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
1307 , Balance.balance_by_unit =
1309 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1311 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1312 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1317 , "[A+$1+€2, A-$1-€2] = {A+$0+€0, $+0 €+0}" ~:
1319 (flip Balance.balance)
1321 [ (Format.Ledger.posting ("A":|[]))
1322 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2 ]
1324 , (Format.Ledger.posting ("A":|[]))
1325 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2 ]
1330 { Balance.balance_by_account =
1331 Lib.TreeMap.from_List const $
1333 , Data.Map.fromListWith const $
1334 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance s, s))
1335 [ Balance.Amount_Sum_Both (Amount.usd $ -1) (Amount.usd $ 1)
1336 , Balance.Amount_Sum_Both (Amount.eur $ -2) (Amount.eur $ 2)
1340 , Balance.balance_by_unit =
1342 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1344 { Balance.unit_sum_amount = Balance.Amount_Sum_Both (Amount.usd $ -1) (Amount.usd $ 1)
1345 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1349 { Balance.unit_sum_amount = Balance.Amount_Sum_Both (Amount.eur $ -2) (Amount.eur $ 2)
1350 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1355 , "[A+$1+€2+£3, B-$1-2€-£3] = {A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~:
1357 (flip Balance.balance)
1359 [ (Format.Ledger.posting ("A":|[]))
1360 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ]
1362 , (Format.Ledger.posting ("B":|[]))
1363 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ]
1368 { Balance.balance_by_account =
1369 Lib.TreeMap.from_List const $
1370 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1371 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
1372 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
1374 , Balance.balance_by_unit =
1376 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1378 { Balance.unit_sum_amount = Balance.Amount_Sum_Both (Amount.usd $ -1) (Amount.usd $ 1)
1379 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1383 { Balance.unit_sum_amount = Balance.Amount_Sum_Both (Amount.eur $ -2) (Amount.eur $ 2)
1384 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1388 { Balance.unit_sum_amount = Balance.Amount_Sum_Both (Amount.gbp $ -3) (Amount.gbp $ 3)
1389 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1395 , "union" ~: TestList
1396 [ "nil nil = nil" ~:
1397 Balance.union Balance.nil Balance.nil
1399 (Balance.nil::Balance.Balance Amount)
1400 , "{A+$1, $+1} {A+$1, $+1} = {A+$2, $+2}" ~:
1403 { Balance.balance_by_account =
1404 Lib.TreeMap.from_List const $
1405 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1406 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1407 , Balance.balance_by_unit =
1409 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1411 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1412 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1418 { Balance.balance_by_account =
1419 Lib.TreeMap.from_List const $
1420 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1421 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1422 , Balance.balance_by_unit =
1424 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1426 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1427 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1434 { Balance.balance_by_account =
1435 Lib.TreeMap.from_List const $
1436 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1437 [ ("A":|[], Amount.from_List [ Amount.usd $ 2 ]) ]
1438 , Balance.balance_by_unit =
1440 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1442 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1443 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1448 , "{A+$1, $+1} {B+$1, $+1} = {A+$1 B+$1, $+2}" ~:
1451 { Balance.balance_by_account =
1452 Lib.TreeMap.from_List const $
1453 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1454 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1455 , Balance.balance_by_unit =
1457 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1459 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1460 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1466 { Balance.balance_by_account =
1467 Lib.TreeMap.from_List const $
1468 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1469 [ ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1470 , Balance.balance_by_unit =
1472 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1474 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1475 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1482 { Balance.balance_by_account =
1483 Lib.TreeMap.from_List const $
1484 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1485 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1486 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1487 , Balance.balance_by_unit =
1489 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1491 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1492 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1497 , "{A+$1, $+1} {B+€1, €+1} = {A+$1 B+€1, $+1 €+1}" ~:
1500 { Balance.balance_by_account =
1501 Lib.TreeMap.from_List const $
1502 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1503 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
1504 , Balance.balance_by_unit =
1506 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1508 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1509 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1515 { Balance.balance_by_account =
1516 Lib.TreeMap.from_List const $
1517 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1518 [ ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
1519 , Balance.balance_by_unit =
1521 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1523 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
1524 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1531 { Balance.balance_by_account =
1532 Lib.TreeMap.from_List const $
1533 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1534 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1535 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
1536 , Balance.balance_by_unit =
1538 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1540 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1541 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1545 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
1546 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1552 , "expanded" ~: TestList
1553 [ "nil_By_Account" ~:
1557 (Lib.TreeMap.empty::Balance.Expanded Amount)
1560 (Lib.TreeMap.from_List const $
1561 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1562 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ])
1564 (Lib.TreeMap.from_List const $
1565 [ ("A":|[], Balance.Account_Sum_Expanded
1566 { Balance.inclusive =
1567 Data.Map.map Balance.amount_sum $
1568 Amount.from_List [ Amount.usd $ 1 ]
1569 , Balance.exclusive =
1570 Data.Map.map Balance.amount_sum $
1571 Amount.from_List [ Amount.usd $ 1 ]
1574 , "A/A+$1 = A+$1 A/A+$1" ~:
1576 (Lib.TreeMap.from_List const $
1577 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1578 [ ("A":|["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
1580 (Lib.TreeMap.from_List const
1581 [ ("A":|[], Balance.Account_Sum_Expanded
1582 { Balance.inclusive =
1583 Data.Map.map Balance.amount_sum $
1584 Amount.from_List [ Amount.usd $ 1 ]
1585 , Balance.exclusive =
1586 Data.Map.map Balance.amount_sum $
1589 , ("A":|["A"], Balance.Account_Sum_Expanded
1590 { Balance.inclusive =
1591 Data.Map.map Balance.amount_sum $
1592 Amount.from_List [ Amount.usd $ 1 ]
1593 , Balance.exclusive =
1594 Data.Map.map Balance.amount_sum $
1595 Amount.from_List [ Amount.usd $ 1 ]
1598 , "A/B+$1 = A+$1 A/B+$1" ~:
1600 (Lib.TreeMap.from_List const $
1601 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1602 [ ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ]) ])
1604 (Lib.TreeMap.from_List const
1605 [ ("A":|[], Balance.Account_Sum_Expanded
1606 { Balance.inclusive =
1607 Data.Map.map Balance.amount_sum $
1608 Amount.from_List [ Amount.usd $ 1 ]
1609 , Balance.exclusive =
1610 Data.Map.map Balance.amount_sum $
1613 , ("A":|["B"], Balance.Account_Sum_Expanded
1614 { Balance.inclusive =
1615 Data.Map.map Balance.amount_sum $
1616 Amount.from_List [ Amount.usd $ 1 ]
1617 , Balance.exclusive =
1618 Data.Map.map Balance.amount_sum $
1619 Amount.from_List [ Amount.usd $ 1 ]
1622 , "A/B/C+$1 = A+$1 A/B+$1 A/B/C+$1" ~:
1624 (Lib.TreeMap.from_List const $
1625 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1626 [ ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
1628 (Lib.TreeMap.from_List const $
1629 [ ("A":|[], Balance.Account_Sum_Expanded
1630 { Balance.inclusive =
1631 Data.Map.map Balance.amount_sum $
1632 Amount.from_List [ Amount.usd $ 1 ]
1633 , Balance.exclusive =
1634 Data.Map.map Balance.amount_sum $
1637 , ("A":|["B"], Balance.Account_Sum_Expanded
1638 { Balance.inclusive =
1639 Data.Map.map Balance.amount_sum $
1640 Amount.from_List [ Amount.usd $ 1 ]
1641 , Balance.exclusive =
1642 Data.Map.map Balance.amount_sum $
1645 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
1646 { Balance.inclusive =
1647 Data.Map.map Balance.amount_sum $
1648 Amount.from_List [ Amount.usd $ 1 ]
1649 , Balance.exclusive =
1650 Data.Map.map Balance.amount_sum $
1651 Amount.from_List [ Amount.usd $ 1 ]
1654 , "A+$1 A/B+$1 = A+$2 A/B+$1" ~:
1656 (Lib.TreeMap.from_List const $
1657 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1658 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1659 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1662 (Lib.TreeMap.from_List const
1663 [ ("A":|[], Balance.Account_Sum_Expanded
1664 { Balance.inclusive =
1665 Data.Map.map Balance.amount_sum $
1666 Amount.from_List [ Amount.usd $ 2 ]
1667 , Balance.exclusive =
1668 Data.Map.map Balance.amount_sum $
1669 Amount.from_List [ Amount.usd $ 1 ]
1671 , ("A":|["B"], 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 $
1677 Amount.from_List [ Amount.usd $ 1 ]
1680 , "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
1682 (Lib.TreeMap.from_List const $
1683 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1684 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1685 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1686 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
1689 (Lib.TreeMap.from_List const
1690 [ ("A":|[], Balance.Account_Sum_Expanded
1691 { Balance.inclusive =
1692 Data.Map.map Balance.amount_sum $
1693 Amount.from_List [ Amount.usd $ 3 ]
1694 , Balance.exclusive =
1695 Data.Map.map Balance.amount_sum $
1696 Amount.from_List [ Amount.usd $ 1 ]
1698 , ("A":|["B"], Balance.Account_Sum_Expanded
1699 { Balance.inclusive =
1700 Data.Map.map Balance.amount_sum $
1701 Amount.from_List [ Amount.usd $ 2 ]
1702 , Balance.exclusive =
1703 Data.Map.map Balance.amount_sum $
1704 Amount.from_List [ Amount.usd $ 1 ]
1706 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
1707 { Balance.inclusive =
1708 Data.Map.map Balance.amount_sum $
1709 Amount.from_List [ Amount.usd $ 1 ]
1710 , Balance.exclusive =
1711 Data.Map.map Balance.amount_sum $
1712 Amount.from_List [ Amount.usd $ 1 ]
1715 , "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" ~:
1717 (Lib.TreeMap.from_List const $
1718 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1719 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1720 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1721 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
1722 , ("A":|["B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
1725 (Lib.TreeMap.from_List const
1726 [ ("A":|[], Balance.Account_Sum_Expanded
1727 { Balance.inclusive =
1728 Data.Map.map Balance.amount_sum $
1729 Amount.from_List [ Amount.usd $ 4 ]
1730 , Balance.exclusive =
1731 Data.Map.map Balance.amount_sum $
1732 Amount.from_List [ Amount.usd $ 1 ]
1734 , ("A":|["B"], Balance.Account_Sum_Expanded
1735 { Balance.inclusive =
1736 Data.Map.map Balance.amount_sum $
1737 Amount.from_List [ Amount.usd $ 3 ]
1738 , Balance.exclusive =
1739 Data.Map.map Balance.amount_sum $
1740 Amount.from_List [ Amount.usd $ 1 ]
1742 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
1743 { Balance.inclusive =
1744 Data.Map.map Balance.amount_sum $
1745 Amount.from_List [ Amount.usd $ 2 ]
1746 , Balance.exclusive =
1747 Data.Map.map Balance.amount_sum $
1748 Amount.from_List [ Amount.usd $ 1 ]
1750 , ("A":|["B", "C", "D"], Balance.Account_Sum_Expanded
1751 { Balance.inclusive =
1752 Data.Map.map Balance.amount_sum $
1753 Amount.from_List [ Amount.usd $ 1 ]
1754 , Balance.exclusive =
1755 Data.Map.map Balance.amount_sum $
1756 Amount.from_List [ Amount.usd $ 1 ]
1759 , "A+$1 A/B+$1 A/BB+$1 AA/B+$1 = A+$3 A/B+$1 A/BB+$1 AA+$1 AA/B+$1" ~:
1761 (Lib.TreeMap.from_List const $
1762 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1763 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1764 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1765 , ("A":|["BB"], Amount.from_List [ Amount.usd $ 1 ])
1766 , ("AA":|["B"], Amount.from_List [ Amount.usd $ 1 ])
1769 (Lib.TreeMap.from_List const
1770 [ ("A":|[], Balance.Account_Sum_Expanded
1771 { Balance.inclusive =
1772 Data.Map.map Balance.amount_sum $
1773 Amount.from_List [ Amount.usd $ 3 ]
1774 , Balance.exclusive =
1775 Data.Map.map Balance.amount_sum $
1776 Amount.from_List [ Amount.usd $ 1 ]
1778 , ("A":|["B"], Balance.Account_Sum_Expanded
1779 { Balance.inclusive =
1780 Data.Map.map Balance.amount_sum $
1781 Amount.from_List [ Amount.usd $ 1 ]
1782 , Balance.exclusive =
1783 Data.Map.map Balance.amount_sum $
1784 Amount.from_List [ Amount.usd $ 1 ]
1786 , ("A":|["BB"], Balance.Account_Sum_Expanded
1787 { Balance.inclusive =
1788 Data.Map.map Balance.amount_sum $
1789 Amount.from_List [ Amount.usd $ 1 ]
1790 , Balance.exclusive =
1791 Data.Map.map Balance.amount_sum $
1792 Amount.from_List [ Amount.usd $ 1 ]
1794 , ("AA":|[], Balance.Account_Sum_Expanded
1795 { Balance.inclusive =
1796 Data.Map.map Balance.amount_sum $
1797 Amount.from_List [ Amount.usd $ 1 ]
1798 , Balance.exclusive =
1799 Data.Map.map Balance.amount_sum $
1802 , ("AA":|["B"], Balance.Account_Sum_Expanded
1803 { Balance.inclusive =
1804 Data.Map.map Balance.amount_sum $
1805 Amount.from_List [ Amount.usd $ 1 ]
1806 , Balance.exclusive =
1807 Data.Map.map Balance.amount_sum $
1808 Amount.from_List [ Amount.usd $ 1 ]
1812 , "deviation" ~: TestList
1814 (Balance.deviation $
1816 { Balance.balance_by_account =
1817 Lib.TreeMap.from_List const $
1818 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1819 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1820 , ("B":|[], Amount.from_List [])
1822 , Balance.balance_by_unit =
1824 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1826 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1827 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1833 (Balance.Deviation $
1835 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1837 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1838 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1842 , "{A+$1 B+$1, $2}" ~:
1843 (Balance.deviation $
1845 { Balance.balance_by_account =
1846 Lib.TreeMap.from_List const $
1847 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1848 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1849 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
1851 , Balance.balance_by_unit =
1853 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1855 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
1856 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1864 (Balance.Deviation $
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 $ 2
1869 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1875 , "is_equilibrium_inferrable" ~: TestList
1876 [ "nil" ~: TestCase $
1878 Balance.is_equilibrium_inferrable $
1880 (Balance.nil::Balance.Balance Amount.Amount)
1881 , "{A+$0, $+0}" ~: TestCase $
1883 Balance.is_equilibrium_inferrable $
1886 { Balance.balance_by_account =
1887 Lib.TreeMap.from_List const $
1888 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1889 [ ("A":|[], Amount.from_List [ Amount.usd $ 0 ])
1891 , Balance.balance_by_unit =
1893 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1895 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
1896 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1901 , "{A+$1, $+1}" ~: TestCase $
1903 Balance.is_equilibrium_inferrable $
1906 { Balance.balance_by_account =
1907 Lib.TreeMap.from_List const $
1908 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1909 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1911 , Balance.balance_by_unit =
1913 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1915 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1916 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1921 , "{A+$0+€0, $0 €+0}" ~: TestCase $
1923 Balance.is_equilibrium_inferrable $
1926 { Balance.balance_by_account =
1927 Lib.TreeMap.from_List const $
1928 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1929 [ ("A":|[], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
1931 , Balance.balance_by_unit =
1933 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1935 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
1936 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1940 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 0
1941 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1946 , "{A+$1, B-$1, $+0}" ~: TestCase $
1948 Balance.is_equilibrium_inferrable $
1951 { Balance.balance_by_account =
1952 Lib.TreeMap.from_List const $
1953 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1954 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1955 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
1957 , Balance.balance_by_unit =
1959 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1961 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
1962 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1967 , "{A+$1 B, $+1}" ~: TestCase $
1969 Balance.is_equilibrium_inferrable $
1972 { Balance.balance_by_account =
1973 Lib.TreeMap.from_List const $
1974 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
1975 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
1976 , ("B":|[], Amount.from_List [])
1978 , Balance.balance_by_unit =
1980 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
1982 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 1
1983 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
1988 , "{A+$1 B+€1, $+1 €+1}" ~: 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.eur $ 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 $ 1
2004 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2008 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
2009 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2014 , "{A+$1 B-$1+€1, $+0 €+1}" ~: TestCase $
2016 Balance.is_equilibrium_inferrable $
2019 { Balance.balance_by_account =
2020 Lib.TreeMap.from_List const $
2021 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
2022 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2023 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ 1 ])
2025 , Balance.balance_by_unit =
2027 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
2029 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
2030 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2034 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 1
2035 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2040 , "{A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~: TestCase $
2042 Balance.is_equilibrium_inferrable $
2045 { Balance.balance_by_account =
2046 Lib.TreeMap.from_List const $
2047 Data.List.map (id *** Data.Map.map Balance.amount_sum) $
2048 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
2049 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
2051 , Balance.balance_by_unit =
2053 Data.List.map (\s -> (Amount.unit $ Balance.amount_sum_balance $ Balance.unit_sum_amount s, s))
2055 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 0
2056 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2060 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.eur $ 0
2061 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2065 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.gbp $ 0
2066 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2072 , "infer_equilibrium" ~: TestList
2074 (snd $ Balance.infer_equilibrium $
2075 Format.Ledger.posting_by_Account
2076 [ (Format.Ledger.posting ("A":|[]))
2077 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2078 , (Format.Ledger.posting ("B":|[]))
2079 { Format.Ledger.posting_amounts=Amount.from_List [] }
2083 Format.Ledger.posting_by_Account
2084 [ (Format.Ledger.posting ("A":|[]))
2085 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2086 , (Format.Ledger.posting ("B":|[]))
2087 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ] }
2090 (snd $ Balance.infer_equilibrium $
2091 Format.Ledger.posting_by_Account
2092 [ (Format.Ledger.posting ("A":|[]))
2093 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2094 , (Format.Ledger.posting ("B":|[]))
2095 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1 ] }
2099 Format.Ledger.posting_by_Account
2100 [ (Format.Ledger.posting ("A":|[]))
2101 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 1] }
2102 , (Format.Ledger.posting ("B":|[]))
2103 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1, Amount.usd $ -1 ] }
2106 (snd $ Balance.infer_equilibrium $
2107 Format.Ledger.posting_by_Account
2108 [ (Format.Ledger.posting ("A":|[]))
2109 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2110 , (Format.Ledger.posting ("B":|[]))
2111 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2116 { Balance.unit_sum_amount = Balance.amount_sum $ Amount.usd $ 2
2117 , Balance.unit_sum_accounts = Data.Map.fromList []}
2119 , "{A+$1 B-$1 B-1€}" ~:
2120 (snd $ Balance.infer_equilibrium $
2121 Format.Ledger.posting_by_Account
2122 [ (Format.Ledger.posting ("A":|[]))
2123 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
2124 , (Format.Ledger.posting ("B":|[]))
2125 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -1 ] }
2129 Format.Ledger.posting_by_Account
2130 [ (Format.Ledger.posting ("A":|[]))
2131 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 1 ] }
2132 , (Format.Ledger.posting ("B":|[]))
2133 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -1 ] }
2137 , "Format" ~: TestList
2138 [ "Ledger" ~: TestList
2139 [ "Read" ~: TestList
2140 [ "account_name" ~: TestList
2142 (Data.Either.rights $
2144 (Format.Ledger.Read.account_name <* P.eof)
2149 (Data.Either.rights $
2151 (Format.Ledger.Read.account_name <* P.eof)
2156 (Data.Either.rights $
2158 (Format.Ledger.Read.account_name <* P.eof)
2159 () "" ("AA"::Text)])
2163 (Data.Either.rights $
2165 (Format.Ledger.Read.account_name <* P.eof)
2170 (Data.Either.rights $
2172 (Format.Ledger.Read.account_name <* P.eof)
2177 (Data.Either.rights $
2179 (Format.Ledger.Read.account_name <* P.eof)
2180 () "" ("A:"::Text)])
2184 (Data.Either.rights $
2186 (Format.Ledger.Read.account_name <* P.eof)
2187 () "" (":A"::Text)])
2191 (Data.Either.rights $
2193 (Format.Ledger.Read.account_name <* P.eof)
2194 () "" ("A "::Text)])
2198 (Data.Either.rights $
2200 (Format.Ledger.Read.account_name)
2201 () "" ("A "::Text)])
2205 (Data.Either.rights $
2207 (Format.Ledger.Read.account_name <* P.eof)
2208 () "" ("A A"::Text)])
2212 (Data.Either.rights $
2214 (Format.Ledger.Read.account_name <* P.eof)
2215 () "" ("A "::Text)])
2219 (Data.Either.rights $
2221 (Format.Ledger.Read.account_name <* P.eof)
2222 () "" ("A \n"::Text)])
2226 (Data.Either.rights $
2228 (Format.Ledger.Read.account_name <* P.eof)
2229 () "" ("(A)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 <* P.eof)
2243 () "" ("(A) A"::Text)])
2247 (Data.Either.rights $
2249 (Format.Ledger.Read.account_name <* P.eof)
2250 () "" ("[ ]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)"::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]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 , "account" ~: TestList
2305 (Data.Either.rights $
2307 (Format.Ledger.Read.account <* P.eof)
2312 (Data.Either.rights $
2314 (Format.Ledger.Read.account <* P.eof)
2319 (Data.Either.rights $
2321 (Format.Ledger.Read.account <* P.eof)
2322 () "" ("A:"::Text)])
2326 (Data.Either.rights $
2328 (Format.Ledger.Read.account <* P.eof)
2329 () "" (":A"::Text)])
2333 (Data.Either.rights $
2335 (Format.Ledger.Read.account <* P.eof)
2336 () "" ("A "::Text)])
2340 (Data.Either.rights $
2342 (Format.Ledger.Read.account <* P.eof)
2343 () "" (" A"::Text)])
2347 (Data.Either.rights $
2349 (Format.Ledger.Read.account <* P.eof)
2350 () "" ("A:B"::Text)])
2354 (Data.Either.rights $
2356 (Format.Ledger.Read.account <* P.eof)
2357 () "" ("A:B:C"::Text)])
2360 , "\"Aa:Bbb:Cccc\"" ~:
2361 (Data.Either.rights $
2363 (Format.Ledger.Read.account <* P.eof)
2364 () "" ("Aa:Bbb:Cccc"::Text)])
2366 ["Aa":|["Bbb", "Cccc"]]
2367 , "\"A a : B b b : C c c c\"" ~:
2368 (Data.Either.rights $
2370 (Format.Ledger.Read.account <* P.eof)
2371 () "" ("A a : B b b : C c c c"::Text)])
2373 ["A a ":|[" B b b ", " C c c c"]]
2375 (Data.Either.rights $
2377 (Format.Ledger.Read.account <* P.eof)
2378 () "" ("A: :C"::Text)])
2382 (Data.Either.rights $
2384 (Format.Ledger.Read.account <* P.eof)
2385 () "" ("A::C"::Text)])
2389 (Data.Either.rights $
2391 (Format.Ledger.Read.account <* P.eof)
2392 () "" ("A:B:(C)"::Text)])
2396 , "posting_type" ~: TestList
2398 Format.Ledger.Read.posting_type
2401 (Format.Ledger.Posting_Type_Regular, "A":|[])
2403 Format.Ledger.Read.posting_type
2406 (Format.Ledger.Posting_Type_Regular, "(":|[])
2408 Format.Ledger.Read.posting_type
2411 (Format.Ledger.Posting_Type_Regular, ")":|[])
2413 Format.Ledger.Read.posting_type
2416 (Format.Ledger.Posting_Type_Regular, "()":|[])
2418 Format.Ledger.Read.posting_type
2421 (Format.Ledger.Posting_Type_Regular, "( )":|[])
2423 Format.Ledger.Read.posting_type
2426 (Format.Ledger.Posting_Type_Virtual, "A":|[])
2428 Format.Ledger.Read.posting_type
2431 (Format.Ledger.Posting_Type_Virtual, "A":|["B", "C"])
2433 Format.Ledger.Read.posting_type
2436 (Format.Ledger.Posting_Type_Regular, "A":|["B", "C"])
2438 Format.Ledger.Read.posting_type
2441 (Format.Ledger.Posting_Type_Regular, "(A)":|["B", "C"])
2443 Format.Ledger.Read.posting_type
2446 (Format.Ledger.Posting_Type_Regular, "A":|["(B)", "C"])
2448 Format.Ledger.Read.posting_type
2451 (Format.Ledger.Posting_Type_Regular, "A":|["B", "(C)"])
2453 Format.Ledger.Read.posting_type
2456 (Format.Ledger.Posting_Type_Regular, "[":|[])
2458 Format.Ledger.Read.posting_type
2461 (Format.Ledger.Posting_Type_Regular, "]":|[])
2463 Format.Ledger.Read.posting_type
2466 (Format.Ledger.Posting_Type_Regular, "[]":|[])
2468 Format.Ledger.Read.posting_type
2471 (Format.Ledger.Posting_Type_Regular, "[ ]":|[])
2473 Format.Ledger.Read.posting_type
2476 (Format.Ledger.Posting_Type_Virtual_Balanced, "A":|[])
2478 Format.Ledger.Read.posting_type
2481 (Format.Ledger.Posting_Type_Virtual_Balanced, "A":|["B", "C"])
2483 Format.Ledger.Read.posting_type
2486 (Format.Ledger.Posting_Type_Regular, "A":|["B", "C"])
2488 Format.Ledger.Read.posting_type
2491 (Format.Ledger.Posting_Type_Regular, "[A]":|["B", "C"])
2493 Format.Ledger.Read.posting_type
2496 (Format.Ledger.Posting_Type_Regular, "A":|["[B]", "C"])
2498 Format.Ledger.Read.posting_type
2501 (Format.Ledger.Posting_Type_Regular, "A":|["B", "[C]"])
2503 , "comment" ~: TestList
2504 [ "; some comment = Right \" some comment\"" ~:
2505 (Data.Either.rights $
2507 (Format.Ledger.Read.comment <* P.eof)
2508 () "" ("; some comment"::Text)])
2511 , "; some comment \\n = Right \" some comment \"" ~:
2512 (Data.Either.rights $
2514 (Format.Ledger.Read.comment <* P.newline <* P.eof)
2515 () "" ("; some comment \n"::Text)])
2517 [ " some comment " ]
2518 , "; some comment \\r\\n = Right \" some comment \"" ~:
2519 (Data.Either.rights $
2521 (Format.Ledger.Read.comment <* P.string "\r\n" <* P.eof)
2522 () "" ("; some comment \r\n"::Text)])
2524 [ " some comment " ]
2526 , "comments" ~: TestList
2527 [ "; some comment\\n ; some other comment = Right [\" some comment\", \" some other comment\"]" ~:
2528 (Data.Either.rights $
2530 (Format.Ledger.Read.comments <* P.eof)
2531 () "" ("; some comment\n ; some other comment"::Text)])
2533 [ [" some comment", " some other comment"] ]
2534 , "; some comment \\n = Right \" some comment \"" ~:
2535 (Data.Either.rights $
2537 (Format.Ledger.Read.comments <* P.string "\n" <* P.eof)
2538 () "" ("; some comment \n"::Text)])
2540 [ [" some comment "] ]
2542 , "tag_value" ~: TestList
2544 (Data.Either.rights $
2546 (Format.Ledger.Read.tag_value <* P.eof)
2551 (Data.Either.rights $
2553 (Format.Ledger.Read.tag_value <* P.char '\n' <* P.eof)
2554 () "" (",\n"::Text)])
2558 (Data.Either.rights $
2560 (Format.Ledger.Read.tag_value <* P.eof)
2561 () "" (",x"::Text)])
2565 (Data.Either.rights $
2567 (Format.Ledger.Read.tag_value <* P.string ",x:" <* P.eof)
2568 () "" (",x:"::Text)])
2572 (Data.Either.rights $
2574 (Format.Ledger.Read.tag_value <* P.string ", n:" <* P.eof)
2575 () "" ("v, v, n:"::Text)])
2581 (Data.Either.rights $
2583 (Format.Ledger.Read.tag <* P.eof)
2584 () "" ("Name:"::Text)])
2588 (Data.Either.rights $
2590 (Format.Ledger.Read.tag <* P.eof)
2591 () "" ("Name:Value"::Text)])
2594 , "Name:Value\\n" ~:
2595 (Data.Either.rights $
2597 (Format.Ledger.Read.tag <* P.string "\n" <* P.eof)
2598 () "" ("Name:Value\n"::Text)])
2602 (Data.Either.rights $
2604 (Format.Ledger.Read.tag <* P.eof)
2605 () "" ("Name:Val ue"::Text)])
2607 [("Name", "Val ue")]
2609 (Data.Either.rights $
2611 (Format.Ledger.Read.tag <* P.eof)
2612 () "" ("Name:,"::Text)])
2616 (Data.Either.rights $
2618 (Format.Ledger.Read.tag <* P.eof)
2619 () "" ("Name:Val,ue"::Text)])
2621 [("Name", "Val,ue")]
2623 (Data.Either.rights $
2625 (Format.Ledger.Read.tag <* P.string ",ue:" <* P.eof)
2626 () "" ("Name:Val,ue:"::Text)])
2630 , "tags" ~: TestList
2632 (Data.Either.rights $
2634 (Format.Ledger.Read.tags <* P.eof)
2635 () "" ("Name:"::Text)])
2642 (Data.Either.rights $
2644 (Format.Ledger.Read.tags <* P.eof)
2645 () "" ("Name:,"::Text)])
2652 (Data.Either.rights $
2654 (Format.Ledger.Read.tags <* P.eof)
2655 () "" ("Name:,Name:"::Text)])
2658 [ ("Name", ["", ""])
2662 (Data.Either.rights $
2664 (Format.Ledger.Read.tags <* P.eof)
2665 () "" ("Name:,Name2:"::Text)])
2672 , "Name: , Name2:" ~:
2673 (Data.Either.rights $
2675 (Format.Ledger.Read.tags <* P.eof)
2676 () "" ("Name: , Name2:"::Text)])
2683 , "Name:,Name2:,Name3:" ~:
2684 (Data.Either.rights $
2686 (Format.Ledger.Read.tags <* P.eof)
2687 () "" ("Name:,Name2:,Name3:"::Text)])
2695 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ~:
2696 (Data.Either.rights $
2698 (Format.Ledger.Read.tags <* P.eof)
2699 () "" ("Name:Val ue,Name2:V a l u e,Name3:V al ue"::Text)])
2702 [ ("Name", ["Val ue"])
2703 , ("Name2", ["V a l u e"])
2704 , ("Name3", ["V al ue"])
2708 , "posting" ~: TestList
2709 [ " A:B:C = Right A:B:C" ~:
2710 (Data.Either.rights $
2711 [P.runParser_with_Error
2712 (Format.Ledger.Read.posting <* P.eof)
2713 Format.Ledger.Read.nil_Context "" (" A:B:C"::Text)])
2715 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
2716 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2718 , Format.Ledger.Posting_Type_Regular
2721 , " !A:B:C = Right !A:B:C" ~:
2722 (Data.List.map fst $
2723 Data.Either.rights $
2724 [P.runParser_with_Error
2725 (Format.Ledger.Read.posting <* P.eof)
2726 Format.Ledger.Read.nil_Context "" (" !A:B:C"::Text)])
2728 [ (Format.Ledger.posting ("A":|["B", "C"]))
2729 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2730 , Format.Ledger.posting_status = True
2733 , " *A:B:C = Right *A:B:C" ~:
2734 (Data.List.map fst $
2735 Data.Either.rights $
2736 [P.runParser_with_Error
2737 (Format.Ledger.Read.posting <* P.eof)
2738 Format.Ledger.Read.nil_Context "" (" *A:B:C"::Text)])
2740 [ (Format.Ledger.posting ("A":|["B", "C"]))
2741 { Format.Ledger.posting_amounts = Data.Map.fromList []
2742 , Format.Ledger.posting_comments = []
2743 , Format.Ledger.posting_dates = []
2744 , Format.Ledger.posting_status = True
2745 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2746 , Format.Ledger.posting_tags = Data.Map.fromList []
2749 , " A:B:C $1 = Right A:B:C $1" ~:
2750 (Data.List.map fst $
2751 Data.Either.rights $
2752 [P.runParser_with_Error
2753 (Format.Ledger.Read.posting <* P.eof)
2754 Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
2756 [ (Format.Ledger.posting ("A":|["B","C $1"]))
2757 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2760 , " A:B:C $1 = Right A:B:C $1" ~:
2761 (Data.List.map fst $
2762 Data.Either.rights $
2763 [P.runParser_with_Error
2764 (Format.Ledger.Read.posting <* P.eof)
2765 Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
2767 [ (Format.Ledger.posting ("A":|["B", "C"]))
2768 { Format.Ledger.posting_amounts = Data.Map.fromList
2770 { Amount.quantity = 1
2771 , Amount.style = Amount.Style.nil
2772 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2773 , Amount.Style.unit_spaced = Just False
2778 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2781 , " A:B:C $1 + 1€ = Right A:B:C $1 + 1€" ~:
2782 (Data.List.map fst $
2783 Data.Either.rights $
2784 [P.runParser_with_Error
2785 (Format.Ledger.Read.posting <* P.eof)
2786 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1€"::Text)])
2788 [ (Format.Ledger.posting ("A":|["B", "C"]))
2789 { Format.Ledger.posting_amounts = Data.Map.fromList
2791 { Amount.quantity = 1
2792 , Amount.style = Amount.Style.nil
2793 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2794 , Amount.Style.unit_spaced = Just False
2799 { Amount.quantity = 1
2800 , Amount.style = Amount.Style.nil
2801 { Amount.Style.unit_side = Just Amount.Style.Side_Right
2802 , Amount.Style.unit_spaced = Just False
2807 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2810 , " A:B:C $1 + 1$ = Right A:B:C $2" ~:
2811 (Data.List.map fst $
2812 Data.Either.rights $
2813 [P.runParser_with_Error
2814 (Format.Ledger.Read.posting <* P.eof)
2815 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1$"::Text)])
2817 [ (Format.Ledger.posting ("A":|["B", "C"]))
2818 { Format.Ledger.posting_amounts = Data.Map.fromList
2820 { Amount.quantity = 2
2821 , Amount.style = Amount.Style.nil
2822 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2823 , Amount.Style.unit_spaced = Just False
2828 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2831 , " A:B:C $1 + 1$ + 1$ = Right A:B:C $3" ~:
2832 (Data.List.map fst $
2833 Data.Either.rights $
2834 [P.runParser_with_Error
2835 (Format.Ledger.Read.posting <* P.eof)
2836 Format.Ledger.Read.nil_Context "" (" A:B:C $1 + 1$ + 1$"::Text)])
2838 [ (Format.Ledger.posting ("A":|["B", "C"]))
2839 { Format.Ledger.posting_amounts = Data.Map.fromList
2841 { Amount.quantity = 3
2842 , Amount.style = Amount.Style.nil
2843 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2844 , Amount.Style.unit_spaced = Just False
2849 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2852 , " A:B:C ; some comment = Right A:B:C ; some comment" ~:
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 ; some comment"::Text)])
2859 [ (Format.Ledger.posting ("A":|["B", "C"]))
2860 { Format.Ledger.posting_amounts = Data.Map.fromList []
2861 , Format.Ledger.posting_comments = [" some comment"]
2862 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2865 , " A:B:C ; some comment\\n ; some other comment = Right A:B:C ; some comment\\n ; some other comment" ~:
2866 (Data.List.map fst $
2867 Data.Either.rights $
2868 [P.runParser_with_Error
2869 (Format.Ledger.Read.posting <* P.eof)
2870 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment\n ; some other comment"::Text)])
2872 [ (Format.Ledger.posting ("A":|["B", "C"]))
2873 { Format.Ledger.posting_amounts = Data.Map.fromList []
2874 , Format.Ledger.posting_comments = [" some comment", " some other comment"]
2875 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2878 , " A:B:C $1 ; some comment = Right A:B:C $1 ; some comment" ~:
2879 (Data.List.map fst $
2880 Data.Either.rights $
2881 [P.runParser_with_Error
2882 (Format.Ledger.Read.posting)
2883 Format.Ledger.Read.nil_Context "" (" A:B:C $1 ; some comment"::Text)])
2885 [ (Format.Ledger.posting ("A":|["B", "C"]))
2886 { Format.Ledger.posting_amounts = Data.Map.fromList
2888 { Amount.quantity = 1
2889 , Amount.style = Amount.Style.nil
2890 { Amount.Style.unit_side = Just Amount.Style.Side_Left
2891 , Amount.Style.unit_spaced = Just False
2896 , Format.Ledger.posting_comments = [" some comment"]
2897 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2900 , " A:B:C ; N:V = Right A:B:C ; N:V" ~:
2901 (Data.List.map fst $
2902 Data.Either.rights $
2903 [P.runParser_with_Error
2904 (Format.Ledger.Read.posting <* P.eof)
2905 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V"::Text)])
2907 [ (Format.Ledger.posting ("A":|["B", "C"]))
2908 { Format.Ledger.posting_comments = [" N:V"]
2909 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2910 , Format.Ledger.posting_tags = Data.Map.fromList
2915 , " A:B:C ; some comment N:V = Right A:B:C ; some comment N:V" ~:
2916 (Data.List.map fst $
2917 Data.Either.rights $
2918 [P.runParser_with_Error
2919 (Format.Ledger.Read.posting <* P.eof)
2920 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V"::Text)])
2922 [ (Format.Ledger.posting ("A":|["B", "C"]))
2923 { Format.Ledger.posting_comments = [" some comment N:V"]
2924 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2925 , Format.Ledger.posting_tags = Data.Map.fromList
2930 , " A:B:C ; some comment N:V v, N2:V2 v2 = Right A:B:C ; some comment N:V v, N2:V2 v2" ~:
2931 (Data.List.map fst $
2932 Data.Either.rights $
2933 [P.runParser_with_Error
2934 (Format.Ledger.Read.posting )
2935 Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V v, N2:V2 v2"::Text)])
2937 [ (Format.Ledger.posting ("A":|["B", "C"]))
2938 { Format.Ledger.posting_comments = [" some comment N:V v, N2:V2 v2"]
2939 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2940 , Format.Ledger.posting_tags = Data.Map.fromList
2946 , " A:B:C ; N:V\\n ; N:V2 = Right A:B:C ; N:V\\n ; N:V2" ~:
2947 (Data.List.map fst $
2948 Data.Either.rights $
2949 [P.runParser_with_Error
2950 (Format.Ledger.Read.posting <* P.eof)
2951 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N:V2"::Text)])
2953 [ (Format.Ledger.posting ("A":|["B", "C"]))
2954 { Format.Ledger.posting_comments = [" N:V", " N:V2"]
2955 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2956 , Format.Ledger.posting_tags = Data.Map.fromList
2957 [ ("N", ["V", "V2"])
2961 , " A:B:C ; N:V\\n ; N2:V = Right A:B:C ; N:V\\n ; N2:V" ~:
2962 (Data.List.map fst $
2963 Data.Either.rights $
2964 [P.runParser_with_Error
2965 (Format.Ledger.Read.posting <* P.eof)
2966 Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N2:V"::Text)])
2968 [ (Format.Ledger.posting ("A":|["B", "C"]))
2969 { Format.Ledger.posting_comments = [" N:V", " N2:V"]
2970 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2971 , Format.Ledger.posting_tags = Data.Map.fromList
2977 , " A:B:C ; date:2001/01/01 = Right A:B:C ; date:2001/01/01" ~:
2978 (Data.List.map fst $
2979 Data.Either.rights $
2980 [P.runParser_with_Error
2981 (Format.Ledger.Read.posting <* P.eof)
2982 Format.Ledger.Read.nil_Context "" (" A:B:C ; date:2001/01/01"::Text)])
2984 [ (Format.Ledger.posting ("A":|["B", "C"]))
2985 { Format.Ledger.posting_comments = [" date:2001/01/01"]
2986 , Format.Ledger.posting_dates =
2987 [ Time.zonedTimeToUTC $
2990 (Time.fromGregorian 2001 01 01)
2991 (Time.TimeOfDay 0 0 0))
2994 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
2995 , Format.Ledger.posting_tags = Data.Map.fromList
2996 [ ("date", ["2001/01/01"])
3000 , " (A:B:C) = Right (A:B:C)" ~:
3001 (Data.Either.rights $
3002 [P.runParser_with_Error
3003 (Format.Ledger.Read.posting <* P.eof)
3004 Format.Ledger.Read.nil_Context "" (" (A:B:C)"::Text)])
3006 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
3007 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3009 , Format.Ledger.Posting_Type_Virtual
3012 , " [A:B:C] = Right [A:B:C]" ~:
3013 (Data.Either.rights $
3014 [P.runParser_with_Error
3015 (Format.Ledger.Read.posting <* P.eof)
3016 Format.Ledger.Read.nil_Context "" (" [A:B:C]"::Text)])
3018 [ ( (Format.Ledger.posting ("A":|["B", "C"]))
3019 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3021 , Format.Ledger.Posting_Type_Virtual_Balanced
3025 , "transaction" ~: TestList
3026 [ "2000/01/01 some description\\n A:B:C $1\\n a:b:c" ~:
3027 (Data.Either.rights $
3028 [P.runParser_with_Error
3029 (Format.Ledger.Read.transaction <* P.eof)
3030 Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C $1\n a:b:c"::Text)])
3032 [ Format.Ledger.transaction
3033 { Format.Ledger.transaction_dates=
3034 ( Time.zonedTimeToUTC $
3037 (Time.fromGregorian 2000 01 01)
3038 (Time.TimeOfDay 0 0 0))
3041 , Format.Ledger.transaction_description="some description"
3042 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3043 [ (Format.Ledger.posting ("A":|["B", "C"]))
3044 { Format.Ledger.posting_amounts = Data.Map.fromList
3046 { Amount.quantity = 1
3047 , Amount.style = Amount.Style.nil
3048 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3049 , Amount.Style.unit_spaced = Just False
3054 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
3056 , (Format.Ledger.posting ("a":|["b", "c"]))
3057 { Format.Ledger.posting_amounts = Data.Map.fromList
3059 { Amount.quantity = -1
3060 , Amount.style = Amount.Style.nil
3061 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3062 , Amount.Style.unit_spaced = Just False
3067 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
3070 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3073 , "2000/01/01 some description\\n A:B:C $1\\n a:b:c\\n" ~:
3074 (Data.Either.rights $
3075 [P.runParser_with_Error
3076 (Format.Ledger.Read.transaction <* P.newline <* P.eof)
3077 Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C $1\n a:b:c\n"::Text)])
3079 [ Format.Ledger.transaction
3080 { Format.Ledger.transaction_dates=
3081 ( Time.zonedTimeToUTC $
3084 (Time.fromGregorian 2000 01 01)
3085 (Time.TimeOfDay 0 0 0))
3088 , Format.Ledger.transaction_description="some description"
3089 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3090 [ (Format.Ledger.posting ("A":|["B", "C"]))
3091 { Format.Ledger.posting_amounts = Data.Map.fromList
3093 { Amount.quantity = 1
3094 , Amount.style = Amount.Style.nil
3095 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3096 , Amount.Style.unit_spaced = Just False
3101 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
3103 , (Format.Ledger.posting ("a":|["b", "c"]))
3104 { Format.Ledger.posting_amounts = Data.Map.fromList
3106 { Amount.quantity = -1
3107 , Amount.style = Amount.Style.nil
3108 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3109 , Amount.Style.unit_spaced = Just False
3114 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
3117 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3120 , "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" ~:
3121 (Data.Either.rights $
3122 [P.runParser_with_Error
3123 (Format.Ledger.Read.transaction <* P.eof)
3124 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)])
3126 [ Format.Ledger.transaction
3127 { Format.Ledger.transaction_comments_after =
3129 , " some other;comment"
3131 , " some last comment"
3133 , Format.Ledger.transaction_dates=
3134 ( Time.zonedTimeToUTC $
3137 (Time.fromGregorian 2000 01 01)
3138 (Time.TimeOfDay 0 0 0))
3141 , Format.Ledger.transaction_description="some description"
3142 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3143 [ (Format.Ledger.posting ("A":|["B", "C"]))
3144 { Format.Ledger.posting_amounts = Data.Map.fromList
3146 { Amount.quantity = 1
3147 , Amount.style = Amount.Style.nil
3148 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3149 , Amount.Style.unit_spaced = Just False
3154 , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
3156 , (Format.Ledger.posting ("a":|["b", "c"]))
3157 { Format.Ledger.posting_amounts = Data.Map.fromList
3159 { Amount.quantity = -1
3160 , Amount.style = Amount.Style.nil
3161 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3162 , Amount.Style.unit_spaced = Just False
3167 , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
3170 , Format.Ledger.transaction_tags = Data.Map.fromList
3173 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3177 , "journal" ~: TestList
3178 [ "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
3180 P.runParserT_with_Error
3181 (Format.Ledger.Read.journal "" {-<* P.eof-})
3182 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)
3184 (\j -> j{Format.Ledger.journal_last_read_time=
3185 Format.Ledger.journal_last_read_time Format.Ledger.journal}) $
3186 Data.Either.rights [jnl])
3188 [ Format.Ledger.journal
3189 { Format.Ledger.journal_transactions =
3190 Format.Ledger.transaction_by_Date
3191 [ Format.Ledger.transaction
3192 { Format.Ledger.transaction_dates=
3193 ( Time.zonedTimeToUTC $
3196 (Time.fromGregorian 2000 01 01)
3197 (Time.TimeOfDay 0 0 0))
3200 , Format.Ledger.transaction_description="1° description"
3201 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3202 [ (Format.Ledger.posting ("A":|["B", "C"]))
3203 { Format.Ledger.posting_amounts = Data.Map.fromList
3205 { Amount.quantity = 1
3206 , Amount.style = Amount.Style.nil
3207 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3208 , Amount.Style.unit_spaced = Just False
3213 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
3215 , (Format.Ledger.posting ("a":|["b", "c"]))
3216 { Format.Ledger.posting_amounts = Data.Map.fromList
3218 { Amount.quantity = -1
3219 , Amount.style = Amount.Style.nil
3220 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3221 , Amount.Style.unit_spaced = Just False
3226 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
3229 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
3231 , Format.Ledger.transaction
3232 { Format.Ledger.transaction_dates=
3233 ( Time.zonedTimeToUTC $
3236 (Time.fromGregorian 2000 01 02)
3237 (Time.TimeOfDay 0 0 0))
3240 , Format.Ledger.transaction_description="2° description"
3241 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3242 [ (Format.Ledger.posting ("A":|["B", "C"]))
3243 { Format.Ledger.posting_amounts = Data.Map.fromList
3245 { Amount.quantity = 1
3246 , Amount.style = Amount.Style.nil
3247 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3248 , Amount.Style.unit_spaced = Just False
3253 , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
3255 , (Format.Ledger.posting ("x":|["y", "z"]))
3256 { Format.Ledger.posting_amounts = Data.Map.fromList
3258 { Amount.quantity = -1
3259 , Amount.style = Amount.Style.nil
3260 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3261 , Amount.Style.unit_spaced = Just False
3266 , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
3269 , Format.Ledger.transaction_sourcepos = P.newPos "" 4 1
3276 , "Write" ~: TestList
3277 [ "account" ~: TestList
3279 ((Format.Ledger.Write.show
3280 Format.Ledger.Write.Style
3281 { Format.Ledger.Write.style_color=False
3282 , Format.Ledger.Write.style_align=True
3284 Format.Ledger.Write.account Format.Ledger.Posting_Type_Regular $
3289 ((Format.Ledger.Write.show
3290 Format.Ledger.Write.Style
3291 { Format.Ledger.Write.style_color=False
3292 , Format.Ledger.Write.style_align=True
3294 Format.Ledger.Write.account Format.Ledger.Posting_Type_Regular $
3299 ((Format.Ledger.Write.show
3300 Format.Ledger.Write.Style
3301 { Format.Ledger.Write.style_color=False
3302 , Format.Ledger.Write.style_align=True
3304 Format.Ledger.Write.account Format.Ledger.Posting_Type_Virtual $
3309 ((Format.Ledger.Write.show
3310 Format.Ledger.Write.Style
3311 { Format.Ledger.Write.style_color=False
3312 , Format.Ledger.Write.style_align=True
3314 Format.Ledger.Write.account Format.Ledger.Posting_Type_Virtual_Balanced $
3319 , "amount" ~: 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.amount
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.amount
3338 { Amount.style = Amount.Style.nil
3339 { Amount.Style.precision = 2 }
3344 ((Format.Ledger.Write.show
3345 Format.Ledger.Write.Style
3346 { Format.Ledger.Write.style_color=False
3347 , Format.Ledger.Write.style_align=True
3349 Format.Ledger.Write.amount
3351 { Amount.quantity = Decimal 0 123
3356 ((Format.Ledger.Write.show
3357 Format.Ledger.Write.Style
3358 { Format.Ledger.Write.style_color=False
3359 , Format.Ledger.Write.style_align=True
3361 Format.Ledger.Write.amount
3363 { Amount.quantity = Decimal 0 (- 123)
3367 , "12.3 @ prec=0" ~:
3368 ((Format.Ledger.Write.show
3369 Format.Ledger.Write.Style
3370 { Format.Ledger.Write.style_color=False
3371 , Format.Ledger.Write.style_align=True
3373 Format.Ledger.Write.amount
3375 { Amount.quantity = Decimal 1 123
3376 , Amount.style = Amount.Style.nil
3377 { Amount.Style.fractioning = Just '.'
3382 , "12.5 @ prec=0" ~:
3383 ((Format.Ledger.Write.show
3384 Format.Ledger.Write.Style
3385 { Format.Ledger.Write.style_color=False
3386 , Format.Ledger.Write.style_align=True
3388 Format.Ledger.Write.amount
3390 { Amount.quantity = Decimal 1 125
3391 , Amount.style = Amount.Style.nil
3392 { Amount.Style.fractioning = Just '.'
3397 , "12.3 @ prec=1" ~:
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 1 123
3406 , Amount.style = Amount.Style.nil
3407 { Amount.Style.fractioning = Just '.'
3408 , Amount.Style.precision = 1
3413 , "1,234.56 @ prec=2" ~:
3414 ((Format.Ledger.Write.show
3415 Format.Ledger.Write.Style
3416 { Format.Ledger.Write.style_color=False
3417 , Format.Ledger.Write.style_align=True
3419 Format.Ledger.Write.amount
3421 { Amount.quantity = Decimal 2 123456
3422 , Amount.style = Amount.Style.nil
3423 { Amount.Style.fractioning = Just '.'
3424 , Amount.Style.precision = 2
3425 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
3430 , "123,456,789,01,2.3456789 @ prec=7" ~:
3431 ((Format.Ledger.Write.show
3432 Format.Ledger.Write.Style
3433 { Format.Ledger.Write.style_color=False
3434 , Format.Ledger.Write.style_align=True
3436 Format.Ledger.Write.amount
3438 { Amount.quantity = Decimal 7 1234567890123456789
3439 , Amount.style = Amount.Style.nil
3440 { Amount.Style.fractioning = Just '.'
3441 , Amount.Style.precision = 7
3442 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3446 "123,456,789,01,2.3456789")
3447 , "1234567.8,90,123,456,789 @ prec=12" ~:
3448 ((Format.Ledger.Write.show
3449 Format.Ledger.Write.Style
3450 { Format.Ledger.Write.style_color=False
3451 , Format.Ledger.Write.style_align=True
3453 Format.Ledger.Write.amount
3455 { Amount.quantity = Decimal 12 1234567890123456789
3456 , Amount.style = Amount.Style.nil
3457 { Amount.Style.fractioning = Just '.'
3458 , Amount.Style.precision = 12
3459 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3463 "1234567.8,90,123,456,789")
3464 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
3465 ((Format.Ledger.Write.show
3466 Format.Ledger.Write.Style
3467 { Format.Ledger.Write.style_color=False
3468 , Format.Ledger.Write.style_align=True
3470 Format.Ledger.Write.amount
3472 { Amount.quantity = Decimal 7 1234567890123456789
3473 , Amount.style = Amount.Style.nil
3474 { Amount.Style.fractioning = Just '.'
3475 , Amount.Style.precision = 7
3476 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3480 "1,2,3,4,5,6,7,89,012.3456789")
3481 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
3482 ((Format.Ledger.Write.show
3483 Format.Ledger.Write.Style
3484 { Format.Ledger.Write.style_color=False
3485 , Format.Ledger.Write.style_align=True
3487 Format.Ledger.Write.amount
3489 { Amount.quantity = Decimal 12 1234567890123456789
3490 , Amount.style = Amount.Style.nil
3491 { Amount.Style.fractioning = Just '.'
3492 , Amount.Style.precision = 12
3493 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3497 "1234567.890,12,3,4,5,6,7,8,9")
3499 , "amount_length" ~: TestList
3501 ((Format.Ledger.Write.amount_length
3506 ((Format.Ledger.Write.amount_length
3508 { Amount.style = Amount.Style.nil
3509 { Amount.Style.precision = 2 }
3514 ((Format.Ledger.Write.amount_length
3516 { Amount.quantity = Decimal 0 123
3521 ((Format.Ledger.Write.amount_length
3523 { Amount.quantity = Decimal 0 (- 123)
3527 , "12.3 @ prec=0" ~:
3528 ((Format.Ledger.Write.amount_length
3530 { Amount.quantity = Decimal 1 123
3531 , Amount.style = Amount.Style.nil
3532 { Amount.Style.fractioning = Just '.'
3537 , "12.5 @ prec=0" ~:
3538 ((Format.Ledger.Write.amount_length
3540 { Amount.quantity = Decimal 1 125
3541 , Amount.style = Amount.Style.nil
3542 { Amount.Style.fractioning = Just '.'
3547 , "12.3 @ prec=1" ~:
3548 ((Format.Ledger.Write.amount_length
3550 { Amount.quantity = Decimal 1 123
3551 , Amount.style = Amount.Style.nil
3552 { Amount.Style.fractioning = Just '.'
3553 , Amount.Style.precision = 1
3558 , "1,234.56 @ prec=2" ~:
3559 ((Format.Ledger.Write.amount_length
3561 { Amount.quantity = Decimal 2 123456
3562 , Amount.style = Amount.Style.nil
3563 { Amount.Style.fractioning = Just '.'
3564 , Amount.Style.precision = 2
3565 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
3570 , "123,456,789,01,2.3456789 @ prec=7" ~:
3571 ((Format.Ledger.Write.amount_length
3573 { Amount.quantity = Decimal 7 1234567890123456789
3574 , Amount.style = Amount.Style.nil
3575 { Amount.Style.fractioning = Just '.'
3576 , Amount.Style.precision = 7
3577 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3582 , "1234567.8,90,123,456,789 @ prec=12" ~:
3583 ((Format.Ledger.Write.amount_length
3585 { Amount.quantity = Decimal 12 1234567890123456789
3586 , Amount.style = Amount.Style.nil
3587 { Amount.Style.fractioning = Just '.'
3588 , Amount.Style.precision = 12
3589 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
3594 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
3595 ((Format.Ledger.Write.amount_length
3597 { Amount.quantity = Decimal 7 1234567890123456789
3598 , Amount.style = Amount.Style.nil
3599 { Amount.Style.fractioning = Just '.'
3600 , Amount.Style.precision = 7
3601 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3606 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
3607 ((Format.Ledger.Write.amount_length
3609 { Amount.quantity = Decimal 12 1234567890123456789
3610 , Amount.style = Amount.Style.nil
3611 { Amount.Style.fractioning = Just '.'
3612 , Amount.Style.precision = 12
3613 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3618 , "1000000.000,00,0,0,0,0,0,0,0 @ prec=12" ~:
3619 ((Format.Ledger.Write.amount_length
3621 { Amount.quantity = Decimal 12 1000000000000000000
3622 , Amount.style = Amount.Style.nil
3623 { Amount.Style.fractioning = Just '.'
3624 , Amount.Style.precision = 12
3625 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
3631 ((Format.Ledger.Write.amount_length $
3633 { Amount.quantity = Decimal 0 999
3634 , Amount.style = Amount.Style.nil
3635 { Amount.Style.precision = 0
3640 , "1000 @ prec=0" ~:
3641 ((Format.Ledger.Write.amount_length $
3643 { Amount.quantity = Decimal 0 1000
3644 , Amount.style = Amount.Style.nil
3645 { Amount.Style.precision = 0
3650 , "10,00€ @ prec=2" ~:
3651 ((Format.Ledger.Write.amount_length $ Amount.eur 10)
3655 , "date" ~: TestList
3657 ((Format.Ledger.Write.show
3658 Format.Ledger.Write.Style
3659 { Format.Ledger.Write.style_color=False
3660 , Format.Ledger.Write.style_align=True
3662 Format.Ledger.Write.date
3666 , "2000/01/01 12:34:51 CET" ~:
3667 (Format.Ledger.Write.show
3668 Format.Ledger.Write.Style
3669 { Format.Ledger.Write.style_color=False
3670 , Format.Ledger.Write.style_align=True
3672 Format.Ledger.Write.date $
3673 Time.zonedTimeToUTC $
3676 (Time.fromGregorian 2000 01 01)
3677 (Time.TimeOfDay 12 34 51))
3678 (Time.TimeZone 60 False "CET"))
3680 "2000/01/01 11:34:51"
3681 , "2000/01/01 12:34:51 +0100" ~:
3682 (Format.Ledger.Write.show
3683 Format.Ledger.Write.Style
3684 { Format.Ledger.Write.style_color=False
3685 , Format.Ledger.Write.style_align=True
3687 Format.Ledger.Write.date $
3688 Time.zonedTimeToUTC $
3691 (Time.fromGregorian 2000 01 01)
3692 (Time.TimeOfDay 12 34 51))
3693 (Time.TimeZone 60 False ""))
3695 "2000/01/01 11:34:51"
3696 , "2000/01/01 01:02:03" ~:
3697 (Format.Ledger.Write.show
3698 Format.Ledger.Write.Style
3699 { Format.Ledger.Write.style_color=False
3700 , Format.Ledger.Write.style_align=True
3702 Format.Ledger.Write.date $
3703 Time.zonedTimeToUTC $
3706 (Time.fromGregorian 2000 01 01)
3707 (Time.TimeOfDay 1 2 3))
3710 "2000/01/01 01:02:03"
3712 (Format.Ledger.Write.show
3713 Format.Ledger.Write.Style
3714 { Format.Ledger.Write.style_color=False
3715 , Format.Ledger.Write.style_align=True
3717 Format.Ledger.Write.date $
3718 Time.zonedTimeToUTC $
3721 (Time.fromGregorian 0 01 01)
3722 (Time.TimeOfDay 1 2 0))
3727 (Format.Ledger.Write.show
3728 Format.Ledger.Write.Style
3729 { Format.Ledger.Write.style_color=False
3730 , Format.Ledger.Write.style_align=True
3732 Format.Ledger.Write.date $
3733 Time.zonedTimeToUTC $
3736 (Time.fromGregorian 0 01 01)
3737 (Time.TimeOfDay 1 0 0))
3742 (Format.Ledger.Write.show
3743 Format.Ledger.Write.Style
3744 { Format.Ledger.Write.style_color=False
3745 , Format.Ledger.Write.style_align=True
3747 Format.Ledger.Write.date $
3748 Time.zonedTimeToUTC $
3751 (Time.fromGregorian 0 01 01)
3752 (Time.TimeOfDay 0 1 0))
3757 (Format.Ledger.Write.show
3758 Format.Ledger.Write.Style
3759 { Format.Ledger.Write.style_color=False
3760 , Format.Ledger.Write.style_align=True
3762 Format.Ledger.Write.date $
3763 Time.zonedTimeToUTC $
3766 (Time.fromGregorian 0 01 01)
3767 (Time.TimeOfDay 0 0 0))
3772 , "transaction" ~: TestList
3774 ((Format.Ledger.Write.show
3775 Format.Ledger.Write.Style
3776 { Format.Ledger.Write.style_color=False
3777 , Format.Ledger.Write.style_align=True
3779 Format.Ledger.Write.transaction
3780 Format.Ledger.transaction)
3783 , "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" ~:
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.transaction $
3790 Format.Ledger.transaction
3791 { Format.Ledger.transaction_dates=
3792 ( Time.zonedTimeToUTC $
3795 (Time.fromGregorian 2000 01 01)
3796 (Time.TimeOfDay 0 0 0))
3799 , Format.Ledger.transaction_description="some description"
3800 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3801 [ (Format.Ledger.posting ("A":|["B", "C"]))
3802 { Format.Ledger.posting_amounts = Data.Map.fromList
3804 { Amount.quantity = 1
3805 , Amount.style = Amount.Style.nil
3806 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3807 , Amount.Style.unit_spaced = Just False
3813 , (Format.Ledger.posting ("a":|["b", "c"]))
3814 { Format.Ledger.posting_comments = ["first comment","second comment","third comment"]
3819 "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")
3820 , "2000/01/01 some description\\n\\tA:B:C $1\\n\\tAA:BB:CC $123" ~:
3821 ((Format.Ledger.Write.show
3822 Format.Ledger.Write.Style
3823 { Format.Ledger.Write.style_color=False
3824 , Format.Ledger.Write.style_align=True
3826 Format.Ledger.Write.transaction $
3827 Format.Ledger.transaction
3828 { Format.Ledger.transaction_dates=
3829 ( Time.zonedTimeToUTC $
3832 (Time.fromGregorian 2000 01 01)
3833 (Time.TimeOfDay 0 0 0))
3836 , Format.Ledger.transaction_description="some description"
3837 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
3838 [ (Format.Ledger.posting ("A":|["B", "C"]))
3839 { Format.Ledger.posting_amounts = Data.Map.fromList
3841 { Amount.quantity = 1
3842 , Amount.style = Amount.Style.nil
3843 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3844 , Amount.Style.unit_spaced = Just False
3850 , (Format.Ledger.posting ("AA":|["BB", "CC"]))
3851 { Format.Ledger.posting_amounts = Data.Map.fromList
3853 { Amount.quantity = 123
3854 , Amount.style = Amount.Style.nil
3855 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3856 , Amount.Style.unit_spaced = Just False
3865 "2000/01/01 some description\n\tA:B:C $1\n\tAA:BB:CC $123")