1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE OverloadedStrings #-}
3 {-# LANGUAGE ScopedTypeVariables #-}
4 {-# LANGUAGE TupleSections #-}
7 import Test.HUnit hiding ((~?))
8 import Test.Framework.Providers.HUnit (hUnitTestToTests)
9 import Test.Framework.Runners.Console (defaultMain)
11 -- import Control.Applicative (Const(..))
12 import Control.Arrow ((***))
13 import Control.Monad.IO.Class (liftIO)
14 import Data.Decimal (DecimalRaw(..))
15 import qualified Data.Either
16 import Data.Function (on)
17 -- import Data.Functor.Compose (Compose(..))
18 import qualified Data.List
19 import Data.List.NonEmpty (NonEmpty(..))
20 import qualified Data.Map.Strict as Data.Map
21 import Data.Maybe (fromJust)
22 import qualified Data.Strict.Maybe as Strict
23 import Data.Text (Text)
24 import qualified Data.Time.Calendar as Time
25 import qualified Data.Time.LocalTime as Time
26 import qualified Text.Parsec as P hiding (char, space, spaces, string)
27 import qualified Text.Parsec.Pos as P
28 -- import qualified Text.PrettyPrint.Leijen.Text as PP
30 import Hcompta.Account (Account)
31 import qualified Hcompta.Account as Account
32 import qualified Hcompta.Account.Read as Account.Read
33 import Hcompta.Amount (Amount)
34 import qualified Hcompta.Amount as Amount
35 import qualified Hcompta.Amount.Read as Amount.Read
36 import qualified Hcompta.Amount.Style as Amount.Style
37 import qualified Hcompta.Amount.Write as Amount.Write
38 import qualified Hcompta.Balance as Balance
39 import Hcompta.Chart (Chart)
40 -- import qualified Hcompta.Chart as Chart
41 import qualified Hcompta.Date as Date
42 import qualified Hcompta.Date.Read as Date.Read
43 import qualified Hcompta.Date.Write as Date.Write
44 import qualified Hcompta.Filter as Filter
45 import qualified Hcompta.Filter.Read as Filter.Read
46 import qualified Hcompta.Format.Ledger as Format.Ledger
47 import qualified Hcompta.Format.Ledger.Read as Format.Ledger.Read
48 import qualified Hcompta.Format.Ledger.Write as Format.Ledger.Write
49 -- import qualified Hcompta.Journal as Journal
50 import qualified Hcompta.Lib.Foldable as Lib.Foldable
51 import qualified Hcompta.Lib.Interval as Lib.Interval
52 import qualified Hcompta.Lib.Interval.Sieve as Lib.Interval.Sieve
53 import qualified Hcompta.Lib.Parsec as P
54 import qualified Hcompta.Lib.TreeMap as Lib.TreeMap
55 import qualified Hcompta.Posting as Posting
56 import qualified Hcompta.Tag as Tag
59 main = defaultMain $ hUnitTestToTests test_Hcompta
61 (~?) :: String -> Bool -> Test
62 (~?) s b = s ~: (b ~?= True)
68 [ "TreeMap" ~: TestList
69 [ "insert" ~: TestList
71 (Lib.TreeMap.insert const ((0::Int):|[]) () Lib.TreeMap.empty)
73 (Lib.TreeMap.TreeMap $
75 [ ((0::Int), Lib.TreeMap.leaf ())
78 (Lib.TreeMap.insert const ((0::Int):|1:[]) () Lib.TreeMap.empty)
80 (Lib.TreeMap.TreeMap $
82 [ ((0::Int), Lib.TreeMap.Node
83 { Lib.TreeMap.node_value = Strict.Nothing
84 , Lib.TreeMap.node_size = 1
85 , Lib.TreeMap.node_descendants =
86 Lib.TreeMap.singleton ((1::Int):|[]) ()
93 , "map_by_depth_first" ~: TestList
94 [ "[0, 0/1, 0/1/2, 1, 1/2/3]" ~:
95 (Lib.TreeMap.map_by_depth_first
96 (\descendants value ->
99 Strict.fromMaybe undefined $
100 Lib.TreeMap.node_value v
102 (Strict.fromMaybe [] value)
103 (Lib.TreeMap.nodes descendants)
105 Lib.TreeMap.from_List const
106 [ (((0::Integer):|[]), [0])
108 , ((0:|1:2:[]), [0,1,2])
110 , ((1:|2:3:[]), [1,2,3])
114 (Lib.TreeMap.from_List const
115 [ ((0:|[]), [0,0,1,0,1,2])
116 , ((0:|1:[]), [0,1,0,1,2])
117 , ((0:|1:2:[]), [0,1,2])
118 , ((1:|[]), [1,1,2,3])
119 , ((1:|2:[]), [1,2,3])
120 , ((1:|2:3:[]), [1,2,3])
123 (Lib.TreeMap.map_by_depth_first
124 (\descendants value ->
126 (\acc v -> (++) acc $
127 Strict.fromMaybe undefined $
128 Lib.TreeMap.node_value v
130 (Strict.fromMaybe [] value)
131 (Lib.TreeMap.nodes descendants)
133 Lib.TreeMap.from_List const
134 [ (((0::Integer):|0:[]), [0,0])
138 (Lib.TreeMap.from_List const
143 , "flatten" ~: TestList
144 [ "[0, 0/1, 0/1/2]" ~:
145 (Lib.TreeMap.flatten id $
146 Lib.TreeMap.from_List const
147 [ (((0::Integer):|[]), ())
158 , "[1, 1/2, 1/22, 1/2/3, 1/2/33, 11, 11/2, 11/2/3, 11/2/33]" ~:
159 (Lib.TreeMap.flatten id $
160 Lib.TreeMap.from_List const
169 , ((11:|2:33:[]), ())
174 [ (((1::Integer):|[]), ())
182 , ((11:|2:33:[]), ())
185 , "find_along" ~: TestList
186 [ "0/1/2/3 [0, 0/1, 0/1/2, 0/1/2/3]" ~:
187 (Lib.TreeMap.find_along
189 Lib.TreeMap.from_List const
190 [ (((0::Integer):|[]), [0])
192 , ((0:|1:2:[]), [0,1,2])
193 , ((0:|1:2:3:[]), [0,1,2,3])
202 , "0/1/2/3 [0, 0/1]" ~:
203 (Lib.TreeMap.find_along
205 Lib.TreeMap.from_List const
206 [ (((0::Integer):|[]), [0])
216 , "Foldable" ~: TestList
217 [ "accumLeftsAndFoldrRights" ~: TestList
219 (Lib.Foldable.accumLeftsAndFoldrRights (++) [""] $
222 (([(0::Integer)], [(""::String)]))
224 ((take 1 *** take 0) $
225 Lib.Foldable.accumLeftsAndFoldrRights (++) [""] $
226 ( repeat (Left [0]) ))
228 ([(0::Integer)], ([]::[String]))
229 , "Right:Left:Right:Left" ~:
230 (Lib.Foldable.accumLeftsAndFoldrRights (++) ["0"] $
231 ( Right ["2"]:Left [1]:Right ["1"]:Left [0]:[] ))
233 (([1, 0]::[Integer]), (["2", "1", "0"]::[String]))
234 , "Right:Left:Right:repeat Left" ~:
235 ((take 1 *** take 2) $
236 Lib.Foldable.accumLeftsAndFoldrRights (++) ["0"] $
237 ( Right ["2"]:Left [1]:Right ["1"]:repeat (Left [0]) ))
239 (([1]::[Integer]), (["2", "1"]::[String]))
242 , "Interval" ~: TestList
243 [ "position" ~: TestList $
246 let i = fromJust mi in
247 let j = fromJust mj in
250 Lib.Interval.Equal -> (EQ, EQ)
252 [ ((show . Lib.Interval.Pretty) i ++ " " ++ (show . Lib.Interval.Pretty) j) ~: Lib.Interval.position i j ~?= (p, le)
253 , ((show . Lib.Interval.Pretty) j ++ " " ++ (show . Lib.Interval.Pretty) i) ~: Lib.Interval.position j i ~?= (p, ge)
256 [ ( (Lib.Interval.<..<) 0 (4::Integer)
257 , (Lib.Interval.<..<) 5 9
258 , Lib.Interval.Away )
259 , ( (Lib.Interval.<..<) 0 4
260 , (Lib.Interval.<=..<) 4 9
261 , Lib.Interval.Adjacent )
262 , ( (Lib.Interval.<..<) 0 5
263 , (Lib.Interval.<..<) 4 9
264 , Lib.Interval.Overlap )
265 , ( (Lib.Interval.<..<) 0 5
266 , (Lib.Interval.<..<) 0 9
267 , Lib.Interval.Prefix )
268 , ( (Lib.Interval.<..<) 0 9
269 , (Lib.Interval.<..<) 1 8
270 , Lib.Interval.Include )
271 , ( (Lib.Interval.<..<) 0 9
272 , (Lib.Interval.<..<) 5 9
273 , Lib.Interval.Suffixed )
274 , ( (Lib.Interval.<..<) 0 9
275 , (Lib.Interval.<..<) 0 9
276 , Lib.Interval.Equal )
277 , ( (Lib.Interval.<..<) 0 9
278 , (Lib.Interval.<..<=) 0 9
279 , Lib.Interval.Prefix )
280 , ( (Lib.Interval.<=..<) 0 9
281 , (Lib.Interval.<..<) 0 9
282 , Lib.Interval.Suffixed )
283 , ( (Lib.Interval.<=..<=) 0 9
284 , (Lib.Interval.<..<) 0 9
285 , Lib.Interval.Include )
287 , "intersection" ~: TestList $
290 let i = fromJust mi in
291 let j = fromJust mj in
292 [ ((show . Lib.Interval.Pretty) i ++ " " ++ (show . Lib.Interval.Pretty) j) ~: Lib.Interval.intersection i j ~?= e
293 , ((show . Lib.Interval.Pretty) j ++ " " ++ (show . Lib.Interval.Pretty) i) ~: Lib.Interval.intersection j i ~?= e
296 [ ( (Lib.Interval.<..<) 0 (4::Integer)
297 , (Lib.Interval.<..<) 5 9
299 , ( (Lib.Interval.<..<=) 0 5
300 , (Lib.Interval.<=..<) 5 9
301 , (Lib.Interval.<=..<=) 5 5 )
302 , ( (Lib.Interval.<..<) 0 6
303 , (Lib.Interval.<..<) 4 9
304 , (Lib.Interval.<..<) 4 6 )
305 , ( (Lib.Interval.<..<=) 0 6
306 , (Lib.Interval.<=..<) 4 9
307 , (Lib.Interval.<=..<=) 4 6 )
308 , ( (Lib.Interval.<..<) 0 6
309 , (Lib.Interval.<=..<) 4 9
310 , (Lib.Interval.<=..<) 4 6 )
311 , ( (Lib.Interval.<..<=) 0 6
312 , (Lib.Interval.<..<) 4 9
313 , (Lib.Interval.<..<=) 4 6 )
314 , ( (Lib.Interval.<..<) 0 9
315 , (Lib.Interval.<..<) 0 9
316 , (Lib.Interval.<..<) 0 9 )
317 , ( (Lib.Interval.<=..<) 0 9
318 , (Lib.Interval.<..<=) 0 9
319 , (Lib.Interval.<..<) 0 9 )
320 , ( (Lib.Interval.<..<=) 0 9
321 , (Lib.Interval.<=..<) 0 9
322 , (Lib.Interval.<..<) 0 9 )
323 , ( (Lib.Interval.<=..<=) 0 9
324 , (Lib.Interval.<=..<=) 0 9
325 , (Lib.Interval.<=..<=) 0 9 )
327 , "union" ~: TestList $
330 let i = fromJust mi in
331 let j = fromJust mj in
332 [ ((show . Lib.Interval.Pretty) i ++ " " ++ (show . Lib.Interval.Pretty) j) ~: Lib.Interval.union i j ~?= e
333 , ((show . Lib.Interval.Pretty) j ++ " " ++ (show . Lib.Interval.Pretty) i) ~: Lib.Interval.union j i ~?= e
336 [ ( (Lib.Interval.<..<) 0 (4::Integer)
337 , (Lib.Interval.<..<) 5 9
339 , ( (Lib.Interval.<..<=) 0 5
340 , (Lib.Interval.<..<) 5 9
341 , (Lib.Interval.<..<) 0 9 )
342 , ( (Lib.Interval.<..<) 0 5
343 , (Lib.Interval.<=..<) 5 9
344 , (Lib.Interval.<..<) 0 9 )
345 , ( (Lib.Interval.<..<=) 0 5
346 , (Lib.Interval.<=..<) 5 9
347 , (Lib.Interval.<..<) 0 9 )
348 , ( (Lib.Interval.<..<) 0 6
349 , (Lib.Interval.<..<) 4 9
350 , (Lib.Interval.<..<) 0 9 )
351 , ( (Lib.Interval.<..<) 0 9
352 , (Lib.Interval.<..<) 0 9
353 , (Lib.Interval.<..<) 0 9 )
354 , ( (Lib.Interval.<=..<) 0 9
355 , (Lib.Interval.<..<=) 0 9
356 , (Lib.Interval.<=..<=) 0 9 )
357 , ( (Lib.Interval.<..<=) 0 9
358 , (Lib.Interval.<=..<) 0 9
359 , (Lib.Interval.<=..<=) 0 9 )
360 , ( (Lib.Interval.<=..<=) 0 9
361 , (Lib.Interval.<=..<=) 0 9
362 , (Lib.Interval.<=..<=) 0 9 )
364 , "Sieve" ~: TestList $
365 [ "union" ~: TestList $
368 let is = map (fromJust) mis in
369 let e = map (fromJust) me in
371 (flip (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton))
372 Lib.Interval.Sieve.empty is in
374 (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton)
375 Lib.Interval.Sieve.empty is in
376 [ (Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) is) ~:
377 Lib.Interval.Sieve.intervals sil ~?= e
378 , (Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) $ reverse is) ~:
379 Lib.Interval.Sieve.intervals sir ~?= e
382 [ ( [ (Lib.Interval.<=..<) 0 (5::Integer)
383 , (Lib.Interval.<=..<=) 5 9
385 , [ (Lib.Interval.<=..<=) 0 9 ]
387 , ( [ (Lib.Interval.<=..<=) 0 5
388 , (Lib.Interval.<=..<=) 0 9
390 , [ (Lib.Interval.<=..<=) 0 9 ]
392 , ( [ (Lib.Interval.<=..<=) 0 4
393 , (Lib.Interval.<=..<=) 5 9
394 , (Lib.Interval.<=..<=) 3 6
396 , [ (Lib.Interval.<=..<=) 0 9 ]
398 , ( [ (Lib.Interval.<=..<=) 1 4
399 , (Lib.Interval.<=..<=) 5 8
401 , [ (Lib.Interval.<=..<=) 1 4
402 , (Lib.Interval.<=..<=) 5 8
405 , ( [ (Lib.Interval.<=..<=) 1 8
406 , (Lib.Interval.<=..<=) 0 9
408 , [ (Lib.Interval.<=..<=) 0 9 ]
410 , ( [ (Lib.Interval.<=..<=) 1 4
411 , (Lib.Interval.<=..<=) 5 8
412 , (Lib.Interval.<=..<=) 0 9
414 , [ (Lib.Interval.<=..<=) 0 9 ]
417 ++ Data.List.concatMap
419 let is = map fromJust mis in
420 let js = map fromJust mjs in
421 let e = map fromJust me in
423 (flip (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton))
424 Lib.Interval.Sieve.empty is in
426 (flip (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton))
427 Lib.Interval.Sieve.empty js in
428 [ ((Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) is) ++ " u " ++
429 (Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) js)) ~:
430 Lib.Interval.Sieve.intervals (Lib.Interval.Sieve.union iu ju) ~?= e
431 , ((Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) $ js) ++ " u " ++
432 (Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) $ is)) ~:
433 Lib.Interval.Sieve.intervals (Lib.Interval.Sieve.union ju iu) ~?= e
436 [ ( [ (Lib.Interval.<=..<=) 0 (1::Integer)
437 , (Lib.Interval.<=..<=) 2 4
439 , [ (Lib.Interval.<=..<=) 0 3
441 , [ (Lib.Interval.<=..<=) 0 4
444 , ( [ (Lib.Interval.<=..<=) 0 1
445 , (Lib.Interval.<=..<=) 2 3
446 , (Lib.Interval.<=..<=) 4 5
447 , (Lib.Interval.<=..<=) 6 7
449 , [ (Lib.Interval.<=..<=) 1 2
450 , (Lib.Interval.<=..<=) 3 4
451 , (Lib.Interval.<=..<=) 5 6
453 , [ (Lib.Interval.<=..<=) 0 7
456 , ( [ (Lib.Interval.<=..<=) 0 1
457 , (Lib.Interval.<=..<=) 2 3
459 , [ (Lib.Interval.<=..<=) 4 5
461 , [ (Lib.Interval.<=..<=) 0 1
462 , (Lib.Interval.<=..<=) 2 3
463 , (Lib.Interval.<=..<=) 4 5
466 , ( [ (Lib.Interval.<=..<=) 0 1
467 , (Lib.Interval.<=..<=) 4 5
469 , [ (Lib.Interval.<=..<=) 2 3
471 , [ (Lib.Interval.<=..<=) 0 1
472 , (Lib.Interval.<=..<=) 2 3
473 , (Lib.Interval.<=..<=) 4 5
477 , "intersection" ~: TestList $
480 let is = map (fromJust) mis in
481 let js = map (fromJust) mjs in
482 let e = map (fromJust) me in
484 (flip (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton))
485 Lib.Interval.Sieve.empty is in
487 (flip (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton))
488 Lib.Interval.Sieve.empty js in
489 [ ((Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) is) ++ " n " ++
490 (Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) js)) ~:
491 Lib.Interval.Sieve.intervals (Lib.Interval.Sieve.intersection iu ju) ~?= e
492 , ((Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) $ js) ++ " n " ++
493 (Data.List.intercalate " " $ map (show . Lib.Interval.Pretty) $ is)) ~:
494 Lib.Interval.Sieve.intervals (Lib.Interval.Sieve.intersection ju iu) ~?= e
497 [ ( [ (Lib.Interval.<=..<) 0 (5::Integer) ]
498 , [ (Lib.Interval.<=..<=) 5 9 ]
501 , ( [ (Lib.Interval.<=..<=) 0 5 ]
502 , [ (Lib.Interval.<=..<=) 5 9 ]
503 , [ (Lib.Interval.<=..<=) 5 5 ]
505 , ( [ (Lib.Interval.<=..<=) 0 5 ]
506 , [ (Lib.Interval.<=..<=) 0 9 ]
507 , [ (Lib.Interval.<=..<=) 0 5 ]
509 , ( [ (Lib.Interval.<=..<=) 0 4
510 , (Lib.Interval.<=..<=) 5 9
512 , [ (Lib.Interval.<=..<=) 3 6 ]
513 , [ (Lib.Interval.<=..<=) 3 4
514 , (Lib.Interval.<=..<=) 5 6
517 , ( [ (Lib.Interval.<=..<=) 1 4
518 , (Lib.Interval.<=..<=) 6 8
520 , [ (Lib.Interval.<=..<=) 2 3
521 , (Lib.Interval.<=..<=) 5 7
523 , [ (Lib.Interval.<=..<=) 2 3
524 , (Lib.Interval.<=..<=) 6 7
528 , "complement" ~: TestList $
531 let is = map fromJust mis in
532 let e = map fromJust me in
534 (flip (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton))
535 Lib.Interval.Sieve.empty is in
536 [ show (Lib.Interval.Pretty $
537 Lib.Interval.Sieve.fmap_interval
538 (Lib.Interval.fmap_unsafe $ Lib.Interval.Pretty) iu) ~:
539 Lib.Interval.Sieve.intervals (Lib.Interval.Sieve.complement iu) ~?= e
542 [ ( [ ((Lib.Interval.<=..<) `on` Lib.Interval.Limited) 0 (5::Integer)
543 , ((Lib.Interval.<=..<=) `on` Lib.Interval.Limited) 5 9
545 , [ Just $ (Lib.Interval...<) 0
546 , Just $ (Lib.Interval.<..) 9
549 , ( [ Just $ Lib.Interval.unlimited ]
553 , [ Just $ Lib.Interval.unlimited ]
555 , ( [ Just $ (Lib.Interval...<) 0
556 , Just $ (Lib.Interval.<..) 0
558 , [ Just $ Lib.Interval.point $ Lib.Interval.Limited 0
561 , ( [ ((Lib.Interval.<=..<) `on` Lib.Interval.Limited) 0 1
562 , ((Lib.Interval.<=..<) `on` Lib.Interval.Limited) 2 3
563 , ((Lib.Interval.<..<=) `on` Lib.Interval.Limited) 3 4
565 , [ Just $ (Lib.Interval...<) 0
566 , ((Lib.Interval.<=..<) `on` Lib.Interval.Limited) 1 2
567 , Just $ Lib.Interval.point $ Lib.Interval.Limited 3
568 , Just $ (Lib.Interval.<..) 4
572 , "complement_with" ~: TestList $
575 let ib = fromJust mib in
576 let is = map fromJust mis in
577 let e = map fromJust me in
579 (flip (Lib.Interval.Sieve.union . Lib.Interval.Sieve.singleton))
580 Lib.Interval.Sieve.empty is in
581 [ show (Lib.Interval.Pretty iu) ~:
582 Lib.Interval.Sieve.intervals (Lib.Interval.Sieve.complement_with ib iu) ~?= e
585 [ ( (Lib.Interval.<=..<=) (-10) (10::Integer)
586 , [ (Lib.Interval.<=..<) 0 5
587 , (Lib.Interval.<=..<=) 5 9
589 , [ (Lib.Interval.<=..<) (-10) 0
590 , (Lib.Interval.<..<=) 9 10
593 , ( (Lib.Interval.<=..<=) (-10) 10
594 , [ (Lib.Interval.<=..<=) (-10) 10 ]
597 , ( (Lib.Interval.<=..<=) (-10) 10
599 , [ (Lib.Interval.<=..<=) (-10) 10 ]
601 , ( (Lib.Interval.<=..<=) (-10) 10
602 , [ (Lib.Interval.<=..<) (-10) 0
603 , (Lib.Interval.<..<=) 0 10
605 , [ Just $ Lib.Interval.point 0
608 , ( (Lib.Interval.<=..<=) (-10) 10
609 , [ Just $ Lib.Interval.point 0
611 , [ (Lib.Interval.<=..<) (-10) 0
612 , (Lib.Interval.<..<=) 0 10
615 , ( (Lib.Interval.<=..<=) 0 10
616 , [ (Lib.Interval.<..<=) 0 10
618 , [ Just $ Lib.Interval.point 0
621 , ( (Lib.Interval.<=..<=) 0 10
622 , [ (Lib.Interval.<=..<) 0 10
624 , [ Just $ Lib.Interval.point 10
627 , ( Just $ Lib.Interval.point 0
630 , [ Just $ Lib.Interval.point 0
633 , ( Just $ Lib.Interval.point 0
634 , [ Just $ Lib.Interval.point 0
643 , "Account" ~: TestList
644 [ "foldr" ~: TestList
646 (reverse $ Account.foldr ("A":|[]) (:) []) ~?= ["A":|[]]
648 (reverse $ Account.foldr ("A":|["B"]) (:) []) ~?= ["A":|[], "A":|["B"]]
650 (reverse $ Account.foldr ("A":|["B", "C"]) (:) []) ~?= ["A":|[], "A":|["B"], "A":|["B", "C"]]
652 , "ascending" ~: TestList
654 Account.ascending ("A":|[]) ~?= Nothing
656 Account.ascending ("A":|["B"]) ~?= Just ("A":|[])
658 Account.ascending ("A":|["B", "C"]) ~?= Just ("A":|["B"])
661 [ "section" ~: TestList
663 (Data.Either.rights $
665 (Account.Read.section <* P.eof)
670 (Data.Either.rights $
672 (Account.Read.section <* P.eof)
677 (Data.Either.rights $
679 (Account.Read.section <* P.eof)
684 (Data.Either.rights $
686 (Account.Read.section <* P.eof)
691 (Data.Either.rights $
693 (Account.Read.section <* P.eof)
698 (Data.Either.rights $
700 (Account.Read.section <* P.eof)
705 (Data.Either.rights $
707 (Account.Read.section <* P.eof)
712 (Data.Either.rights $
714 (Account.Read.section <* P.eof)
719 (Data.Either.rights $
721 (Account.Read.section)
726 (Data.Either.rights $
728 (Account.Read.section <* P.eof)
729 () "" ("A A"::Text)])
733 (Data.Either.rights $
735 (Account.Read.section <* P.eof)
740 (Data.Either.rights $
742 (Account.Read.section <* P.eof)
743 () "" ("A\t"::Text)])
747 (Data.Either.rights $
749 (Account.Read.section <* P.eof)
750 () "" ("A \n"::Text)])
754 (Data.Either.rights $
756 (Account.Read.section <* P.eof)
757 () "" ("(A)A"::Text)])
761 (Data.Either.rights $
763 (Account.Read.section <* P.eof)
764 () "" ("( )A"::Text)])
768 (Data.Either.rights $
770 (Account.Read.section <* P.eof)
771 () "" ("(A) A"::Text)])
775 (Data.Either.rights $
777 (Account.Read.section <* P.eof)
778 () "" ("[ ]A"::Text)])
782 (Data.Either.rights $
784 (Account.Read.section <* P.eof)
785 () "" ("(A) "::Text)])
789 (Data.Either.rights $
791 (Account.Read.section <* P.eof)
792 () "" ("(A)"::Text)])
796 (Data.Either.rights $
798 (Account.Read.section <* P.eof)
799 () "" ("A(A)"::Text)])
803 (Data.Either.rights $
805 (Account.Read.section <* P.eof)
806 () "" ("[A]A"::Text)])
810 (Data.Either.rights $
812 (Account.Read.section <* P.eof)
813 () "" ("[A] A"::Text)])
817 (Data.Either.rights $
819 (Account.Read.section <* P.eof)
820 () "" ("[A] "::Text)])
824 (Data.Either.rights $
826 (Account.Read.section <* P.eof)
827 () "" ("[A]"::Text)])
831 , "account" ~: TestList
833 (Data.Either.rights $
835 (Account.Read.account <* P.eof)
840 (Data.Either.rights $
842 (Account.Read.account <* P.eof)
847 (Data.Either.rights $
849 (Account.Read.account <* P.eof)
854 (Data.Either.rights $
856 (Account.Read.account <* P.eof)
861 (Data.Either.rights $
863 (Account.Read.account <* P.eof)
868 (Data.Either.rights $
870 (Account.Read.account <* P.eof)
875 (Data.Either.rights $
877 (Account.Read.account <* P.eof)
878 () "" ("A:B"::Text)])
882 (Data.Either.rights $
884 (Account.Read.account <* P.eof)
885 () "" ("A:B:C"::Text)])
888 , "\"Aa:Bbb:Cccc\"" ~:
889 (Data.Either.rights $
891 (Account.Read.account <* P.eof)
892 () "" ("Aa:Bbb:Cccc"::Text)])
894 ["Aa":|["Bbb", "Cccc"]]
895 , "\"A a : B b b : C c c c\"" ~:
896 (Data.Either.rights $
898 (Account.Read.account <* P.eof)
899 () "" ("A a : B b b : C c c c"::Text)])
901 ["A a ":|[" B b b ", " C c c c"]]
903 (Data.Either.rights $
905 (Account.Read.account <* P.eof)
906 () "" ("A: :C"::Text)])
910 (Data.Either.rights $
912 (Account.Read.account <* P.eof)
913 () "" ("A::C"::Text)])
917 (Data.Either.rights $
919 (Account.Read.account <* P.eof)
920 () "" ("A:B:(C)"::Text)])
926 , "Amount" ~: TestList
931 { Amount.quantity = Decimal 0 1
932 , Amount.style = Amount.Style.nil
933 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
938 { Amount.quantity = Decimal 0 1
939 , Amount.style = Amount.Style.nil
940 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
946 { Amount.quantity = Decimal 0 2
947 , Amount.style = Amount.Style.nil
948 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
953 , "from_List" ~: TestList
954 [ "from_List [$1, 1$] = $2" ~:
957 { Amount.quantity = Decimal 0 1
958 , Amount.style = Amount.Style.nil
959 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
964 { Amount.quantity = Decimal 0 1
965 , Amount.style = Amount.Style.nil
966 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
974 { Amount.quantity = Decimal 0 2
975 , Amount.style = Amount.Style.nil
976 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
983 [ "amount" ~: TestList
985 (Data.Either.rights $
987 (Amount.Read.amount <* P.eof)
991 , "\"0\" = Right 0" ~:
992 (Data.Either.rights $
994 (Amount.Read.amount <* P.eof)
998 { Amount.quantity = Decimal 0 0
1000 , "\"00\" = Right 0" ~:
1001 (Data.Either.rights $
1003 (Amount.Read.amount <* P.eof)
1004 () "" ("00"::Text)])
1007 { Amount.quantity = Decimal 0 0
1009 , "\"0.\" = Right 0." ~:
1010 (Data.Either.rights $
1012 (Amount.Read.amount <* P.eof)
1013 () "" ("0."::Text)])
1016 { Amount.quantity = Decimal 0 0
1019 { Amount.Style.fractioning = Just '.'
1022 , "\".0\" = Right 0.0" ~:
1023 (Data.Either.rights $
1025 (Amount.Read.amount <* P.eof)
1026 () "" (".0"::Text)])
1029 { Amount.quantity = Decimal 0 0
1032 { Amount.Style.fractioning = Just '.'
1033 , Amount.Style.precision = 1
1036 , "\"0,\" = Right 0," ~:
1037 (Data.Either.rights $
1039 (Amount.Read.amount <* P.eof)
1040 () "" ("0,"::Text)])
1043 { Amount.quantity = Decimal 0 0
1046 { Amount.Style.fractioning = Just ','
1049 , "\",0\" = Right 0,0" ~:
1050 (Data.Either.rights $
1052 (Amount.Read.amount <* P.eof)
1053 () "" (",0"::Text)])
1056 { Amount.quantity = Decimal 0 0
1059 { Amount.Style.fractioning = Just ','
1060 , Amount.Style.precision = 1
1063 , "\"0_\" = Left" ~:
1064 (Data.Either.rights $
1066 (Amount.Read.amount <* P.eof)
1067 () "" ("0_"::Text)])
1070 , "\"_0\" = Left" ~:
1071 (Data.Either.rights $
1073 (Amount.Read.amount <* P.eof)
1074 () "" ("_0"::Text)])
1077 , "\"0.0\" = Right 0.0" ~:
1078 (Data.Either.rights $
1080 (Amount.Read.amount <* P.eof)
1081 () "" ("0.0"::Text)])
1084 { Amount.quantity = Decimal 0 0
1087 { Amount.Style.fractioning = Just '.'
1088 , Amount.Style.precision = 1
1091 , "\"00.00\" = Right 0.00" ~:
1092 (Data.Either.rights $
1094 (Amount.Read.amount <* P.eof)
1095 () "" ("00.00"::Text)])
1098 { Amount.quantity = Decimal 0 0
1101 { Amount.Style.fractioning = Just '.'
1102 , Amount.Style.precision = 2
1105 , "\"0,0\" = Right 0,0" ~:
1106 (Data.Either.rights $
1108 (Amount.Read.amount <* P.eof)
1109 () "" ("0,0"::Text)])
1112 { Amount.quantity = Decimal 0 0
1115 { Amount.Style.fractioning = Just ','
1116 , Amount.Style.precision = 1
1119 , "\"00,00\" = Right 0,00" ~:
1120 (Data.Either.rights $
1122 (Amount.Read.amount <* P.eof)
1123 () "" ("00,00"::Text)])
1126 { Amount.quantity = Decimal 0 0
1129 { Amount.Style.fractioning = Just ','
1130 , Amount.Style.precision = 2
1133 , "\"0_0\" = Right 0" ~:
1134 (Data.Either.rights $
1136 (Amount.Read.amount <* P.eof)
1137 () "" ("0_0"::Text)])
1140 { Amount.quantity = Decimal 0 0
1143 { Amount.Style.fractioning = Nothing
1144 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
1145 , Amount.Style.precision = 0
1148 , "\"00_00\" = Right 0" ~:
1149 (Data.Either.rights $
1151 (Amount.Read.amount <* P.eof)
1152 () "" ("00_00"::Text)])
1155 { Amount.quantity = Decimal 0 0
1158 { Amount.Style.fractioning = Nothing
1159 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
1160 , Amount.Style.precision = 0
1163 , "\"0,000.00\" = Right 0,000.00" ~:
1164 (Data.Either.rights $
1166 (Amount.Read.amount <* P.eof)
1167 () "" ("0,000.00"::Text)])
1170 { Amount.quantity = Decimal 0 0
1173 { Amount.Style.fractioning = Just '.'
1174 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
1175 , Amount.Style.precision = 2
1178 , "\"0.000,00\" = Right 0.000,00" ~:
1179 (Data.Either.rights $
1181 (Amount.Read.amount)
1182 () "" ("0.000,00"::Text)])
1185 { Amount.quantity = Decimal 0 0
1188 { Amount.Style.fractioning = Just ','
1189 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1190 , Amount.Style.precision = 2
1193 , "\"1,000.00\" = Right 1,000.00" ~:
1194 (Data.Either.rights $
1196 (Amount.Read.amount <* P.eof)
1197 () "" ("1,000.00"::Text)])
1200 { Amount.quantity = Decimal 0 1000
1203 { Amount.Style.fractioning = Just '.'
1204 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
1205 , Amount.Style.precision = 2
1208 , "\"1.000,00\" = Right 1.000,00" ~:
1209 (Data.Either.rights $
1211 (Amount.Read.amount)
1212 () "" ("1.000,00"::Text)])
1215 { Amount.quantity = Decimal 0 1000
1218 { Amount.Style.fractioning = Just ','
1219 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1220 , Amount.Style.precision = 2
1223 , "\"1,000.00.\" = Left" ~:
1224 (Data.Either.rights $
1226 (Amount.Read.amount)
1227 () "" ("1,000.00."::Text)])
1230 , "\"1.000,00,\" = Left" ~:
1231 (Data.Either.rights $
1233 (Amount.Read.amount)
1234 () "" ("1.000,00,"::Text)])
1237 , "\"1,000.00_\" = Left" ~:
1238 (Data.Either.rights $
1240 (Amount.Read.amount)
1241 () "" ("1,000.00_"::Text)])
1244 , "\"12\" = Right 12" ~:
1245 (Data.Either.rights $
1247 (Amount.Read.amount <* P.eof)
1248 () "" ("123"::Text)])
1251 { Amount.quantity = Decimal 0 123
1253 , "\"1.2\" = Right 1.2" ~:
1254 (Data.Either.rights $
1256 (Amount.Read.amount <* P.eof)
1257 () "" ("1.2"::Text)])
1260 { Amount.quantity = Decimal 1 12
1263 { Amount.Style.fractioning = Just '.'
1264 , Amount.Style.precision = 1
1267 , "\"1,2\" = Right 1,2" ~:
1268 (Data.Either.rights $
1270 (Amount.Read.amount <* P.eof)
1271 () "" ("1,2"::Text)])
1274 { Amount.quantity = Decimal 1 12
1277 { Amount.Style.fractioning = Just ','
1278 , Amount.Style.precision = 1
1281 , "\"12.23\" = Right 12.23" ~:
1282 (Data.Either.rights $
1284 (Amount.Read.amount <* P.eof)
1285 () "" ("12.34"::Text)])
1288 { Amount.quantity = Decimal 2 1234
1291 { Amount.Style.fractioning = Just '.'
1292 , Amount.Style.precision = 2
1295 , "\"12,23\" = Right 12,23" ~:
1296 (Data.Either.rights $
1298 (Amount.Read.amount <* P.eof)
1299 () "" ("12,34"::Text)])
1302 { Amount.quantity = Decimal 2 1234
1305 { Amount.Style.fractioning = Just ','
1306 , Amount.Style.precision = 2
1309 , "\"1_2\" = Right 1_2" ~:
1310 (Data.Either.rights $
1312 (Amount.Read.amount <* P.eof)
1313 () "" ("1_2"::Text)])
1316 { Amount.quantity = Decimal 0 12
1319 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
1320 , Amount.Style.precision = 0
1323 , "\"1_23\" = Right 1_23" ~:
1324 (Data.Either.rights $
1326 (Amount.Read.amount <* P.eof)
1327 () "" ("1_23"::Text)])
1330 { Amount.quantity = Decimal 0 123
1333 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
1334 , Amount.Style.precision = 0
1337 , "\"1_23_456\" = Right 1_23_456" ~:
1338 (Data.Either.rights $
1340 (Amount.Read.amount <* P.eof)
1341 () "" ("1_23_456"::Text)])
1344 { Amount.quantity = Decimal 0 123456
1347 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
1348 , Amount.Style.precision = 0
1351 , "\"1_23_456.7890_12345_678901\" = Right 1_23_456.7890_12345_678901" ~:
1352 (Data.Either.rights $
1354 (Amount.Read.amount <* P.eof)
1355 () "" ("1_23_456.7890_12345_678901"::Text)])
1358 { Amount.quantity = Decimal 15 123456789012345678901
1361 { Amount.Style.fractioning = Just '.'
1362 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
1363 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [4, 5, 6]
1364 , Amount.Style.precision = 15
1367 , "\"123456_78901_2345.678_90_1\" = Right 123456_78901_2345.678_90_1" ~:
1368 (Data.Either.rights $
1370 (Amount.Read.amount <* P.eof)
1371 () "" ("123456_78901_2345.678_90_1"::Text)])
1374 { Amount.quantity = Decimal 6 123456789012345678901
1377 { Amount.Style.fractioning = Just '.'
1378 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [4, 5, 6]
1379 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [3, 2]
1380 , Amount.Style.precision = 6
1383 , "\"$1\" = Right $1" ~:
1384 (Data.Either.rights $
1386 (Amount.Read.amount <* P.eof)
1387 () "" ("$1"::Text)])
1390 { Amount.quantity = Decimal 0 1
1393 { Amount.Style.fractioning = Nothing
1394 , Amount.Style.grouping_integral = Nothing
1395 , Amount.Style.grouping_fractional = Nothing
1396 , Amount.Style.precision = 0
1397 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1398 , Amount.Style.unit_spaced = Just False
1402 , "\"1$\" = Right 1$" ~:
1403 (Data.Either.rights $
1405 (Amount.Read.amount <* P.eof)
1406 () "" ("1$"::Text)])
1409 { Amount.quantity = Decimal 0 1
1412 { Amount.Style.fractioning = Nothing
1413 , Amount.Style.grouping_integral = Nothing
1414 , Amount.Style.grouping_fractional = Nothing
1415 , Amount.Style.precision = 0
1416 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1417 , Amount.Style.unit_spaced = Just False
1421 , "\"$ 1\" = Right $ 1" ~:
1422 (Data.Either.rights $
1424 (Amount.Read.amount <* P.eof)
1425 () "" ("$ 1"::Text)])
1428 { Amount.quantity = Decimal 0 1
1431 { Amount.Style.fractioning = Nothing
1432 , Amount.Style.grouping_integral = Nothing
1433 , Amount.Style.grouping_fractional = Nothing
1434 , Amount.Style.precision = 0
1435 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1436 , Amount.Style.unit_spaced = Just True
1440 , "\"1 $\" = Right 1 $" ~:
1441 (Data.Either.rights $
1443 (Amount.Read.amount <* P.eof)
1444 () "" ("1 $"::Text)])
1447 { Amount.quantity = Decimal 0 1
1450 { Amount.Style.fractioning = Nothing
1451 , Amount.Style.grouping_integral = Nothing
1452 , Amount.Style.grouping_fractional = Nothing
1453 , Amount.Style.precision = 0
1454 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1455 , Amount.Style.unit_spaced = Just True
1459 , "\"-$1\" = Right $-1" ~:
1460 (Data.Either.rights $
1462 (Amount.Read.amount <* P.eof)
1463 () "" ("-$1"::Text)])
1466 { Amount.quantity = Decimal 0 (-1)
1469 { Amount.Style.fractioning = Nothing
1470 , Amount.Style.grouping_integral = Nothing
1471 , Amount.Style.grouping_fractional = Nothing
1472 , Amount.Style.precision = 0
1473 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1474 , Amount.Style.unit_spaced = Just False
1478 , "\"\\\"4 2\\\"1\" = Right \\\"4 2\\\"1" ~:
1479 (Data.Either.rights $
1481 (Amount.Read.amount <* P.eof)
1482 () "" ("\"4 2\"1"::Text)])
1485 { Amount.quantity = Decimal 0 1
1488 { Amount.Style.fractioning = Nothing
1489 , Amount.Style.grouping_integral = Nothing
1490 , Amount.Style.grouping_fractional = Nothing
1491 , Amount.Style.precision = 0
1492 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1493 , Amount.Style.unit_spaced = Just False
1495 , Amount.unit = "4 2"
1497 , "\"1\\\"4 2\\\"\" = Right 1\\\"4 2\\\"" ~:
1498 (Data.Either.rights $
1500 (Amount.Read.amount <* P.eof)
1501 () "" ("1\"4 2\""::Text)])
1504 { Amount.quantity = Decimal 0 1
1507 { Amount.Style.fractioning = Nothing
1508 , Amount.Style.grouping_integral = Nothing
1509 , Amount.Style.grouping_fractional = Nothing
1510 , Amount.Style.precision = 0
1511 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1512 , Amount.Style.unit_spaced = Just False
1514 , Amount.unit = "4 2"
1516 , "\"$1.000,00\" = Right $1.000,00" ~:
1517 (Data.Either.rights $
1519 (Amount.Read.amount <* P.eof)
1520 () "" ("$1.000,00"::Text)])
1523 { Amount.quantity = Decimal 0 1000
1526 { Amount.Style.fractioning = Just ','
1527 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1528 , Amount.Style.grouping_fractional = Nothing
1529 , Amount.Style.precision = 2
1530 , Amount.Style.unit_side = Just Amount.Style.Side_Left
1531 , Amount.Style.unit_spaced = Just False
1535 , "\"1.000,00$\" = Right 1.000,00$" ~:
1536 (Data.Either.rights $
1538 (Amount.Read.amount <* P.eof)
1539 () "" ("1.000,00$"::Text)])
1542 { Amount.quantity = Decimal 0 1000
1545 { Amount.Style.fractioning = Just ','
1546 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
1547 , Amount.Style.grouping_fractional = Nothing
1548 , Amount.Style.precision = 2
1549 , Amount.Style.unit_side = Just Amount.Style.Side_Right
1550 , Amount.Style.unit_spaced = Just False
1556 , "Write" ~: TestList
1557 [ "amount" ~: TestList
1559 ((Format.Ledger.Write.show
1560 Format.Ledger.Write.Style
1561 { Format.Ledger.Write.style_color=False
1562 , Format.Ledger.Write.style_align=True
1569 ((Format.Ledger.Write.show
1570 Format.Ledger.Write.Style
1571 { Format.Ledger.Write.style_color=False
1572 , Format.Ledger.Write.style_align=True
1576 { Amount.style = Amount.Style.nil
1577 { Amount.Style.precision = 2 }
1582 ((Format.Ledger.Write.show
1583 Format.Ledger.Write.Style
1584 { Format.Ledger.Write.style_color=False
1585 , Format.Ledger.Write.style_align=True
1589 { Amount.quantity = Decimal 0 123
1594 ((Format.Ledger.Write.show
1595 Format.Ledger.Write.Style
1596 { Format.Ledger.Write.style_color=False
1597 , Format.Ledger.Write.style_align=True
1601 { Amount.quantity = Decimal 0 (- 123)
1605 , "12.3 @ prec=0" ~:
1606 ((Format.Ledger.Write.show
1607 Format.Ledger.Write.Style
1608 { Format.Ledger.Write.style_color=False
1609 , Format.Ledger.Write.style_align=True
1613 { Amount.quantity = Decimal 1 123
1614 , Amount.style = Amount.Style.nil
1615 { Amount.Style.fractioning = Just '.'
1620 , "12.5 @ prec=0" ~:
1621 ((Format.Ledger.Write.show
1622 Format.Ledger.Write.Style
1623 { Format.Ledger.Write.style_color=False
1624 , Format.Ledger.Write.style_align=True
1628 { Amount.quantity = Decimal 1 125
1629 , Amount.style = Amount.Style.nil
1630 { Amount.Style.fractioning = Just '.'
1635 , "12.3 @ prec=1" ~:
1636 ((Format.Ledger.Write.show
1637 Format.Ledger.Write.Style
1638 { Format.Ledger.Write.style_color=False
1639 , Format.Ledger.Write.style_align=True
1643 { Amount.quantity = Decimal 1 123
1644 , Amount.style = Amount.Style.nil
1645 { Amount.Style.fractioning = Just '.'
1646 , Amount.Style.precision = 1
1651 , "1,234.56 @ prec=2" ~:
1652 ((Format.Ledger.Write.show
1653 Format.Ledger.Write.Style
1654 { Format.Ledger.Write.style_color=False
1655 , Format.Ledger.Write.style_align=True
1659 { Amount.quantity = Decimal 2 123456
1660 , Amount.style = Amount.Style.nil
1661 { Amount.Style.fractioning = Just '.'
1662 , Amount.Style.precision = 2
1663 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
1668 , "123,456,789,01,2.3456789 @ prec=7" ~:
1669 ((Format.Ledger.Write.show
1670 Format.Ledger.Write.Style
1671 { Format.Ledger.Write.style_color=False
1672 , Format.Ledger.Write.style_align=True
1676 { Amount.quantity = Decimal 7 1234567890123456789
1677 , Amount.style = Amount.Style.nil
1678 { Amount.Style.fractioning = Just '.'
1679 , Amount.Style.precision = 7
1680 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
1684 "123,456,789,01,2.3456789")
1685 , "1234567.8,90,123,456,789 @ prec=12" ~:
1686 ((Format.Ledger.Write.show
1687 Format.Ledger.Write.Style
1688 { Format.Ledger.Write.style_color=False
1689 , Format.Ledger.Write.style_align=True
1693 { Amount.quantity = Decimal 12 1234567890123456789
1694 , Amount.style = Amount.Style.nil
1695 { Amount.Style.fractioning = Just '.'
1696 , Amount.Style.precision = 12
1697 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
1701 "1234567.8,90,123,456,789")
1702 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
1703 ((Format.Ledger.Write.show
1704 Format.Ledger.Write.Style
1705 { Format.Ledger.Write.style_color=False
1706 , Format.Ledger.Write.style_align=True
1710 { Amount.quantity = Decimal 7 1234567890123456789
1711 , Amount.style = Amount.Style.nil
1712 { Amount.Style.fractioning = Just '.'
1713 , Amount.Style.precision = 7
1714 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
1718 "1,2,3,4,5,6,7,89,012.3456789")
1719 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
1720 ((Format.Ledger.Write.show
1721 Format.Ledger.Write.Style
1722 { Format.Ledger.Write.style_color=False
1723 , Format.Ledger.Write.style_align=True
1727 { Amount.quantity = Decimal 12 1234567890123456789
1728 , Amount.style = Amount.Style.nil
1729 { Amount.Style.fractioning = Just '.'
1730 , Amount.Style.precision = 12
1731 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
1735 "1234567.890,12,3,4,5,6,7,8,9")
1737 , "amount_length" ~: TestList
1739 ((Amount.Write.amount_length
1744 ((Amount.Write.amount_length
1746 { Amount.style = Amount.Style.nil
1747 { Amount.Style.precision = 2 }
1752 ((Amount.Write.amount_length
1754 { Amount.quantity = Decimal 0 123
1759 ((Amount.Write.amount_length
1761 { Amount.quantity = Decimal 0 (- 123)
1765 , "12.3 @ prec=0" ~:
1766 ((Amount.Write.amount_length
1768 { Amount.quantity = Decimal 1 123
1769 , Amount.style = Amount.Style.nil
1770 { Amount.Style.fractioning = Just '.'
1775 , "12.5 @ prec=0" ~:
1776 ((Amount.Write.amount_length
1778 { Amount.quantity = Decimal 1 125
1779 , Amount.style = Amount.Style.nil
1780 { Amount.Style.fractioning = Just '.'
1785 , "12.3 @ prec=1" ~:
1786 ((Amount.Write.amount_length
1788 { Amount.quantity = Decimal 1 123
1789 , Amount.style = Amount.Style.nil
1790 { Amount.Style.fractioning = Just '.'
1791 , Amount.Style.precision = 1
1796 , "1,234.56 @ prec=2" ~:
1797 ((Amount.Write.amount_length
1799 { Amount.quantity = Decimal 2 123456
1800 , Amount.style = Amount.Style.nil
1801 { Amount.Style.fractioning = Just '.'
1802 , Amount.Style.precision = 2
1803 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
1808 , "123,456,789,01,2.3456789 @ prec=7" ~:
1809 ((Amount.Write.amount_length
1811 { Amount.quantity = Decimal 7 1234567890123456789
1812 , Amount.style = Amount.Style.nil
1813 { Amount.Style.fractioning = Just '.'
1814 , Amount.Style.precision = 7
1815 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
1820 , "1234567.8,90,123,456,789 @ prec=12" ~:
1821 ((Amount.Write.amount_length
1823 { Amount.quantity = Decimal 12 1234567890123456789
1824 , Amount.style = Amount.Style.nil
1825 { Amount.Style.fractioning = Just '.'
1826 , Amount.Style.precision = 12
1827 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
1832 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
1833 ((Amount.Write.amount_length
1835 { Amount.quantity = Decimal 7 1234567890123456789
1836 , Amount.style = Amount.Style.nil
1837 { Amount.Style.fractioning = Just '.'
1838 , Amount.Style.precision = 7
1839 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
1844 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
1845 ((Amount.Write.amount_length
1847 { Amount.quantity = Decimal 12 1234567890123456789
1848 , Amount.style = Amount.Style.nil
1849 { Amount.Style.fractioning = Just '.'
1850 , Amount.Style.precision = 12
1851 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
1856 , "1000000.000,00,0,0,0,0,0,0,0 @ prec=12" ~:
1857 ((Amount.Write.amount_length
1859 { Amount.quantity = Decimal 12 1000000000000000000
1860 , Amount.style = Amount.Style.nil
1861 { Amount.Style.fractioning = Just '.'
1862 , Amount.Style.precision = 12
1863 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
1869 ((Amount.Write.amount_length $
1871 { Amount.quantity = Decimal 0 999
1872 , Amount.style = Amount.Style.nil
1873 { Amount.Style.precision = 0
1878 , "1000 @ prec=0" ~:
1879 ((Amount.Write.amount_length $
1881 { Amount.quantity = Decimal 0 1000
1882 , Amount.style = Amount.Style.nil
1883 { Amount.Style.precision = 0
1888 , "10,00€ @ prec=2" ~:
1889 ((Amount.Write.amount_length $ Amount.eur 10)
1895 , "Date" ~: TestList
1896 [ "Read" ~: TestList
1897 [ "date" ~: TestList
1899 (Data.Either.rights $
1900 [P.runParser_with_Error
1901 (Date.Read.date id Nothing <* P.eof)
1902 () "" ("2000/01/01"::Text)])
1904 [ Time.zonedTimeToUTC $
1907 (Time.fromGregorian 2000 01 01)
1908 (Time.TimeOfDay 0 0 0))
1910 , "2000/01/01 some text" ~:
1911 (Data.Either.rights $
1912 [P.runParser_with_Error
1913 (Date.Read.date id Nothing)
1914 () "" ("2000/01/01 some text"::Text)])
1916 [ Time.zonedTimeToUTC $
1919 (Time.fromGregorian 2000 01 01)
1920 (Time.TimeOfDay 0 0 0))
1922 , "2000/01/01_12:34" ~:
1923 (Data.Either.rights $
1924 [P.runParser_with_Error
1925 (Date.Read.date id Nothing <* P.eof)
1926 () "" ("2000/01/01_12:34"::Text)])
1928 [ Time.zonedTimeToUTC $
1931 (Time.fromGregorian 2000 01 01)
1932 (Time.TimeOfDay 12 34 0))
1934 , "2000/01/01_12:34:56" ~:
1935 (Data.Either.rights $
1936 [P.runParser_with_Error
1937 (Date.Read.date id Nothing <* P.eof)
1938 () "" ("2000/01/01_12:34:56"::Text)])
1940 [ Time.zonedTimeToUTC $
1943 (Time.fromGregorian 2000 01 01)
1944 (Time.TimeOfDay 12 34 56))
1946 , "2000/01/01_12:34CET" ~:
1947 (Data.Either.rights $
1948 [P.runParser_with_Error
1949 (Date.Read.date id Nothing <* P.eof)
1950 () "" ("2000/01/01_12:34CET"::Text)])
1952 [ Time.zonedTimeToUTC $
1955 (Time.fromGregorian 2000 01 01)
1956 (Time.TimeOfDay 12 34 0))
1957 (Time.TimeZone 60 True "CET")]
1958 , "2000/01/01_12:34+0130" ~:
1959 (Data.Either.rights $
1960 [P.runParser_with_Error
1961 (Date.Read.date id Nothing <* P.eof)
1962 () "" ("2000/01/01_12:34+0130"::Text)])
1964 [ Time.zonedTimeToUTC $
1967 (Time.fromGregorian 2000 01 01)
1968 (Time.TimeOfDay 12 34 0))
1969 (Time.TimeZone 90 False "+0130")]
1970 , "2000/01/01_12:34:56CET" ~:
1971 (Data.Either.rights $
1972 [P.runParser_with_Error
1973 (Date.Read.date id Nothing <* P.eof)
1974 () "" ("2000/01/01_12:34:56CET"::Text)])
1976 [ Time.zonedTimeToUTC $
1979 (Time.fromGregorian 2000 01 01)
1980 (Time.TimeOfDay 12 34 56))
1981 (Time.TimeZone 60 True "CET")]
1983 (Data.Either.rights $
1984 [P.runParser_with_Error
1985 (Date.Read.date id Nothing <* P.eof)
1986 () "" ("2001/02/29"::Text)])
1990 (Data.Either.rights $
1991 [P.runParser_with_Error
1992 (Date.Read.date id (Just 2000) <* P.eof)
1993 () "" ("01/01"::Text)])
1995 [ Time.zonedTimeToUTC $
1998 (Time.fromGregorian 2000 01 01)
1999 (Time.TimeOfDay 0 0 0))
2003 , "Write" ~: TestList
2004 [ "date" ~: TestList
2006 ((Format.Ledger.Write.show
2007 Format.Ledger.Write.Style
2008 { Format.Ledger.Write.style_color=False
2009 , Format.Ledger.Write.style_align=True
2015 , "2000/01/01_12:34:51CET" ~:
2016 (Format.Ledger.Write.show
2017 Format.Ledger.Write.Style
2018 { Format.Ledger.Write.style_color=False
2019 , Format.Ledger.Write.style_align=True
2022 Time.zonedTimeToUTC $
2025 (Time.fromGregorian 2000 01 01)
2026 (Time.TimeOfDay 12 34 51))
2027 (Time.TimeZone 60 False "CET"))
2029 "2000/01/01_11:34:51"
2030 , "2000/01/01_12:34:51+0100" ~:
2031 (Format.Ledger.Write.show
2032 Format.Ledger.Write.Style
2033 { Format.Ledger.Write.style_color=False
2034 , Format.Ledger.Write.style_align=True
2037 Time.zonedTimeToUTC $
2040 (Time.fromGregorian 2000 01 01)
2041 (Time.TimeOfDay 12 34 51))
2042 (Time.TimeZone 60 False ""))
2044 "2000/01/01_11:34:51"
2045 , "2000/01/01_01:02:03" ~:
2046 (Format.Ledger.Write.show
2047 Format.Ledger.Write.Style
2048 { Format.Ledger.Write.style_color=False
2049 , Format.Ledger.Write.style_align=True
2052 Time.zonedTimeToUTC $
2055 (Time.fromGregorian 2000 01 01)
2056 (Time.TimeOfDay 1 2 3))
2059 "2000/01/01_01:02:03"
2061 (Format.Ledger.Write.show
2062 Format.Ledger.Write.Style
2063 { Format.Ledger.Write.style_color=False
2064 , Format.Ledger.Write.style_align=True
2067 Time.zonedTimeToUTC $
2070 (Time.fromGregorian 0 01 01)
2071 (Time.TimeOfDay 1 2 0))
2076 (Format.Ledger.Write.show
2077 Format.Ledger.Write.Style
2078 { Format.Ledger.Write.style_color=False
2079 , Format.Ledger.Write.style_align=True
2082 Time.zonedTimeToUTC $
2085 (Time.fromGregorian 0 01 01)
2086 (Time.TimeOfDay 1 0 0))
2091 (Format.Ledger.Write.show
2092 Format.Ledger.Write.Style
2093 { Format.Ledger.Write.style_color=False
2094 , Format.Ledger.Write.style_align=True
2097 Time.zonedTimeToUTC $
2100 (Time.fromGregorian 0 01 01)
2101 (Time.TimeOfDay 0 1 0))
2106 (Format.Ledger.Write.show
2107 Format.Ledger.Write.Style
2108 { Format.Ledger.Write.style_color=False
2109 , Format.Ledger.Write.style_align=True
2112 Time.zonedTimeToUTC $
2115 (Time.fromGregorian 0 01 01)
2116 (Time.TimeOfDay 0 0 0))
2123 , "Filter" ~: TestList
2124 [ "test" ~: TestList
2125 [ "Filter_Path" ~: TestList
2128 (Filter.Filter_Path Filter.Eq
2129 [ Filter.Filter_Path_Section_Text
2130 (Filter.Filter_Text_Exact "A")
2132 (("A":|[]::Account))
2135 (Filter.Filter_Path Filter.Eq
2136 [ Filter.Filter_Path_Section_Any
2138 (("A":|[]::Account))
2141 (Filter.Filter_Path Filter.Eq
2142 [ Filter.Filter_Path_Section_Many
2144 (("A":|[]::Account))
2147 (Filter.Filter_Path Filter.Eq
2148 [ Filter.Filter_Path_Section_Many
2149 , Filter.Filter_Path_Section_Text
2150 (Filter.Filter_Text_Exact "A")
2152 (("A":|[]::Account))
2155 (Filter.Filter_Path Filter.Eq
2156 [ Filter.Filter_Path_Section_Text
2157 (Filter.Filter_Text_Exact "A")
2158 , Filter.Filter_Path_Section_Many
2160 (("A":|[]::Account))
2163 (Filter.Filter_Path Filter.Eq
2164 [ Filter.Filter_Path_Section_Text
2165 (Filter.Filter_Text_Exact "A")
2166 , Filter.Filter_Path_Section_Many
2168 (("A":|"B":[]::Account))
2171 (Filter.Filter_Path Filter.Eq
2172 [ Filter.Filter_Path_Section_Text
2173 (Filter.Filter_Text_Exact "A")
2174 , Filter.Filter_Path_Section_Text
2175 (Filter.Filter_Text_Exact "B")
2177 (("A":|"B":[]::Account))
2180 (Filter.Filter_Path Filter.Eq
2181 [ Filter.Filter_Path_Section_Text
2182 (Filter.Filter_Text_Exact "A")
2183 , Filter.Filter_Path_Section_Many
2184 , Filter.Filter_Path_Section_Many
2185 , Filter.Filter_Path_Section_Text
2186 (Filter.Filter_Text_Exact "B")
2188 (("A":|"B":[]::Account))
2191 (Filter.Filter_Path Filter.Eq
2192 [ Filter.Filter_Path_Section_Many
2193 , Filter.Filter_Path_Section_Text
2194 (Filter.Filter_Text_Exact "B")
2195 , Filter.Filter_Path_Section_Many
2197 (("A":|"B":"C":[]::Account))
2200 (Filter.Filter_Path Filter.Eq
2201 [ Filter.Filter_Path_Section_Many
2202 , Filter.Filter_Path_Section_Text
2203 (Filter.Filter_Text_Exact "C")
2205 (("A":|"B":"C":[]::Account))
2206 , "<A:B:C::D A:B" ~?
2208 (Filter.Filter_Path Filter.Lt
2209 [ Filter.Filter_Path_Section_Text
2210 (Filter.Filter_Text_Exact "A")
2211 , Filter.Filter_Path_Section_Text
2212 (Filter.Filter_Text_Exact "B")
2213 , Filter.Filter_Path_Section_Text
2214 (Filter.Filter_Text_Exact "C")
2215 , Filter.Filter_Path_Section_Many
2216 , Filter.Filter_Path_Section_Text
2217 (Filter.Filter_Text_Exact "D")
2219 (("A":|"B":[]::Account))
2220 , ">A:B:C::D A:B:C:CC:CCC:D:E" ~?
2222 (Filter.Filter_Path Filter.Gt
2223 [ Filter.Filter_Path_Section_Text
2224 (Filter.Filter_Text_Exact "A")
2225 , Filter.Filter_Path_Section_Text
2226 (Filter.Filter_Text_Exact "B")
2227 , Filter.Filter_Path_Section_Text
2228 (Filter.Filter_Text_Exact "C")
2229 , Filter.Filter_Path_Section_Many
2230 , Filter.Filter_Path_Section_Text
2231 (Filter.Filter_Text_Exact "D")
2233 (("A":|"B":"C":"CC":"CCC":"D":"E":[]::Account))
2235 , "Filter_Bool" ~: TestList
2238 (Filter.Any::Filter.Filter_Bool (Filter.Filter_Account (Chart, Account)))
2239 (mempty, ("A":|[]::Account))
2241 , "Filter_Ord" ~: TestList
2244 (Filter.With_Interval $ Filter.Filter_Ord Filter.Gt (0::Integer))
2245 (fromJust $ (Lib.Interval.<=..<=) 1 2)
2248 (Filter.With_Interval $ Filter.Filter_Ord Filter.Lt (0::Integer))
2249 (fromJust $ (Lib.Interval.<=..<=) (-2) (-1))
2250 , "not (1 < (0, 2))" ~?
2252 (Filter.With_Interval $ Filter.Filter_Ord Filter.Gt (1::Integer))
2253 (fromJust $ (Lib.Interval.<=..<=) 0 2))
2256 , "Read" ~: TestList
2257 [ "filter_account" ~: TestList
2259 (Data.Either.rights $
2261 (Filter.Read.filter_account_path <* P.eof)
2264 [ Filter.Filter_Path Filter.Eq
2265 [ Filter.Filter_Path_Section_Any ]
2268 (Data.Either.rights $
2270 (Filter.Read.filter_account_path <* P.eof)
2273 [ Filter.Filter_Path Filter.Eq
2274 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A") ]
2277 (Data.Either.rights $
2279 (Filter.Read.filter_account_path <* P.eof)
2280 () "" ("AA"::Text)])
2282 [ Filter.Filter_Path Filter.Eq
2283 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "AA") ]
2286 (Data.Either.rights $
2288 (Filter.Read.filter_account_path <* P.eof)
2289 () "" ("::A"::Text)])
2291 [ Filter.Filter_Path Filter.Eq
2292 [ Filter.Filter_Path_Section_Many
2293 , Filter.Filter_Path_Section_Many
2294 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2298 (Data.Either.rights $
2300 (Filter.Read.filter_account_path <* P.eof)
2301 () "" (":A"::Text)])
2303 [ Filter.Filter_Path Filter.Eq
2304 [ Filter.Filter_Path_Section_Many
2305 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2309 (Data.Either.rights $
2311 (Filter.Read.filter_account_path <* P.eof)
2312 () "" ("A:"::Text)])
2314 [ Filter.Filter_Path Filter.Eq
2315 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2316 , Filter.Filter_Path_Section_Many
2320 (Data.Either.rights $
2322 (Filter.Read.filter_account_path <* P.eof)
2323 () "" ("A::"::Text)])
2325 [ Filter.Filter_Path Filter.Eq
2326 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2327 , Filter.Filter_Path_Section_Many
2328 , Filter.Filter_Path_Section_Many
2332 (Data.Either.rights $
2334 (Filter.Read.filter_account_path <* P.eof)
2335 () "" ("A:B"::Text)])
2337 [ Filter.Filter_Path Filter.Eq
2338 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2339 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "B")
2343 (Data.Either.rights $
2345 (Filter.Read.filter_account_path <* P.eof)
2346 () "" ("A::B"::Text)])
2348 [ Filter.Filter_Path Filter.Eq
2349 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2350 , Filter.Filter_Path_Section_Many
2351 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "B")
2355 (Data.Either.rights $
2357 (Filter.Read.filter_account_path <* P.eof)
2358 () "" ("A:::B"::Text)])
2360 [ Filter.Filter_Path Filter.Eq
2361 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2362 , Filter.Filter_Path_Section_Many
2363 , Filter.Filter_Path_Section_Many
2364 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "B")
2368 (Data.Either.rights $
2370 (Filter.Read.filter_account_path <* P.char ' ' <* P.eof)
2371 () "" ("A: "::Text)])
2373 [ Filter.Filter_Path Filter.Eq
2374 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2375 , Filter.Filter_Path_Section_Many
2379 (Data.Either.rights $
2381 (Filter.Read.filter_account_path <* P.eof)
2382 () "" ("<=A:B"::Text)])
2384 [ Filter.Filter_Path Filter.Le
2385 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2386 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "B")
2390 (Data.Either.rights $
2392 (Filter.Read.filter_account_path <* P.eof)
2393 () "" (">=A:B"::Text)])
2395 [ Filter.Filter_Path Filter.Ge
2396 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2397 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "B")
2401 (Data.Either.rights $
2403 (Filter.Read.filter_account_path <* P.eof)
2404 () "" ("<A:B"::Text)])
2406 [ Filter.Filter_Path Filter.Lt
2407 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2408 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "B")
2412 (Data.Either.rights $
2414 (Filter.Read.filter_account_path <* P.eof)
2415 () "" (">A:B"::Text)])
2417 [ Filter.Filter_Path Filter.Gt
2418 [ Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "A")
2419 , Filter.Filter_Path_Section_Text (Filter.Filter_Text_Exact "B")
2423 , "filter_bool" ~: TestList
2425 (Data.Either.rights $
2427 (Filter.Read.filter_bool
2428 [ P.char 'E' >> return (return $ Filter.Bool True) ]
2430 () "" ("( E )"::Text)])
2432 [ Filter.And (Filter.Bool True) Filter.Any
2435 (Data.Either.rights $
2437 (Filter.Read.filter_bool
2438 [ P.char 'E' >> return (return $ Filter.Bool True) ]
2440 () "" ("( ( E ) )"::Text)])
2442 [ Filter.And (Filter.And (Filter.Bool True) Filter.Any) Filter.Any
2444 , "( E ) & ( E )" ~:
2445 (Data.Either.rights $
2447 (Filter.Read.filter_bool
2448 [ P.char 'E' >> return (return $ Filter.Bool True) ]
2450 () "" ("( E ) & ( E )"::Text)])
2453 (Filter.And (Filter.Bool True) Filter.Any)
2454 (Filter.And (Filter.Bool True) Filter.Any)
2456 , "( E ) + ( E )" ~:
2457 (Data.Either.rights $
2459 (Filter.Read.filter_bool
2460 [ P.char 'E' >> return (return $ Filter.Bool True) ]
2462 () "" ("( E ) + ( E )"::Text)])
2465 (Filter.And (Filter.Bool True) Filter.Any)
2466 (Filter.And (Filter.Bool True) Filter.Any)
2468 , "( E ) - ( E )" ~:
2469 (Data.Either.rights $
2471 (Filter.Read.filter_bool
2472 [ P.char 'E' >> return (return $ Filter.Bool True) ]
2474 () "" ("( E ) - ( E )"::Text)])
2477 (Filter.And (Filter.Bool True) Filter.Any)
2478 (Filter.Not (Filter.And (Filter.Bool True) Filter.Any))
2481 (Data.Either.rights $
2483 (Filter.Read.filter_bool
2484 [ P.char 'E' >> return (return $ Filter.Bool True) ]
2486 () "" ("(- E )"::Text)])
2488 [ Filter.And (Filter.Not (Filter.Bool True)) Filter.Any
2493 , "Balance" ~: TestList
2494 [ "balance" ~: TestList
2495 [ "[A+$1] = A+$1 & $+1" ~:
2497 (Format.Ledger.posting ("A":|[]))
2498 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
2503 { Balance.balance_by_account =
2504 Lib.TreeMap.from_List const $
2505 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2506 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
2507 , Balance.balance_by_unit =
2508 Balance.Balance_by_Unit $
2510 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2512 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
2513 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2518 , "[A+$1, A-$1] = {A+$0, $+0}" ~:
2522 [ (Format.Ledger.posting ("A":|[]))
2523 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
2525 , (Format.Ledger.posting ("A":|[]))
2526 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ]
2531 { Balance.balance_by_account =
2532 Lib.TreeMap.from_List const $
2534 , Balance.Account_Sum $
2535 Data.Map.fromListWith const $
2536 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance s, s))
2542 , Balance.balance_by_unit =
2543 Balance.Balance_by_Unit $
2545 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2547 { Balance.unit_sum_amount = Amount.Sum_Both
2550 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2555 , "[A+$1, A-€1] = {A+$1-€1, $+1 €-1}" ~:
2559 [ (Format.Ledger.posting ("A":|[]))
2560 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
2562 , (Format.Ledger.posting ("A":|[]))
2563 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1 ]
2568 { Balance.balance_by_account =
2569 Lib.TreeMap.from_List const $
2570 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2571 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ -1 ]) ]
2572 , Balance.balance_by_unit =
2573 Balance.Balance_by_Unit $
2575 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2577 { Balance.unit_sum_amount = Amount.Sum_Positive (Amount.usd $ 1)
2578 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2582 { Balance.unit_sum_amount = Amount.Sum_Negative (Amount.eur $ -1)
2583 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2588 , "[A+$1, B-$1] = {A+$1 B-$1, $+0}" ~:
2592 [ (Format.Ledger.posting ("A":|[]))
2593 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
2595 , (Format.Ledger.posting ("B":|[]))
2596 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ]
2601 { Balance.balance_by_account =
2602 Lib.TreeMap.from_List const $
2603 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2604 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2605 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
2607 , Balance.balance_by_unit =
2608 Balance.Balance_by_Unit $
2610 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2612 { Balance.unit_sum_amount = Amount.Sum_Both
2615 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2624 [ (Format.Ledger.posting ("A":|[]))
2625 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
2627 , (Format.Ledger.posting ("B":|[]))
2628 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ]
2633 { Balance.balance_by_account =
2634 Lib.TreeMap.from_List const $
2635 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2636 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2637 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
2639 , Balance.balance_by_unit =
2640 Balance.Balance_by_Unit $
2642 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2644 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 2
2645 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2650 , "[A+$1+€2, A-$1-€2] = {A+$0+€0, $+0 €+0}" ~:
2654 [ (Format.Ledger.posting ("A":|[]))
2655 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2 ]
2657 , (Format.Ledger.posting ("A":|[]))
2658 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2 ]
2663 { Balance.balance_by_account =
2664 Lib.TreeMap.from_List const $
2666 , Balance.Account_Sum $
2667 Data.Map.fromListWith const $
2668 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance s, s))
2669 [ Amount.Sum_Both (Amount.usd $ -1) (Amount.usd $ 1)
2670 , Amount.Sum_Both (Amount.eur $ -2) (Amount.eur $ 2)
2674 , Balance.balance_by_unit =
2675 Balance.Balance_by_Unit $
2677 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2679 { Balance.unit_sum_amount = Amount.Sum_Both (Amount.usd $ -1) (Amount.usd $ 1)
2680 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2684 { Balance.unit_sum_amount = Amount.Sum_Both (Amount.eur $ -2) (Amount.eur $ 2)
2685 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2690 , "[A+$1+€2+£3, B-$1-2€-£3] = {A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~:
2694 [ (Format.Ledger.posting ("A":|[]))
2695 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ]
2697 , (Format.Ledger.posting ("B":|[]))
2698 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ]
2703 { Balance.balance_by_account =
2704 Lib.TreeMap.from_List const $
2705 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2706 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
2707 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
2709 , Balance.balance_by_unit =
2710 Balance.Balance_by_Unit $
2712 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2714 { Balance.unit_sum_amount = Amount.Sum_Both (Amount.usd $ -1) (Amount.usd $ 1)
2715 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2719 { Balance.unit_sum_amount = Amount.Sum_Both (Amount.eur $ -2) (Amount.eur $ 2)
2720 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2724 { Balance.unit_sum_amount = Amount.Sum_Both (Amount.gbp $ -3) (Amount.gbp $ 3)
2725 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2731 , "union" ~: TestList
2732 [ "empty empty = empty" ~:
2733 Balance.union Balance.empty Balance.empty
2735 (Balance.empty::Balance.Balance Amount)
2736 , "{A+$1, $+1} {A+$1, $+1} = {A+$2, $+2}" ~:
2739 { Balance.balance_by_account =
2740 Lib.TreeMap.from_List const $
2741 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2742 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
2743 , Balance.balance_by_unit =
2744 Balance.Balance_by_Unit $
2746 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2748 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
2749 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2755 { Balance.balance_by_account =
2756 Lib.TreeMap.from_List const $
2757 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2758 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
2759 , Balance.balance_by_unit =
2760 Balance.Balance_by_Unit $
2762 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2764 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
2765 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2772 { Balance.balance_by_account =
2773 Lib.TreeMap.from_List const $
2774 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2775 [ ("A":|[], Amount.from_List [ Amount.usd $ 2 ]) ]
2776 , Balance.balance_by_unit =
2777 Balance.Balance_by_Unit $
2779 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2781 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 2
2782 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2787 , "{A+$1, $+1} {B+$1, $+1} = {A+$1 B+$1, $+2}" ~:
2790 { Balance.balance_by_account =
2791 Lib.TreeMap.from_List const $
2792 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2793 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
2794 , Balance.balance_by_unit =
2795 Balance.Balance_by_Unit $
2797 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2799 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
2800 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2806 { Balance.balance_by_account =
2807 Lib.TreeMap.from_List const $
2808 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2809 [ ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
2810 , Balance.balance_by_unit =
2811 Balance.Balance_by_Unit $
2813 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2815 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
2816 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2823 { Balance.balance_by_account =
2824 Lib.TreeMap.from_List const $
2825 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2826 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2827 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
2828 , Balance.balance_by_unit =
2829 Balance.Balance_by_Unit $
2831 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2833 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 2
2834 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2839 , "{A+$1, $+1} {B+€1, €+1} = {A+$1 B+€1, $+1 €+1}" ~:
2842 { Balance.balance_by_account =
2843 Lib.TreeMap.from_List const $
2844 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2845 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ]
2846 , Balance.balance_by_unit =
2847 Balance.Balance_by_Unit $
2849 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2851 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
2852 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2858 { Balance.balance_by_account =
2859 Lib.TreeMap.from_List const $
2860 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2861 [ ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
2862 , Balance.balance_by_unit =
2863 Balance.Balance_by_Unit $
2865 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2867 { Balance.unit_sum_amount = Amount.sum $ Amount.eur $ 1
2868 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2875 { Balance.balance_by_account =
2876 Lib.TreeMap.from_List const $
2877 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2878 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
2879 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ]) ]
2880 , Balance.balance_by_unit =
2881 Balance.Balance_by_Unit $
2883 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
2885 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
2886 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2890 { Balance.unit_sum_amount = Amount.sum $ Amount.eur $ 1
2891 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
2897 , "expanded" ~: TestList
2902 (Lib.TreeMap.empty::Balance.Expanded Amount)
2905 (Lib.TreeMap.from_List const $
2906 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2907 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ]) ])
2909 (Lib.TreeMap.from_List const $
2910 [ ("A":|[], Balance.Account_Sum_Expanded
2911 { Balance.inclusive =
2912 Balance.Account_Sum $
2913 Data.Map.map Amount.sum $
2914 Amount.from_List [ Amount.usd $ 1 ]
2915 , Balance.exclusive =
2916 Balance.Account_Sum $
2917 Data.Map.map Amount.sum $
2918 Amount.from_List [ Amount.usd $ 1 ]
2921 , "A/A+$1 = A+$1 A/A+$1" ~:
2923 (Lib.TreeMap.from_List const $
2924 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2925 [ ("A":|["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
2927 (Lib.TreeMap.from_List const
2928 [ ("A":|[], Balance.Account_Sum_Expanded
2929 { Balance.inclusive =
2930 Balance.Account_Sum $
2931 Data.Map.map Amount.sum $
2932 Amount.from_List [ Amount.usd $ 1 ]
2933 , Balance.exclusive =
2934 Balance.Account_Sum $
2935 Data.Map.map Amount.sum $
2938 , ("A":|["A"], Balance.Account_Sum_Expanded
2939 { Balance.inclusive =
2940 Balance.Account_Sum $
2941 Data.Map.map Amount.sum $
2942 Amount.from_List [ Amount.usd $ 1 ]
2943 , Balance.exclusive =
2944 Balance.Account_Sum $
2945 Data.Map.map Amount.sum $
2946 Amount.from_List [ Amount.usd $ 1 ]
2949 , "A/B+$1 = A+$1 A/B+$1" ~:
2951 (Lib.TreeMap.from_List const $
2952 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2953 [ ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ]) ])
2955 (Lib.TreeMap.from_List const
2956 [ ("A":|[], Balance.Account_Sum_Expanded
2957 { Balance.inclusive =
2958 Balance.Account_Sum $
2959 Data.Map.map Amount.sum $
2960 Amount.from_List [ Amount.usd $ 1 ]
2961 , Balance.exclusive =
2962 Balance.Account_Sum $
2963 Data.Map.map Amount.sum $
2966 , ("A":|["B"], Balance.Account_Sum_Expanded
2967 { Balance.inclusive =
2968 Balance.Account_Sum $
2969 Data.Map.map Amount.sum $
2970 Amount.from_List [ Amount.usd $ 1 ]
2971 , Balance.exclusive =
2972 Balance.Account_Sum $
2973 Data.Map.map Amount.sum $
2974 Amount.from_List [ Amount.usd $ 1 ]
2977 , "A/B/C+$1 = A+$1 A/B+$1 A/B/C+$1" ~:
2979 (Lib.TreeMap.from_List const $
2980 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
2981 [ ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
2983 (Lib.TreeMap.from_List const $
2984 [ ("A":|[], Balance.Account_Sum_Expanded
2985 { Balance.inclusive =
2986 Balance.Account_Sum $
2987 Data.Map.map Amount.sum $
2988 Amount.from_List [ Amount.usd $ 1 ]
2989 , Balance.exclusive =
2990 Balance.Account_Sum $
2991 Data.Map.map Amount.sum $
2994 , ("A":|["B"], Balance.Account_Sum_Expanded
2995 { Balance.inclusive =
2996 Balance.Account_Sum $
2997 Data.Map.map Amount.sum $
2998 Amount.from_List [ Amount.usd $ 1 ]
2999 , Balance.exclusive =
3000 Balance.Account_Sum $
3001 Data.Map.map Amount.sum $
3004 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
3005 { Balance.inclusive =
3006 Balance.Account_Sum $
3007 Data.Map.map Amount.sum $
3008 Amount.from_List [ Amount.usd $ 1 ]
3009 , Balance.exclusive =
3010 Balance.Account_Sum $
3011 Data.Map.map Amount.sum $
3012 Amount.from_List [ Amount.usd $ 1 ]
3015 , "A+$1 A/B+$1 = A+$2 A/B+$1" ~:
3017 (Lib.TreeMap.from_List const $
3018 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3019 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3020 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
3023 (Lib.TreeMap.from_List const
3024 [ ("A":|[], Balance.Account_Sum_Expanded
3025 { Balance.inclusive =
3026 Balance.Account_Sum $
3027 Data.Map.map Amount.sum $
3028 Amount.from_List [ Amount.usd $ 2 ]
3029 , Balance.exclusive =
3030 Balance.Account_Sum $
3031 Data.Map.map Amount.sum $
3032 Amount.from_List [ Amount.usd $ 1 ]
3034 , ("A":|["B"], Balance.Account_Sum_Expanded
3035 { Balance.inclusive =
3036 Balance.Account_Sum $
3037 Data.Map.map Amount.sum $
3038 Amount.from_List [ Amount.usd $ 1 ]
3039 , Balance.exclusive =
3040 Balance.Account_Sum $
3041 Data.Map.map Amount.sum $
3042 Amount.from_List [ Amount.usd $ 1 ]
3045 , "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
3047 (Lib.TreeMap.from_List const $
3048 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3049 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3050 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
3051 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
3054 (Lib.TreeMap.from_List const
3055 [ ("A":|[], Balance.Account_Sum_Expanded
3056 { Balance.inclusive =
3057 Balance.Account_Sum $
3058 Data.Map.map Amount.sum $
3059 Amount.from_List [ Amount.usd $ 3 ]
3060 , Balance.exclusive =
3061 Balance.Account_Sum $
3062 Data.Map.map Amount.sum $
3063 Amount.from_List [ Amount.usd $ 1 ]
3065 , ("A":|["B"], Balance.Account_Sum_Expanded
3066 { Balance.inclusive =
3067 Balance.Account_Sum $
3068 Data.Map.map Amount.sum $
3069 Amount.from_List [ Amount.usd $ 2 ]
3070 , Balance.exclusive =
3071 Balance.Account_Sum $
3072 Data.Map.map Amount.sum $
3073 Amount.from_List [ Amount.usd $ 1 ]
3075 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
3076 { Balance.inclusive =
3077 Balance.Account_Sum $
3078 Data.Map.map Amount.sum $
3079 Amount.from_List [ Amount.usd $ 1 ]
3080 , Balance.exclusive =
3081 Balance.Account_Sum $
3082 Data.Map.map Amount.sum $
3083 Amount.from_List [ Amount.usd $ 1 ]
3086 , "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" ~:
3088 (Lib.TreeMap.from_List const $
3089 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3090 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3091 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
3092 , ("A":|["B", "C"], Amount.from_List [ Amount.usd $ 1 ])
3093 , ("A":|["B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
3096 (Lib.TreeMap.from_List const
3097 [ ("A":|[], Balance.Account_Sum_Expanded
3098 { Balance.inclusive =
3099 Balance.Account_Sum $
3100 Data.Map.map Amount.sum $
3101 Amount.from_List [ Amount.usd $ 4 ]
3102 , Balance.exclusive =
3103 Balance.Account_Sum $
3104 Data.Map.map Amount.sum $
3105 Amount.from_List [ Amount.usd $ 1 ]
3107 , ("A":|["B"], Balance.Account_Sum_Expanded
3108 { Balance.inclusive =
3109 Balance.Account_Sum $
3110 Data.Map.map Amount.sum $
3111 Amount.from_List [ Amount.usd $ 3 ]
3112 , Balance.exclusive =
3113 Balance.Account_Sum $
3114 Data.Map.map Amount.sum $
3115 Amount.from_List [ Amount.usd $ 1 ]
3117 , ("A":|["B", "C"], Balance.Account_Sum_Expanded
3118 { Balance.inclusive =
3119 Balance.Account_Sum $
3120 Data.Map.map Amount.sum $
3121 Amount.from_List [ Amount.usd $ 2 ]
3122 , Balance.exclusive =
3123 Balance.Account_Sum $
3124 Data.Map.map Amount.sum $
3125 Amount.from_List [ Amount.usd $ 1 ]
3127 , ("A":|["B", "C", "D"], Balance.Account_Sum_Expanded
3128 { Balance.inclusive =
3129 Balance.Account_Sum $
3130 Data.Map.map Amount.sum $
3131 Amount.from_List [ Amount.usd $ 1 ]
3132 , Balance.exclusive =
3133 Balance.Account_Sum $
3134 Data.Map.map Amount.sum $
3135 Amount.from_List [ Amount.usd $ 1 ]
3138 , "A+$1 A/B+$1 A/BB+$1 AA/B+$1 = A+$3 A/B+$1 A/BB+$1 AA+$1 AA/B+$1" ~:
3140 (Lib.TreeMap.from_List const $
3141 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3142 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3143 , ("A":|["B"], Amount.from_List [ Amount.usd $ 1 ])
3144 , ("A":|["BB"], Amount.from_List [ Amount.usd $ 1 ])
3145 , ("AA":|["B"], Amount.from_List [ Amount.usd $ 1 ])
3148 (Lib.TreeMap.from_List const
3149 [ ("A":|[], Balance.Account_Sum_Expanded
3150 { Balance.inclusive =
3151 Balance.Account_Sum $
3152 Data.Map.map Amount.sum $
3153 Amount.from_List [ Amount.usd $ 3 ]
3154 , Balance.exclusive =
3155 Balance.Account_Sum $
3156 Data.Map.map Amount.sum $
3157 Amount.from_List [ Amount.usd $ 1 ]
3159 , ("A":|["B"], Balance.Account_Sum_Expanded
3160 { Balance.inclusive =
3161 Balance.Account_Sum $
3162 Data.Map.map Amount.sum $
3163 Amount.from_List [ Amount.usd $ 1 ]
3164 , Balance.exclusive =
3165 Balance.Account_Sum $
3166 Data.Map.map Amount.sum $
3167 Amount.from_List [ Amount.usd $ 1 ]
3169 , ("A":|["BB"], Balance.Account_Sum_Expanded
3170 { Balance.inclusive =
3171 Balance.Account_Sum $
3172 Data.Map.map Amount.sum $
3173 Amount.from_List [ Amount.usd $ 1 ]
3174 , Balance.exclusive =
3175 Balance.Account_Sum $
3176 Data.Map.map Amount.sum $
3177 Amount.from_List [ Amount.usd $ 1 ]
3179 , ("AA":|[], Balance.Account_Sum_Expanded
3180 { Balance.inclusive =
3181 Balance.Account_Sum $
3182 Data.Map.map Amount.sum $
3183 Amount.from_List [ Amount.usd $ 1 ]
3184 , Balance.exclusive =
3185 Balance.Account_Sum $
3186 Data.Map.map Amount.sum $
3189 , ("AA":|["B"], Balance.Account_Sum_Expanded
3190 { Balance.inclusive =
3191 Balance.Account_Sum $
3192 Data.Map.map Amount.sum $
3193 Amount.from_List [ Amount.usd $ 1 ]
3194 , Balance.exclusive =
3195 Balance.Account_Sum $
3196 Data.Map.map Amount.sum $
3197 Amount.from_List [ Amount.usd $ 1 ]
3201 , "deviation" ~: TestList
3203 (Balance.deviation $
3205 { Balance.balance_by_account =
3206 Lib.TreeMap.from_List const $
3207 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3208 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3209 , ("B":|[], Amount.from_List [])
3211 , Balance.balance_by_unit =
3212 Balance.Balance_by_Unit $
3214 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3216 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
3217 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3223 (Balance.Deviation $
3224 Balance.Balance_by_Unit $
3226 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3228 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
3229 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3233 , "{A+$1 B+$1, $2}" ~:
3234 (Balance.deviation $
3236 { Balance.balance_by_account =
3237 Lib.TreeMap.from_List const $
3238 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3239 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3240 , ("B":|[], Amount.from_List [ Amount.usd $ 1 ])
3242 , Balance.balance_by_unit =
3243 Balance.Balance_by_Unit $
3245 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3247 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 2
3248 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3256 (Balance.Deviation $
3257 Balance.Balance_by_Unit $
3259 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3261 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 2
3262 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3268 , "is_equilibrium_inferrable" ~: TestList
3269 [ "nil" ~: TestCase $
3271 Balance.is_equilibrium_inferrable $
3273 (Balance.empty::Balance.Balance Amount.Amount)
3274 , "{A+$0, $+0}" ~: TestCase $
3276 Balance.is_equilibrium_inferrable $
3279 { Balance.balance_by_account =
3280 Lib.TreeMap.from_List const $
3281 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3282 [ ("A":|[], Amount.from_List [ Amount.usd $ 0 ])
3284 , Balance.balance_by_unit =
3285 Balance.Balance_by_Unit $
3287 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3289 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 0
3290 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3295 , "{A+$1, $+1}" ~: TestCase $
3297 Balance.is_equilibrium_inferrable $
3300 { Balance.balance_by_account =
3301 Lib.TreeMap.from_List const $
3302 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3303 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3305 , Balance.balance_by_unit =
3306 Balance.Balance_by_Unit $
3308 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3310 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
3311 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3316 , "{A+$0+€0, $0 €+0}" ~: TestCase $
3318 Balance.is_equilibrium_inferrable $
3321 { Balance.balance_by_account =
3322 Lib.TreeMap.from_List const $
3323 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3324 [ ("A":|[], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
3326 , Balance.balance_by_unit =
3327 Balance.Balance_by_Unit $
3329 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3331 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 0
3332 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3336 { Balance.unit_sum_amount = Amount.sum $ Amount.eur $ 0
3337 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3342 , "{A+$1, B-$1, $+0}" ~: TestCase $
3344 Balance.is_equilibrium_inferrable $
3347 { Balance.balance_by_account =
3348 Lib.TreeMap.from_List const $
3349 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3350 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3351 , ("B":|[], Amount.from_List [ Amount.usd $ -1 ])
3353 , Balance.balance_by_unit =
3354 Balance.Balance_by_Unit $
3356 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3358 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 0
3359 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3364 , "{A+$1 B, $+1}" ~: TestCase $
3366 Balance.is_equilibrium_inferrable $
3369 { Balance.balance_by_account =
3370 Lib.TreeMap.from_List const $
3371 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3372 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3373 , ("B":|[], Amount.from_List [])
3375 , Balance.balance_by_unit =
3376 Balance.Balance_by_Unit $
3378 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3380 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
3381 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3386 , "{A+$1 B+€1, $+1 €+1}" ~: TestCase $
3388 Balance.is_equilibrium_inferrable $
3391 { Balance.balance_by_account =
3392 Lib.TreeMap.from_List const $
3393 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3394 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3395 , ("B":|[], Amount.from_List [ Amount.eur $ 1 ])
3397 , Balance.balance_by_unit =
3398 Balance.Balance_by_Unit $
3400 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3402 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 1
3403 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3407 { Balance.unit_sum_amount = Amount.sum $ Amount.eur $ 1
3408 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3413 , "{A+$1 B-$1+€1, $+0 €+1}" ~: TestCase $
3415 Balance.is_equilibrium_inferrable $
3418 { Balance.balance_by_account =
3419 Lib.TreeMap.from_List const $
3420 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3421 [ ("A":|[], Amount.from_List [ Amount.usd $ 1 ])
3422 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ 1 ])
3424 , Balance.balance_by_unit =
3425 Balance.Balance_by_Unit $
3427 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3429 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 0
3430 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3434 { Balance.unit_sum_amount = Amount.sum $ Amount.eur $ 1
3435 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3440 , "{A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~: TestCase $
3442 Balance.is_equilibrium_inferrable $
3445 { Balance.balance_by_account =
3446 Lib.TreeMap.from_List const $
3447 Data.List.map (id *** Balance.Account_Sum . Data.Map.map Amount.sum) $
3448 [ ("A":|[], Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ])
3449 , ("B":|[], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
3451 , Balance.balance_by_unit =
3452 Balance.Balance_by_Unit $
3454 Data.List.map (\s -> (Amount.unit $ Amount.sum_balance $ Balance.unit_sum_amount s, s))
3456 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 0
3457 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3461 { Balance.unit_sum_amount = Amount.sum $ Amount.eur $ 0
3462 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3466 { Balance.unit_sum_amount = Amount.sum $ Amount.gbp $ 0
3467 , Balance.unit_sum_accounts = Data.Map.fromList $ Data.List.map (,())
3473 , "infer_equilibrium" ~: TestList
3475 (snd $ Balance.infer_equilibrium $
3476 Format.Ledger.posting_by_Account
3477 [ (Format.Ledger.posting ("A":|[]))
3478 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
3479 , (Format.Ledger.posting ("B":|[]))
3480 { Format.Ledger.posting_amounts=Amount.from_List [] }
3484 Format.Ledger.posting_by_Account
3485 [ (Format.Ledger.posting ("A":|[]))
3486 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
3487 , (Format.Ledger.posting ("B":|[]))
3488 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1 ] }
3491 (snd $ Balance.infer_equilibrium $
3492 Format.Ledger.posting_by_Account
3493 [ (Format.Ledger.posting ("A":|[]))
3494 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
3495 , (Format.Ledger.posting ("B":|[]))
3496 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1 ] }
3500 Format.Ledger.posting_by_Account
3501 [ (Format.Ledger.posting ("A":|[]))
3502 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 1] }
3503 , (Format.Ledger.posting ("B":|[]))
3504 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.eur $ -1, Amount.usd $ -1 ] }
3507 (snd $ Balance.infer_equilibrium $
3508 Format.Ledger.posting_by_Account
3509 [ (Format.Ledger.posting ("A":|[]))
3510 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
3511 , (Format.Ledger.posting ("B":|[]))
3512 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
3517 { Balance.unit_sum_amount = Amount.sum $ Amount.usd $ 2
3518 , Balance.unit_sum_accounts = Data.Map.fromList []}
3520 , "{A+$1 B-$1 B-1€}" ~:
3521 (snd $ Balance.infer_equilibrium $
3522 Format.Ledger.posting_by_Account
3523 [ (Format.Ledger.posting ("A":|[]))
3524 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1 ] }
3525 , (Format.Ledger.posting ("B":|[]))
3526 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -1 ] }
3530 Format.Ledger.posting_by_Account
3531 [ (Format.Ledger.posting ("A":|[]))
3532 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 1 ] }
3533 , (Format.Ledger.posting ("B":|[]))
3534 { Format.Ledger.posting_amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -1 ] }
3538 , "Format" ~: TestList
3539 [ "Ledger" ~: TestList
3540 [ "Read" ~: TestList
3541 [ "posting_type" ~: TestList
3543 Format.Ledger.Read.posting_type
3546 (Posting.Posting_Type_Regular, "A":|[])
3548 Format.Ledger.Read.posting_type
3551 (Posting.Posting_Type_Regular, "(":|[])
3553 Format.Ledger.Read.posting_type
3556 (Posting.Posting_Type_Regular, ")":|[])
3558 Format.Ledger.Read.posting_type
3561 (Posting.Posting_Type_Regular, "()":|[])
3563 Format.Ledger.Read.posting_type
3566 (Posting.Posting_Type_Regular, "( )":|[])
3568 Format.Ledger.Read.posting_type
3571 (Posting.Posting_Type_Virtual, "A":|[])
3573 Format.Ledger.Read.posting_type
3576 (Posting.Posting_Type_Virtual, "A":|["B", "C"])
3578 Format.Ledger.Read.posting_type
3581 (Posting.Posting_Type_Regular, "A":|["B", "C"])
3583 Format.Ledger.Read.posting_type
3586 (Posting.Posting_Type_Regular, "(A)":|["B", "C"])
3588 Format.Ledger.Read.posting_type
3591 (Posting.Posting_Type_Regular, "A":|["(B)", "C"])
3593 Format.Ledger.Read.posting_type
3596 (Posting.Posting_Type_Regular, "A":|["B", "(C)"])
3598 Format.Ledger.Read.posting_type
3601 (Posting.Posting_Type_Regular, "[":|[])
3603 Format.Ledger.Read.posting_type
3606 (Posting.Posting_Type_Regular, "]":|[])
3608 Format.Ledger.Read.posting_type
3611 (Posting.Posting_Type_Regular, "[]":|[])
3613 Format.Ledger.Read.posting_type
3616 (Posting.Posting_Type_Regular, "[ ]":|[])
3618 Format.Ledger.Read.posting_type
3621 (Posting.Posting_Type_Virtual_Balanced, "A":|[])
3623 Format.Ledger.Read.posting_type
3626 (Posting.Posting_Type_Virtual_Balanced, "A":|["B", "C"])
3628 Format.Ledger.Read.posting_type
3631 (Posting.Posting_Type_Regular, "A":|["B", "C"])
3633 Format.Ledger.Read.posting_type
3636 (Posting.Posting_Type_Regular, "[A]":|["B", "C"])
3638 Format.Ledger.Read.posting_type
3641 (Posting.Posting_Type_Regular, "A":|["[B]", "C"])
3643 Format.Ledger.Read.posting_type
3646 (Posting.Posting_Type_Regular, "A":|["B", "[C]"])
3648 , "comment" ~: TestList
3649 [ "; some comment = Right \" some comment\"" ~:
3650 (Data.Either.rights $
3652 (Format.Ledger.Read.comment <* P.eof)
3653 () "" ("; some comment"::Text)])
3656 , "; some comment \\n = Right \" some comment \"" ~:
3657 (Data.Either.rights $
3659 (Format.Ledger.Read.comment <* P.newline <* P.eof)
3660 () "" ("; some comment \n"::Text)])
3662 [ " some comment " ]
3663 , "; some comment \\r\\n = Right \" some comment \"" ~:
3664 (Data.Either.rights $
3666 (Format.Ledger.Read.comment <* P.string "\r\n" <* P.eof)
3667 () "" ("; some comment \r\n"::Text)])
3669 [ " some comment " ]
3671 , "comments" ~: TestList
3672 [ "; some comment\\n ; some other comment = Right [\" some comment\", \" some other comment\"]" ~:
3673 (Data.Either.rights $
3675 (Format.Ledger.Read.comments <* P.eof)
3676 () "" ("; some comment\n ; some other comment"::Text)])
3678 [ [" some comment", " some other comment"] ]
3679 , "; some comment \\n = Right \" some comment \"" ~:
3680 (Data.Either.rights $
3682 (Format.Ledger.Read.comments <* P.string "\n" <* P.eof)
3683 () "" ("; some comment \n"::Text)])
3685 [ [" some comment "] ]
3687 , "tag_value" ~: TestList
3689 (Data.Either.rights $
3691 (Format.Ledger.Read.tag_value <* P.eof)
3696 (Data.Either.rights $
3698 (Format.Ledger.Read.tag_value <* P.char '\n' <* P.eof)
3699 () "" (",\n"::Text)])
3703 (Data.Either.rights $
3705 (Format.Ledger.Read.tag_value <* P.eof)
3706 () "" (",x"::Text)])
3710 (Data.Either.rights $
3712 (Format.Ledger.Read.tag_value <* P.string ",x:" <* P.eof)
3713 () "" (",x:"::Text)])
3717 (Data.Either.rights $
3719 (Format.Ledger.Read.tag_value <* P.string ", n:" <* P.eof)
3720 () "" ("v, v, n:"::Text)])
3726 (Data.Either.rights $
3728 (Format.Ledger.Read.tag <* P.eof)
3729 () "" ("Name:"::Text)])
3733 (Data.Either.rights $
3735 (Format.Ledger.Read.tag <* P.eof)
3736 () "" ("Name:Value"::Text)])
3738 [("Name":|[], "Value")]
3739 , "Name:Value\\n" ~:
3740 (Data.Either.rights $
3742 (Format.Ledger.Read.tag <* P.string "\n" <* P.eof)
3743 () "" ("Name:Value\n"::Text)])
3745 [("Name":|[], "Value")]
3747 (Data.Either.rights $
3749 (Format.Ledger.Read.tag <* P.eof)
3750 () "" ("Name:Val ue"::Text)])
3752 [("Name":|[], "Val ue")]
3754 (Data.Either.rights $
3756 (Format.Ledger.Read.tag <* P.eof)
3757 () "" ("Name:,"::Text)])
3761 (Data.Either.rights $
3763 (Format.Ledger.Read.tag <* P.eof)
3764 () "" ("Name:Val,ue"::Text)])
3766 [("Name":|[], "Val,ue")]
3768 (Data.Either.rights $
3770 (Format.Ledger.Read.tag <* P.string ",ue:" <* P.eof)
3771 () "" ("Name:Val,ue:"::Text)])
3773 [("Name":|[], "Val")]
3774 , "Name:Val,ue :" ~:
3775 (Data.Either.rights $
3777 (Format.Ledger.Read.tag <* P.eof)
3778 () "" ("Name:Val,ue :"::Text)])
3780 [("Name":|[], "Val,ue :")]
3782 , "tags" ~: TestList
3784 (Data.Either.rights $
3786 (Format.Ledger.Read.tags <* P.eof)
3787 () "" ("Name:"::Text)])
3790 [ ("Name":|[], [""])
3794 (Data.Either.rights $
3796 (Format.Ledger.Read.tags <* P.eof)
3797 () "" ("Name:,"::Text)])
3800 [ ("Name":|[], [","])
3804 (Data.Either.rights $
3806 (Format.Ledger.Read.tags <* P.eof)
3807 () "" ("Name:,Name:"::Text)])
3810 [ ("Name":|[], ["", ""])
3814 (Data.Either.rights $
3816 (Format.Ledger.Read.tags <* P.eof)
3817 () "" ("Name:,Name2:"::Text)])
3820 [ ("Name":|[], [""])
3821 , ("Name2":|[], [""])
3824 , "Name: , Name2:" ~:
3825 (Data.Either.rights $
3827 (Format.Ledger.Read.tags <* P.eof)
3828 () "" ("Name: , Name2:"::Text)])
3831 [ ("Name":|[], [" "])
3832 , ("Name2":|[], [""])
3835 , "Name:,Name2:,Name3:" ~:
3836 (Data.Either.rights $
3838 (Format.Ledger.Read.tags <* P.eof)
3839 () "" ("Name:,Name2:,Name3:"::Text)])
3842 [ ("Name":|[], [""])
3843 , ("Name2":|[], [""])
3844 , ("Name3":|[], [""])
3847 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ~:
3848 (Data.Either.rights $
3850 (Format.Ledger.Read.tags <* P.eof)
3851 () "" ("Name:Val ue,Name2:V a l u e,Name3:V al ue"::Text)])
3854 [ ("Name":|[], ["Val ue"])
3855 , ("Name2":|[], ["V a l u e"])
3856 , ("Name3":|[], ["V al ue"])
3860 , "posting" ~: TestList
3861 [ " A:B:C = Right A:B:C" ~:
3862 (Data.Either.rights $
3863 [P.runParser_with_Error
3864 (Format.Ledger.Read.posting <* P.eof)
3865 ( Format.Ledger.Read.context () Format.Ledger.journal
3866 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
3867 "" (" A:B:C"::Text)])
3869 [ ( Posting.Posting_Type_Regular
3870 , (Format.Ledger.posting ("A":|["B", "C"]))
3871 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3875 , " !A:B:C = Right !A:B:C" ~:
3876 (Data.List.map snd $
3877 Data.Either.rights $
3878 [P.runParser_with_Error
3879 (Format.Ledger.Read.posting <* P.eof)
3880 ( Format.Ledger.Read.context () Format.Ledger.journal
3881 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
3882 "" (" !A:B:C"::Text)])
3884 [ (Format.Ledger.posting ("A":|["B", "C"]))
3885 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3886 , Format.Ledger.posting_status = True
3889 , " *A:B:C = Right *A:B:C" ~:
3890 (Data.List.map snd $
3891 Data.Either.rights $
3892 [P.runParser_with_Error
3893 (Format.Ledger.Read.posting <* P.eof)
3894 ( Format.Ledger.Read.context () Format.Ledger.journal
3895 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
3896 "" (" *A:B:C"::Text)])
3898 [ (Format.Ledger.posting ("A":|["B", "C"]))
3899 { Format.Ledger.posting_amounts = Data.Map.fromList []
3900 , Format.Ledger.posting_comments = []
3901 , Format.Ledger.posting_dates = []
3902 , Format.Ledger.posting_status = True
3903 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3904 , Format.Ledger.posting_tags = mempty
3907 , " A:B:C $1 = Right A:B:C $1" ~:
3908 (Data.List.map snd $
3909 Data.Either.rights $
3910 [P.runParser_with_Error
3911 (Format.Ledger.Read.posting <* P.eof)
3912 ( Format.Ledger.Read.context () Format.Ledger.journal
3913 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
3914 "" (" A:B:C $1"::Text)])
3916 [ (Format.Ledger.posting ("A":|["B","C $1"]))
3917 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3920 , " A:B:C $1 = Right A:B:C $1" ~:
3921 (Data.List.map snd $
3922 Data.Either.rights $
3923 [P.runParser_with_Error
3924 (Format.Ledger.Read.posting <* P.eof)
3925 ( Format.Ledger.Read.context () Format.Ledger.journal
3926 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
3927 "" (" A:B:C $1"::Text)])
3929 [ (Format.Ledger.posting ("A":|["B", "C"]))
3930 { Format.Ledger.posting_amounts = Data.Map.fromList
3932 { Amount.quantity = 1
3933 , Amount.style = Amount.Style.nil
3934 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3935 , Amount.Style.unit_spaced = Just False
3940 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3943 , " A:B:C $1 + 1€ = Right A:B:C $1 + 1€" ~:
3944 (Data.List.map snd $
3945 Data.Either.rights $
3946 [P.runParser_with_Error
3947 (Format.Ledger.Read.posting <* P.eof)
3948 ( Format.Ledger.Read.context () Format.Ledger.journal
3949 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
3950 "" (" A:B:C $1 + 1€"::Text)])
3952 [ (Format.Ledger.posting ("A":|["B", "C"]))
3953 { Format.Ledger.posting_amounts = Data.Map.fromList
3955 { Amount.quantity = 1
3956 , Amount.style = Amount.Style.nil
3957 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3958 , Amount.Style.unit_spaced = Just False
3963 { Amount.quantity = 1
3964 , Amount.style = Amount.Style.nil
3965 { Amount.Style.unit_side = Just Amount.Style.Side_Right
3966 , Amount.Style.unit_spaced = Just False
3971 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3974 , " A:B:C $1 + 1$ = Right A:B:C $2" ~:
3975 (Data.List.map snd $
3976 Data.Either.rights $
3977 [P.runParser_with_Error
3978 (Format.Ledger.Read.posting <* P.eof)
3979 ( Format.Ledger.Read.context () Format.Ledger.journal
3980 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
3981 "" (" A:B:C $1 + 1$"::Text)])
3983 [ (Format.Ledger.posting ("A":|["B", "C"]))
3984 { Format.Ledger.posting_amounts = Data.Map.fromList
3986 { Amount.quantity = 2
3987 , Amount.style = Amount.Style.nil
3988 { Amount.Style.unit_side = Just Amount.Style.Side_Left
3989 , Amount.Style.unit_spaced = Just False
3994 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
3997 , " A:B:C $1 + 1$ + 1$ = Right A:B:C $3" ~:
3998 (Data.List.map snd $
3999 Data.Either.rights $
4000 [P.runParser_with_Error
4001 (Format.Ledger.Read.posting <* P.eof)
4002 ( Format.Ledger.Read.context () Format.Ledger.journal
4003 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4004 "" (" A:B:C $1 + 1$ + 1$"::Text)])
4006 [ (Format.Ledger.posting ("A":|["B", "C"]))
4007 { Format.Ledger.posting_amounts = Data.Map.fromList
4009 { Amount.quantity = 3
4010 , Amount.style = Amount.Style.nil
4011 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4012 , Amount.Style.unit_spaced = Just False
4017 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4020 , " A:B:C ; some comment = Right A:B:C ; some comment" ~:
4021 (Data.List.map snd $
4022 Data.Either.rights $
4023 [P.runParser_with_Error
4024 (Format.Ledger.Read.posting <* P.eof)
4025 ( Format.Ledger.Read.context () Format.Ledger.journal
4026 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4027 "" (" A:B:C ; some comment"::Text)])
4029 [ (Format.Ledger.posting ("A":|["B", "C"]))
4030 { Format.Ledger.posting_amounts = Data.Map.fromList []
4031 , Format.Ledger.posting_comments = [" some comment"]
4032 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4035 , " A:B:C ; some comment\\n ; some other comment = Right A:B:C ; some comment\\n ; some other comment" ~:
4036 (Data.List.map snd $
4037 Data.Either.rights $
4038 [P.runParser_with_Error
4039 (Format.Ledger.Read.posting <* P.eof)
4040 ( Format.Ledger.Read.context () Format.Ledger.journal
4041 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4042 "" (" A:B:C ; some comment\n ; some other comment"::Text)])
4044 [ (Format.Ledger.posting ("A":|["B", "C"]))
4045 { Format.Ledger.posting_amounts = Data.Map.fromList []
4046 , Format.Ledger.posting_comments = [" some comment", " some other comment"]
4047 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4050 , " A:B:C $1 ; some comment = Right A:B:C $1 ; some comment" ~:
4051 (Data.List.map snd $
4052 Data.Either.rights $
4053 [P.runParser_with_Error
4054 (Format.Ledger.Read.posting)
4055 ( Format.Ledger.Read.context () Format.Ledger.journal
4056 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4057 "" (" A:B:C $1 ; some comment"::Text)])
4059 [ (Format.Ledger.posting ("A":|["B", "C"]))
4060 { Format.Ledger.posting_amounts = Data.Map.fromList
4062 { Amount.quantity = 1
4063 , Amount.style = Amount.Style.nil
4064 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4065 , Amount.Style.unit_spaced = Just False
4070 , Format.Ledger.posting_comments = [" some comment"]
4071 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4074 , " A:B:C ; N:V = Right A:B:C ; N:V" ~:
4075 (Data.List.map snd $
4076 Data.Either.rights $
4077 [P.runParser_with_Error
4078 (Format.Ledger.Read.posting <* P.eof)
4079 ( Format.Ledger.Read.context () Format.Ledger.journal
4080 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4081 "" (" A:B:C ; N:V"::Text)])
4083 [ (Format.Ledger.posting ("A":|["B", "C"]))
4084 { Format.Ledger.posting_comments = [" N:V"]
4085 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4086 , Format.Ledger.posting_tags = Tag.from_List
4091 , " A:B:C ; some comment N:V = Right A:B:C ; some comment N:V" ~:
4092 (Data.List.map snd $
4093 Data.Either.rights $
4094 [P.runParser_with_Error
4095 (Format.Ledger.Read.posting <* P.eof)
4096 ( Format.Ledger.Read.context () Format.Ledger.journal
4097 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4098 "" (" A:B:C ; some comment N:V"::Text)])
4100 [ (Format.Ledger.posting ("A":|["B", "C"]))
4101 { Format.Ledger.posting_comments = [" some comment N:V"]
4102 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4103 , Format.Ledger.posting_tags = Tag.from_List
4108 , " A:B:C ; some comment N:V v, N2:V2 v2 = Right A:B:C ; some comment N:V v, N2:V2 v2" ~:
4109 (Data.List.map snd $
4110 Data.Either.rights $
4111 [P.runParser_with_Error
4112 (Format.Ledger.Read.posting )
4113 ( Format.Ledger.Read.context () Format.Ledger.journal
4114 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4115 "" (" A:B:C ; some comment N:V v, N2:V2 v2"::Text)])
4117 [ (Format.Ledger.posting ("A":|["B", "C"]))
4118 { Format.Ledger.posting_comments = [" some comment N:V v, N2:V2 v2"]
4119 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4120 , Format.Ledger.posting_tags = Tag.from_List
4122 , ("N2":|[], "V2 v2")
4126 , " A:B:C ; N:V\\n ; N:V2 = Right A:B:C ; N:V\\n ; N:V2" ~:
4127 (Data.List.map snd $
4128 Data.Either.rights $
4129 [P.runParser_with_Error
4130 (Format.Ledger.Read.posting <* P.eof)
4131 ( Format.Ledger.Read.context () Format.Ledger.journal
4132 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4133 "" (" A:B:C ; N:V\n ; N:V2"::Text)])
4135 [ (Format.Ledger.posting ("A":|["B", "C"]))
4136 { Format.Ledger.posting_comments = [" N:V", " N:V2"]
4137 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4138 , Format.Ledger.posting_tags = Tag.from_List
4144 , " A:B:C ; N:V\\n ; N2:V = Right A:B:C ; N:V\\n ; N2:V" ~:
4145 (Data.List.map snd $
4146 Data.Either.rights $
4147 [P.runParser_with_Error
4148 (Format.Ledger.Read.posting <* P.eof)
4149 ( Format.Ledger.Read.context () Format.Ledger.journal
4150 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4151 "" (" A:B:C ; N:V\n ; N2:V"::Text)])
4153 [ (Format.Ledger.posting ("A":|["B", "C"]))
4154 { Format.Ledger.posting_comments = [" N:V", " N2:V"]
4155 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4156 , Format.Ledger.posting_tags = Tag.from_List
4162 , " A:B:C ; date:2001/01/01 = Right A:B:C ; date:2001/01/01" ~:
4163 (Data.List.map snd $
4164 Data.Either.rights $
4165 [P.runParser_with_Error
4166 (Format.Ledger.Read.posting <* P.eof)
4167 ( Format.Ledger.Read.context () Format.Ledger.journal
4168 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4169 "" (" A:B:C ; date:2001/01/01"::Text)])
4171 [ (Format.Ledger.posting ("A":|["B", "C"]))
4172 { Format.Ledger.posting_comments = [" date:2001/01/01"]
4173 , Format.Ledger.posting_dates =
4174 [ Time.zonedTimeToUTC $
4177 (Time.fromGregorian 2001 01 01)
4178 (Time.TimeOfDay 0 0 0))
4181 , Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4182 , Format.Ledger.posting_tags = Tag.from_List
4183 [ ("date":|[], "2001/01/01")
4187 , " (A:B:C) = Right (A:B:C)" ~:
4188 (Data.Either.rights $
4189 [P.runParser_with_Error
4190 (Format.Ledger.Read.posting <* P.eof)
4191 ( Format.Ledger.Read.context () Format.Ledger.journal
4192 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4193 "" (" (A:B:C)"::Text)])
4195 [ ( Posting.Posting_Type_Virtual
4196 , (Format.Ledger.posting ("A":|["B", "C"]))
4197 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4201 , " [A:B:C] = Right [A:B:C]" ~:
4202 (Data.Either.rights $
4203 [P.runParser_with_Error
4204 (Format.Ledger.Read.posting <* P.eof)
4205 ( Format.Ledger.Read.context () Format.Ledger.journal
4206 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4207 "" (" [A:B:C]"::Text)])
4209 [ ( Posting.Posting_Type_Virtual_Balanced
4210 , (Format.Ledger.posting ("A":|["B", "C"]))
4211 { Format.Ledger.posting_sourcepos = P.newPos "" 1 1
4216 , "transaction" ~: TestList
4217 [ "2000/01/01 some description\\n A:B:C $1\\n a:b:c" ~:
4218 (Data.Either.rights $
4219 [P.runParser_with_Error
4220 (Format.Ledger.Read.transaction <* P.eof)
4221 ( Format.Ledger.Read.context () Format.Ledger.journal
4222 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4223 "" ("2000/01/01 some description\n A:B:C $1\n a:b:c"::Text)])
4225 [ Format.Ledger.transaction
4226 { Format.Ledger.transaction_dates=
4227 ( Time.zonedTimeToUTC $
4230 (Time.fromGregorian 2000 01 01)
4231 (Time.TimeOfDay 0 0 0))
4234 , Format.Ledger.transaction_description="some description"
4235 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
4236 [ (Format.Ledger.posting ("A":|["B", "C"]))
4237 { Format.Ledger.posting_amounts = Data.Map.fromList
4239 { Amount.quantity = 1
4240 , Amount.style = Amount.Style.nil
4241 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4242 , Amount.Style.unit_spaced = Just False
4247 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
4249 , (Format.Ledger.posting ("a":|["b", "c"]))
4250 { Format.Ledger.posting_amounts = Data.Map.fromList
4252 { Amount.quantity = -1
4253 , Amount.style = Amount.Style.nil
4254 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4255 , Amount.Style.unit_spaced = Just False
4260 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
4263 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
4266 , "2000/01/01 some description\\n A:B:C $1\\n a:b:c\\n" ~:
4267 (Data.Either.rights $
4268 [P.runParser_with_Error
4269 (Format.Ledger.Read.transaction <* P.newline <* P.eof)
4270 ( Format.Ledger.Read.context () Format.Ledger.journal
4271 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4272 "" ("2000/01/01 some description\n A:B:C $1\n a:b:c\n"::Text)])
4274 [ Format.Ledger.transaction
4275 { Format.Ledger.transaction_dates=
4276 ( Time.zonedTimeToUTC $
4279 (Time.fromGregorian 2000 01 01)
4280 (Time.TimeOfDay 0 0 0))
4283 , Format.Ledger.transaction_description="some description"
4284 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
4285 [ (Format.Ledger.posting ("A":|["B", "C"]))
4286 { Format.Ledger.posting_amounts = Data.Map.fromList
4288 { Amount.quantity = 1
4289 , Amount.style = Amount.Style.nil
4290 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4291 , Amount.Style.unit_spaced = Just False
4296 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
4298 , (Format.Ledger.posting ("a":|["b", "c"]))
4299 { Format.Ledger.posting_amounts = Data.Map.fromList
4301 { Amount.quantity = -1
4302 , Amount.style = Amount.Style.nil
4303 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4304 , Amount.Style.unit_spaced = Just False
4309 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
4312 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
4315 , "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" ~:
4316 (Data.Either.rights $
4317 [P.runParser_with_Error
4318 (Format.Ledger.Read.transaction <* P.eof)
4319 ( Format.Ledger.Read.context () Format.Ledger.journal
4320 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4321 "" ("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)])
4323 [ Format.Ledger.transaction
4324 { Format.Ledger.transaction_comments_after =
4326 , " some other;comment"
4328 , " some last comment"
4330 , Format.Ledger.transaction_dates=
4331 ( Time.zonedTimeToUTC $
4334 (Time.fromGregorian 2000 01 01)
4335 (Time.TimeOfDay 0 0 0))
4338 , Format.Ledger.transaction_description="some description"
4339 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
4340 [ (Format.Ledger.posting ("A":|["B", "C"]))
4341 { Format.Ledger.posting_amounts = Data.Map.fromList
4343 { Amount.quantity = 1
4344 , Amount.style = Amount.Style.nil
4345 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4346 , Amount.Style.unit_spaced = Just False
4351 , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
4353 , (Format.Ledger.posting ("a":|["b", "c"]))
4354 { Format.Ledger.posting_amounts = Data.Map.fromList
4356 { Amount.quantity = -1
4357 , Amount.style = Amount.Style.nil
4358 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4359 , Amount.Style.unit_spaced = Just False
4364 , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
4367 , Format.Ledger.transaction_tags = Tag.from_List
4370 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
4374 , "journal" ~: TestList
4375 [ "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
4377 P.runParserT_with_Error
4378 (Format.Ledger.Read.journal "" {-<* P.eof-})
4379 ( Format.Ledger.Read.context () Format.Ledger.journal
4380 ::Format.Ledger.Read.Context () [] Format.Ledger.Transaction)
4381 "" ("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)
4383 (\j -> j{Format.Ledger.journal_last_read_time=Date.nil}) $
4384 Data.Either.rights [jnl])
4386 [ Format.Ledger.journal
4387 { Format.Ledger.journal_sections =
4389 [ Format.Ledger.transaction
4390 { Format.Ledger.transaction_dates=
4391 ( Time.zonedTimeToUTC $
4394 (Time.fromGregorian 2000 01 02)
4395 (Time.TimeOfDay 0 0 0))
4398 , Format.Ledger.transaction_description="2° description"
4399 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
4400 [ (Format.Ledger.posting ("A":|["B", "C"]))
4401 { Format.Ledger.posting_amounts = Data.Map.fromList
4403 { Amount.quantity = 1
4404 , Amount.style = Amount.Style.nil
4405 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4406 , Amount.Style.unit_spaced = Just False
4411 , Format.Ledger.posting_sourcepos = P.newPos "" 5 1
4413 , (Format.Ledger.posting ("x":|["y", "z"]))
4414 { Format.Ledger.posting_amounts = Data.Map.fromList
4416 { Amount.quantity = -1
4417 , Amount.style = Amount.Style.nil
4418 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4419 , Amount.Style.unit_spaced = Just False
4424 , Format.Ledger.posting_sourcepos = P.newPos "" 6 1
4427 , Format.Ledger.transaction_sourcepos = P.newPos "" 4 1
4429 , Format.Ledger.transaction
4430 { Format.Ledger.transaction_dates=
4431 ( Time.zonedTimeToUTC $
4434 (Time.fromGregorian 2000 01 01)
4435 (Time.TimeOfDay 0 0 0))
4438 , Format.Ledger.transaction_description="1° description"
4439 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
4440 [ (Format.Ledger.posting ("A":|["B", "C"]))
4441 { Format.Ledger.posting_amounts = Data.Map.fromList
4443 { Amount.quantity = 1
4444 , Amount.style = Amount.Style.nil
4445 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4446 , Amount.Style.unit_spaced = Just False
4451 , Format.Ledger.posting_sourcepos = P.newPos "" 2 1
4453 , (Format.Ledger.posting ("a":|["b", "c"]))
4454 { Format.Ledger.posting_amounts = Data.Map.fromList
4456 { Amount.quantity = -1
4457 , Amount.style = Amount.Style.nil
4458 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4459 , Amount.Style.unit_spaced = Just False
4464 , Format.Ledger.posting_sourcepos = P.newPos "" 3 1
4467 , Format.Ledger.transaction_sourcepos = P.newPos "" 1 1
4474 , "Write" ~: TestList
4475 [ "account" ~: TestList
4477 ((Format.Ledger.Write.show
4478 Format.Ledger.Write.Style
4479 { Format.Ledger.Write.style_color=False
4480 , Format.Ledger.Write.style_align=True
4482 Format.Ledger.Write.account Posting.Posting_Type_Regular $
4487 ((Format.Ledger.Write.show
4488 Format.Ledger.Write.Style
4489 { Format.Ledger.Write.style_color=False
4490 , Format.Ledger.Write.style_align=True
4492 Format.Ledger.Write.account Posting.Posting_Type_Regular $
4497 ((Format.Ledger.Write.show
4498 Format.Ledger.Write.Style
4499 { Format.Ledger.Write.style_color=False
4500 , Format.Ledger.Write.style_align=True
4502 Format.Ledger.Write.account Posting.Posting_Type_Virtual $
4507 ((Format.Ledger.Write.show
4508 Format.Ledger.Write.Style
4509 { Format.Ledger.Write.style_color=False
4510 , Format.Ledger.Write.style_align=True
4512 Format.Ledger.Write.account Posting.Posting_Type_Virtual_Balanced $
4517 , "transaction" ~: TestList
4519 ((Format.Ledger.Write.show
4520 Format.Ledger.Write.Style
4521 { Format.Ledger.Write.style_color=False
4522 , Format.Ledger.Write.style_align=True
4524 Format.Ledger.Write.transaction
4525 Format.Ledger.transaction)
4528 , "2000/01/01 some description\\n\\tA:B:C $1\\n\\ta:b:c\\n\\t ; first comment\\n\\t ; second comment\\n\\t ; third comment\\n" ~:
4529 ((Format.Ledger.Write.show
4530 Format.Ledger.Write.Style
4531 { Format.Ledger.Write.style_color=False
4532 , Format.Ledger.Write.style_align=True
4534 Format.Ledger.Write.transaction $
4535 Format.Ledger.transaction
4536 { Format.Ledger.transaction_dates=
4537 ( Time.zonedTimeToUTC $
4540 (Time.fromGregorian 2000 01 01)
4541 (Time.TimeOfDay 0 0 0))
4544 , Format.Ledger.transaction_description="some description"
4545 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
4546 [ (Format.Ledger.posting ("A":|["B", "C"]))
4547 { Format.Ledger.posting_amounts = Data.Map.fromList
4549 { Amount.quantity = 1
4550 , Amount.style = Amount.Style.nil
4551 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4552 , Amount.Style.unit_spaced = Just False
4558 , (Format.Ledger.posting ("a":|["b", "c"]))
4559 { Format.Ledger.posting_comments = ["first comment","second comment","third comment"]
4564 "2000/01/01 some description\n\tA:B:C $1\n\ta:b:c\n\t ; first comment\n\t ; second comment\n\t ; third comment\n")
4565 , "2000/01/01 some description\\n\\tA:B:C $1\\n\\tAA:BB:CC $123" ~:
4566 ((Format.Ledger.Write.show
4567 Format.Ledger.Write.Style
4568 { Format.Ledger.Write.style_color=False
4569 , Format.Ledger.Write.style_align=True
4571 Format.Ledger.Write.transaction $
4572 Format.Ledger.transaction
4573 { Format.Ledger.transaction_dates=
4574 ( Time.zonedTimeToUTC $
4577 (Time.fromGregorian 2000 01 01)
4578 (Time.TimeOfDay 0 0 0))
4581 , Format.Ledger.transaction_description="some description"
4582 , Format.Ledger.transaction_postings = Format.Ledger.posting_by_Account
4583 [ (Format.Ledger.posting ("A":|["B", "C"]))
4584 { Format.Ledger.posting_amounts = Data.Map.fromList
4586 { Amount.quantity = 1
4587 , Amount.style = Amount.Style.nil
4588 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4589 , Amount.Style.unit_spaced = Just False
4595 , (Format.Ledger.posting ("AA":|["BB", "CC"]))
4596 { Format.Ledger.posting_amounts = Data.Map.fromList
4598 { Amount.quantity = 123
4599 , Amount.style = Amount.Style.nil
4600 { Amount.Style.unit_side = Just Amount.Style.Side_Left
4601 , Amount.Style.unit_spaced = Just False
4610 "2000/01/01 some description\n\tA:B:C $1\n\tAA:BB:CC $123\n")