{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Test.HUnit
import Test.Framework.Providers.HUnit (hUnitTestToTests)
import Test.Framework.Runners.Console (defaultMain)

import           Control.Applicative ((<*))
import           Control.Monad.IO.Class (liftIO)
import           Data.Decimal (DecimalRaw(..))
import qualified Data.Either
import qualified Data.List
import qualified Data.Map.Strict as Data.Map
import           Data.Text (Text)
import qualified Data.Time.Calendar  as Time
import qualified Data.Time.LocalTime as Time
import qualified Text.Parsec     as P
import qualified Text.Parsec.Pos as P
-- import qualified Text.PrettyPrint.Leijen.Text as PP

import qualified Hcompta.Model.Account as Account
import qualified Hcompta.Model.Amount as Amount
import qualified Hcompta.Model.Amount.Style as Amount.Style
import qualified Hcompta.Model.Date as Date
import qualified Hcompta.Model.Transaction as Transaction
import qualified Hcompta.Model.Transaction.Posting as Posting
import qualified Hcompta.Calc.Balance as Calc.Balance
import qualified Hcompta.Format.Ledger.Read as Format.Ledger.Read
import qualified Hcompta.Format.Ledger.Journal as Format.Ledger.Journal
import qualified Hcompta.Format.Ledger.Write as Format.Ledger.Write

--instance Eq Text.Parsec.ParseError where
-- (==) = const (const False)

main :: IO ()
main = defaultMain $ hUnitTestToTests test_Hcompta

test_Hcompta :: Test
test_Hcompta =
	TestList
	 [ "Model" ~: TestList
		 [ "Account" ~: TestList
			 [ "fold" ~: TestList
				 [ "[] = []" ~:
					(reverse $ Account.fold [] (:) []) ~?= []
				 , "[A] = [[A]]" ~:
					(reverse $ Account.fold ["A"] (:) []) ~?= [["A"]]
				 , "[A, B] = [[A], [A, B]]" ~:
					(reverse $ Account.fold ["A", "B"] (:) []) ~?= [["A"], ["A", "B"]]
				 , "[A, B, C] = [[A], [A, B], [A, B, C]]" ~:
					(reverse $ Account.fold ["A", "B", "C"] (:) []) ~?= [["A"], ["A", "B"], ["A", "B", "C"]]
				 ]
			 , "ascending" ~: TestList
				 [ "[] = []" ~:
					Account.ascending [] ~?= []
				 , "[A] = []" ~:
					Account.ascending ["A"] ~?= []
				 , "[A, B] = [A]" ~:
					Account.ascending ["A", "B"] ~?= ["A"]
				 , "[A, B, C] = [A, B]" ~:
					Account.ascending ["A", "B", "C"] ~?= ["A", "B"]
				 ]
			 ]
		 , "Amount" ~: TestList
			 [ "+" ~: TestList
				 [ "$1 + 1$ = $2" ~:
					(+)
					 (Amount.nil
						 { Amount.quantity = Decimal 0 1
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
							 }
						 , Amount.unit = "$"
						 })
					 (Amount.nil
						 { Amount.quantity = Decimal 0 1
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
							 }
						 , Amount.unit = "$"
						 })
					~?=
					(Amount.nil
					 { Amount.quantity = Decimal 0 2
					 , Amount.style = Amount.Style.nil
						 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
						 }
					 , Amount.unit = "$"
					 })
				 ]
			 , "from_List" ~: TestList
				 [ "from_List [$1, 1$] = $2" ~:
					Amount.from_List
					 [ Amount.nil
						 { Amount.quantity = Decimal 0 1
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
							 }
						 , Amount.unit = "$"
						 }
					 , Amount.nil
						 { Amount.quantity = Decimal 0 1
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.unit_side = Just $ Amount.Style.Side_Right
							 }
						 , Amount.unit = "$"
						 }
					 ]
					~?=
					Data.Map.fromList
					 [ ("$", Amount.nil
						 { Amount.quantity = Decimal 0 2
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.unit_side = Just $ Amount.Style.Side_Left
							 }
						 , Amount.unit = "$"
						 })
					 ]
				 ]
			 ]
		 ]
	 , "Calc" ~: TestList
		 [ "Balance" ~: TestList
			 [ "posting" ~: TestList
				 [ "[A+$1] = A+$1 & $+1" ~:
					 (Calc.Balance.posting
						 Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
							 }
						 Calc.Balance.nil)
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1 ]) ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "[A+$1, A-$1] = {A+$0, $+0}" ~:
					 (Data.List.foldl
						 (flip Calc.Balance.posting)
						 Calc.Balance.nil
						 [ Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
							 }
						 , Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ -1 ]
							 }
						 ])
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 0 ]) ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "[A+$1, A-€1] = {A+$1-€1, $+1 €-1}" ~:
					 (Data.List.foldl
						 (flip Calc.Balance.posting)
						 Calc.Balance.nil
						 [ Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
							 }
						 , Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.eur $ -1 ]
							 }
						 ])
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1, Amount.eur $ -1 ]) ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ -1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "[A+$1, B-$1] = {A+$1 B-$1, $+0}" ~:
					 (Data.List.foldl
						 (flip Calc.Balance.posting)
						 Calc.Balance.nil
						 [ Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ 1 ]
							 }
						 , Posting.nil
							 { Posting.account=["B"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ -1 ]
							 }
						 ])
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
							 , (["B"], Amount.from_List [ Amount.usd $ -1 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							]
						 }
				 , "[A+$1+€2, A-$1-€2] = {A+$0+€0, $+0 €+0}" ~:
					 (Data.List.foldl
						 (flip Calc.Balance.posting)
						 Calc.Balance.nil
						 [ Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2 ]
							 }
						 , Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2 ]
							 }
						 ])
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "[A+$1+€2+£3, B-$1-2€-£3] = {A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~:
					 (Data.List.foldl
						 (flip Calc.Balance.posting)
						 Calc.Balance.nil
						 [ Posting.nil
							 { Posting.account=["A"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ 1, Amount.eur $ 2, Amount.gbp $ 3 ]
							 }
						 , Posting.nil
							 { Posting.account=["B"]
							 , Posting.amounts=Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ]
							 }
						 ])
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $  1, Amount.eur $  2, Amount.gbp $  3 ])
							 , (["B"], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.gbp $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							]
						 }
				 ]
			 , "union" ~: TestList
				 [ "nil nil = nil" ~:
					 Calc.Balance.union
						 Calc.Balance.nil
						 Calc.Balance.nil
					 ~?=
					 Calc.Balance.nil
				 , "{A+$1, $+1} {A+$1, $+1} = {A+$2, $+2}" ~:
					 Calc.Balance.union
						 (Calc.Balance.Balance
							 { Calc.Balance.by_account =
								Data.Map.fromList
								 [ (["A"], Amount.from_List [ Amount.usd $ 1 ]) ]
							 , Calc.Balance.by_unit =
								Data.Map.fromList $
								Data.List.map Calc.Balance.assoc_unit_sum $
								[ Calc.Balance.Unit_Sum
								 { Calc.Balance.amount = Amount.usd $ 1
								 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
									 [["A"]]
								 }
								]
							 })
						 (Calc.Balance.Balance
							 { Calc.Balance.by_account =
								Data.Map.fromList
								 [ (["A"], Amount.from_List [ Amount.usd $ 1 ]) ]
							 , Calc.Balance.by_unit =
								Data.Map.fromList $
								Data.List.map Calc.Balance.assoc_unit_sum $
								[ Calc.Balance.Unit_Sum
								 { Calc.Balance.amount = Amount.usd $ 1
								 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
									 [["A"]]
								 }
								]
							 })
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 2 ]) ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 2
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "{A+$1, $+1} {B+$1, $+1} = {A+$1 B+$1, $+2}" ~:
					 Calc.Balance.union
						 (Calc.Balance.Balance
							 { Calc.Balance.by_account =
								Data.Map.fromList
								 [ (["A"], Amount.from_List [ Amount.usd $ 1 ]) ]
							 , Calc.Balance.by_unit =
								Data.Map.fromList $
								Data.List.map Calc.Balance.assoc_unit_sum $
								[ Calc.Balance.Unit_Sum
								 { Calc.Balance.amount = Amount.usd $ 1
								 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
									 [["A"]]
								 }
								]
							 })
						 (Calc.Balance.Balance
							 { Calc.Balance.by_account =
								Data.Map.fromList
								 [ (["B"], Amount.from_List [ Amount.usd $ 1 ]) ]
							 , Calc.Balance.by_unit =
								Data.Map.fromList $
								Data.List.map Calc.Balance.assoc_unit_sum $
								[ Calc.Balance.Unit_Sum
								 { Calc.Balance.amount = Amount.usd $ 1
								 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
									 [["B"]]
								 }
								]
							 })
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
							 , (["B"], Amount.from_List [ Amount.usd $ 1 ]) ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 2
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							]
						 }
				 , "{A+$1, $+1} {B+€1, €+1} = {A+$1 B+€1, $+1 €+1}" ~:
					 Calc.Balance.union
						 (Calc.Balance.Balance
							 { Calc.Balance.by_account =
								Data.Map.fromList
								 [ (["A"], Amount.from_List [ Amount.usd $ 1 ]) ]
							 , Calc.Balance.by_unit =
								Data.Map.fromList $
								Data.List.map Calc.Balance.assoc_unit_sum $
								[ Calc.Balance.Unit_Sum
								 { Calc.Balance.amount = Amount.usd $ 1
								 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
									 [["A"]]
								 }
								]
							 })
						 (Calc.Balance.Balance
							 { Calc.Balance.by_account =
								Data.Map.fromList
								 [ (["B"], Amount.from_List [ Amount.eur $ 1 ]) ]
							 , Calc.Balance.by_unit =
								Data.Map.fromList $
								Data.List.map Calc.Balance.assoc_unit_sum $
								[ Calc.Balance.Unit_Sum
								 { Calc.Balance.amount = Amount.eur $ 1
								 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
									 [["B"]]
								 }
								]
							 })
					 ~?=
					 Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
							 , (["B"], Amount.from_List [ Amount.eur $ 1 ]) ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["B"]]
							 }
							]
						 }
				 ]
			 , "expand" ~: TestList
				 [ "nil_By_Account = nil_By_Account" ~:
					 Calc.Balance.expand
						 Calc.Balance.nil_By_Account
					 ~?=
					 (Calc.Balance.Expanded $
						Calc.Balance.nil_By_Account)
				 , "A+$1 = A+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ]) ])
				 , "A/A+$1 = A+$1 A/A+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A", "A"], Amount.from_List [ Amount.usd $ 1 ]) ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "A"], Amount.from_List [ Amount.usd $ 1 ]) ])
				 , "A/B+$1 = A+$1 A/B+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A", "B"], Amount.from_List [ Amount.usd $ 1 ]) ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ]) ])
				 , "A/B/C+$1 = A+$1 A/B+$1 A/B/C+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ]) ])
				 , "A+$1 A/B+$1 = A+$2 A/B+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ]) ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 2 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ]) ])
				 , "A+$1 A/B+$1 A/B/C+$1 = A+$3 A/B+$2 A/B/C+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ])
						 ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 3 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 2 ])
						 , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ])
						 ])
				 , "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" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
						 ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 4 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 3 ])
						 , (["A", "B", "C"], Amount.from_List [ Amount.usd $ 2 ])
						 , (["A", "B", "C", "D"], Amount.from_List [ Amount.usd $ 1 ])
						 ])
				 , "A+$1 A/B+$1 B/A+$1 = A+$2 A/B+$1 B/A+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["B", "A"], Amount.from_List [ Amount.usd $ 1 ]) ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 2 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["B", "A"], Amount.from_List [ Amount.usd $ 1 ]) ])
				 , "A+$1 A/B+$1 B/A+$1 = A+$2 A/B+$1 B/A+$1" ~:
					 Calc.Balance.expand
						(Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["B", "A"], Amount.from_List [ Amount.usd $ 1 ]) ])
					 ~?=
					 (Calc.Balance.Expanded $
						Data.Map.fromList
						 [ (["A"], Amount.from_List [ Amount.usd $ 2 ])
						 , (["A", "B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["B"], Amount.from_List [ Amount.usd $ 1 ])
						 , (["B", "A"], Amount.from_List [ Amount.usd $ 1 ]) ])
				 ]
			 , "is_equilibrable" ~: TestList
				 [ "nil" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.nil
				 , "{A+$0, $+0}" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 0 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "{A+$1, $+1}" ~: TestCase $
						(@=?) False $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "{A+$0+€0, $0 €+0}" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 0, Amount.eur $ 0 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							]
						 }
				 , "{A+$1, B-$1, $+0}" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $  1 ])
							 , (["B"], Amount.from_List [ Amount.usd $ -1 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							]
						 }
				 , "{A+$1 B, $+1}" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						 Calc.Balance.Balance
							 { Calc.Balance.by_account =
								Data.Map.fromList
								 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
								 , (["B"], Amount.from_List [])
								 ]
							 , Calc.Balance.by_unit =
								Data.Map.fromList $
								Data.List.map Calc.Balance.assoc_unit_sum $
								[ Calc.Balance.Unit_Sum
								 { Calc.Balance.amount = Amount.usd $ 1
								 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
									 [["A"]]
								 }
								]
							 }
				 , "{A+$1 B+€1, $+1 €+1}" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
							 , (["B"], Amount.from_List [ Amount.eur $ 1 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["B"]]
							 }
							]
						 }
				 , "{A+$1 B-$1+€1, $+0 €+1}" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $ 1 ])
							 , (["B"], Amount.from_List [ Amount.usd $ -1, Amount.eur $ 1 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ 1
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["B"]]
							 }
							]
						 }
				 , "{A+$1+€2+£3 B-$1-€2-£3, $+0 €+0 £+0}" ~: TestCase $
						(@=?) True $
						Calc.Balance.is_equilibrable $
						Calc.Balance.equilibre $
						Calc.Balance.Balance
						 { Calc.Balance.by_account =
							Data.Map.fromList
							 [ (["A"], Amount.from_List [ Amount.usd $  1, Amount.eur $  2, Amount.gbp $  3 ])
							 , (["B"], Amount.from_List [ Amount.usd $ -1, Amount.eur $ -2, Amount.gbp $ -3 ])
							 ]
						 , Calc.Balance.by_unit =
							Data.Map.fromList $
							Data.List.map Calc.Balance.assoc_unit_sum $
							[ Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.usd $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.eur $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							, Calc.Balance.Unit_Sum
							 { Calc.Balance.amount = Amount.gbp $ 0
							 , Calc.Balance.accounts = Data.Map.fromList $ Data.List.map (,())
								 [["A"], ["B"]]
							 }
							]
						 }
				 ]
			 ]
		 ]
	 , "Format" ~: TestList
		 [ "Ledger" ~: TestList
			 [ "Read" ~: TestList
				 [ "account_name" ~: TestList
					 [ "\"\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" (""::Text)])
						 ~?=
						 []
					 , "\"A\" = Right \"A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("A"::Text)])
						 ~?=
						 ["A"]
					 , "\"AA\" = Right \"AA\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("AA"::Text)])
						 ~?=
						 ["AA"]
					 , "\" \" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" (" "::Text)])
						 ~?=
						 []
					 , "\":\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" (":"::Text)])
						 ~?=
						 []
					 , "\"A:\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("A:"::Text)])
						 ~?=
						 []
					 , "\":A\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" (":A"::Text)])
						 ~?=
						 []
					 , "\"A \" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("A "::Text)])
						 ~?=
						 []
					 , "\"A \" ^= Right" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name)
							 () "" ("A "::Text)])
						 ~?=
						 ["A"]
					 , "\"A A\" = Right \"A A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("A A"::Text)])
						 ~?=
						 ["A A"]
					 , "\"A \" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("A "::Text)])
						 ~?=
						 []
					 , "\"A \\n\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("A \n"::Text)])
						 ~?=
						 []
					 , "\"(A)A\" = Right \"(A)A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("(A)A"::Text)])
						 ~?=
						 ["(A)A"]
					 , "\"( )A\" = Right \"( )A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("( )A"::Text)])
						 ~?=
						 ["( )A"]
					 , "\"(A) A\" = Right \"(A) A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("(A) A"::Text)])
						 ~?=
						 ["(A) A"]
					 , "\"[ ]A\" = Right \"[ ]A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("[ ]A"::Text)])
						 ~?=
						 ["[ ]A"]
					 , "\"(A)  \" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("(A)  "::Text)])
						 ~?=
						 []
					 , "\"(A)\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("(A)"::Text)])
						 ~?=
						 []
					 , "\"[A]A\" = Right \"(A)A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("[A]A"::Text)])
						 ~?=
						 ["[A]A"]
					 , "\"[A] A\" = Right \"[A] A\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("[A] A"::Text)])
						 ~?=
						 ["[A] A"]
					 , "\"[A]  \" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("[A]  "::Text)])
						 ~?=
						 []
					 , "\"[A]\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account_name <* P.eof)
							 () "" ("[A]"::Text)])
						 ~?=
						 []
					 ]
				 , "account" ~: TestList
					 [ "\"\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" (""::Text)])
						 ~?=
						 []
					 , "\"A\" = Right [\"A\"]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A"::Text)])
						 ~?=
						 [["A"]]
					 , "\"A:\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A:"::Text)])
						 ~?=
						 []
					 , "\":A\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" (":A"::Text)])
						 ~?=
						 []
					 , "\"A \" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A "::Text)])
						 ~?=
						 []
					 , "\" A\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" (" A"::Text)])
						 ~?=
						 []
					 , "\"A:B\" = Right [\"A\", \"B\"]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A:B"::Text)])
						 ~?=
						 [["A", "B"]]
					 , "\"A:B:C\" = Right [\"A\", \"B\", \"C\"]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A:B:C"::Text)])
						 ~?=
						 [["A", "B", "C"]]
					 , "\"Aa:Bbb:Cccc\" = Right [\"Aa\", \"Bbb\", \":Cccc\"]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("Aa:Bbb:Cccc"::Text)])
						 ~?=
						 [["Aa", "Bbb", "Cccc"]]
					 , "\"A a : B b b : C c c c\" = Right [\"A a \", \" B b b \", \": C c c c\"]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A a : B b b : C c c c"::Text)])
						 ~?=
						 [["A a ", " B b b ", " C c c c"]]
					 , "\"A: :C\" = Right [\"A\", \" \", \"C\"]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A: :C"::Text)])
						 ~?=
						 [["A", " ", "C"]]
					 , "\"A::C\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.account <* P.eof)
							 () "" ("A::C"::Text)])
						 ~?=
						 []
					 ]
				 , "amount" ~: TestList
					 [ "\"\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" (""::Text)])
						 ~?=
						 []
					 , "\"0\" = Right 0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 }]
					 , "\"00\" = Right 0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 }]
					 , "\"0.\" = Right 0." ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0."::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 }
							 }]
					 , "\".0\" = Right 0.0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" (".0"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.precision = 1
								 }
							 }]
					 , "\"0,\" = Right 0," ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0,"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 }
							 }]
					 , "\",0\" = Right 0,0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" (",0"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.precision = 1
								 }
							 }]
					 , "\"0_\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0_"::Text)])
						 ~?=
						 []
					 , "\"_0\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("_0"::Text)])
						 ~?=
						 []
					 , "\"0.0\" = Right 0.0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0.0"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.precision = 1
								 }
							 }]
					 , "\"00.00\" = Right 0.00" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("00.00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"0,0\" = Right 0,0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0,0"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.precision = 1
								 }
							 }]
					 , "\"00,00\" = Right 0,00" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("00,00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"0_0\" = Right 0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0_0"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
								 , Amount.Style.precision = 0
								 }
							 }]
					 , "\"00_00\" = Right 0" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("00_00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
								 , Amount.Style.precision = 0
								 }
							 }]
					 , "\"0,000.00\" = Right 0,000.00" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("0,000.00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"0.000,00\" = Right 0.000,00" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount)
							 () "" ("0.000,00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 0
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"1,000.00\" = Right 1,000.00" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1,000.00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1000
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"1.000,00\" = Right 1.000,00" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount)
							 () "" ("1.000,00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1000
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"1,000.00.\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount)
							 () "" ("1,000.00."::Text)])
						 ~?=
						 []
					 , "\"1.000,00,\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount)
							 () "" ("1.000,00,"::Text)])
						 ~?=
						 []
					 , "\"1,000.00_\" = Left" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount)
							 () "" ("1,000.00_"::Text)])
						 ~?=
						 []
					 , "\"12\" = Right 12" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("123"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 123
							 }]
					 , "\"1.2\" = Right 1.2" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1.2"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 1 12
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.precision = 1
								 }
							 }]
					 , "\"1,2\" = Right 1,2" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1,2"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 1 12
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.precision = 1
								 }
							 }]
					 , "\"12.23\" = Right 12.23" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("12.34"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 2 1234
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"12,23\" = Right 12,23" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("12,34"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 2 1234
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.precision = 2
								 }
							 }]
					 , "\"1_2\" = Right 1_2" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1_2"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 12
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [1]
								 , Amount.Style.precision = 0
								 }
							 }]
					 , "\"1_23\" = Right 1_23" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1_23"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 123
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [2]
								 , Amount.Style.precision = 0
								 }
							 }]
					 , "\"1_23_456\" = Right 1_23_456" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1_23_456"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 123456
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
								 , Amount.Style.precision = 0
								 }
							 }]
					 , "\"1_23_456.7890_12345_678901\" = Right 1_23_456.7890_12345_678901" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1_23_456.7890_12345_678901"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 15 123456789012345678901
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [3, 2]
								 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [4, 5, 6]
								 , Amount.Style.precision = 15
								 }
							 }]
					 , "\"123456_78901_2345.678_90_1\" = Right 123456_78901_2345.678_90_1" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("123456_78901_2345.678_90_1"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 6 123456789012345678901
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just '.'
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '_' [4, 5, 6]
								 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping '_' [3, 2]
								 , Amount.Style.precision = 6
								 }
							 }]
					 , "\"$1\" = Right $1" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("$1"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Nothing
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 0
								 , Amount.Style.unit_side = Just Amount.Style.Side_Left
								 , Amount.Style.unit_spaced = Just False
								 }
							 , Amount.unit = "$"
							 }]
					 , "\"1$\" = Right 1$" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1$"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Nothing
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 0
								 , Amount.Style.unit_side = Just Amount.Style.Side_Right
								 , Amount.Style.unit_spaced = Just False
								 }
							 , Amount.unit = "$"
							 }]
					 , "\"$ 1\" = Right $ 1" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("$ 1"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Nothing
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 0
								 , Amount.Style.unit_side = Just Amount.Style.Side_Left
								 , Amount.Style.unit_spaced = Just True
								 }
							 , Amount.unit = "$"
							 }]
					 , "\"1 $\" = Right 1 $" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1 $"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Nothing
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 0
								 , Amount.Style.unit_side = Just Amount.Style.Side_Right
								 , Amount.Style.unit_spaced = Just True
								 }
							 , Amount.unit = "$"
							 }]
					 , "\"-$1\" = Right $-1" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("-$1"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 (-1)
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Nothing
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 0
								 , Amount.Style.unit_side = Just Amount.Style.Side_Left
								 , Amount.Style.unit_spaced = Just False
								 }
							 , Amount.unit = "$"
							 }]
					 , "\"\\\"4 2\\\"1\" = Right \\\"4 2\\\"1" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("\"4 2\"1"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Nothing
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 0
								 , Amount.Style.unit_side = Just Amount.Style.Side_Left
								 , Amount.Style.unit_spaced = Just False
								 }
							 , Amount.unit = "4 2"
							 }]
					 , "\"1\\\"4 2\\\"\" = Right 1\\\"4 2\\\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1\"4 2\""::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Nothing
								 , Amount.Style.grouping_integral = Nothing
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 0
								 , Amount.Style.unit_side = Just Amount.Style.Side_Right
								 , Amount.Style.unit_spaced = Just False
								 }
							 , Amount.unit = "4 2"
							 }]
					 , "\"$1.000,00\" = Right $1.000,00" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("$1.000,00"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1000
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 2
								 , Amount.Style.unit_side = Just Amount.Style.Side_Left
								 , Amount.Style.unit_spaced = Just False
								 }
							 , Amount.unit = "$"
							 }]
					 , "\"1.000,00$\" = Right 1.000,00$" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.amount <* P.eof)
							 () "" ("1.000,00$"::Text)])
						 ~?=
						 [Amount.nil
							 { Amount.quantity = Decimal 0 1000
							 , Amount.style =
								Amount.Style.nil
								 { Amount.Style.fractioning = Just ','
								 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping '.' [3]
								 , Amount.Style.grouping_fractional = Nothing
								 , Amount.Style.precision = 2
								 , Amount.Style.unit_side = Just Amount.Style.Side_Right
								 , Amount.Style.unit_spaced = Just False
								 }
							 , Amount.unit = "$"
							 }]
					 ]
				 , "comment" ~: TestList
					 [ "; some comment = Right \" some comment\"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.comment <* P.eof)
							 () "" ("; some comment"::Text)])
						 ~?=
						 [ " some comment" ]
					 , "; some comment \\n = Right \" some comment \"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.comment <* P.newline <* P.eof)
							 () "" ("; some comment \n"::Text)])
						 ~?=
						 [ " some comment " ]
					 , "; some comment \\r\\n = Right \" some comment \"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.comment <* P.string "\r\n" <* P.eof)
							 () "" ("; some comment \r\n"::Text)])
						 ~?=
						 [ " some comment " ]
					 ]
				 , "comments" ~: TestList
					 [ "; some comment\\n  ; some other comment = Right [\" some comment\", \" some other comment\"]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.comments <* P.eof)
							 () "" ("; some comment\n  ; some other comment"::Text)])
						 ~?=
						 [ [" some comment", " some other comment"] ]
					 , "; some comment \\n = Right \" some comment \"" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.comments <* P.string "\n" <* P.eof)
							 () "" ("; some comment \n"::Text)])
						 ~?=
						 [ [" some comment "] ]
					 ]
				 , "date" ~: TestList
					 [ "2000/01/01" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing <* P.eof)
							 () "" ("2000/01/01"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 0 0 0))
							 (Time.utc)]
					 , "2000/01/01 some text" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing)
							 () "" ("2000/01/01 some text"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 0 0 0))
							 (Time.utc)]
					 , "2000/01/01 12:34" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing <* P.eof)
							 () "" ("2000/01/01 12:34"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 12 34 0))
							 (Time.utc)]
					 , "2000/01/01 12:34:56" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing <* P.eof)
							 () "" ("2000/01/01 12:34:56"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 12 34 56))
							 (Time.utc)]
					 , "2000/01/01 12:34 CET" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing <* P.eof)
							 () "" ("2000/01/01 12:34 CET"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 12 34 0))
							 (Time.TimeZone 60 True "CET")]
					 , "2000/01/01 12:34 +0130" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing <* P.eof)
							 () "" ("2000/01/01 12:34 +0130"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 12 34 0))
							 (Time.TimeZone 90 False "+0130")]
					 , "2000/01/01 12:34:56 CET" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing <* P.eof)
							 () "" ("2000/01/01 12:34:56 CET"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 12 34 56))
							 (Time.TimeZone 60 True "CET")]
					 , "2001/02/29" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date Nothing <* P.eof)
							 () "" ("2001/02/29"::Text)])
						 ~?=
						 []
					 , "01/01" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.date (Just 2000) <* P.eof)
							 () "" ("01/01"::Text)])
						 ~?=
						 [ Time.ZonedTime
							 (Time.LocalTime
								 (Time.fromGregorian 2000 01 01)
								 (Time.TimeOfDay 0 0 0))
							 (Time.utc)]
					 ]
				 , "tag_value" ~: TestList
					 [ "," ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag_value <* P.eof)
							 () "" (","::Text)])
						 ~?=
						 [","]
					 , ",\\n" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag_value <* P.char '\n' <* P.eof)
							 () "" (",\n"::Text)])
						 ~?=
						 [","]
					 , ",x" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag_value <* P.eof)
							 () "" (",x"::Text)])
						 ~?=
						 [",x"]
					 , ",x:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag_value <* P.string ",x:" <* P.eof)
							 () "" (",x:"::Text)])
						 ~?=
						 [""]
					 , "v, v, n:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag_value <* P.string ", n:" <* P.eof)
							 () "" ("v, v, n:"::Text)])
						 ~?=
						 ["v, v"]
					 ]
				 , "tag" ~: TestList
					 [ "Name:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag <* P.eof)
							 () "" ("Name:"::Text)])
						 ~?=
						 [("Name", "")]
					 , "Name:Value" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag <* P.eof)
							 () "" ("Name:Value"::Text)])
						 ~?=
						 [("Name", "Value")]
					 , "Name:Value\\n" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag <* P.string "\n" <* P.eof)
							 () "" ("Name:Value\n"::Text)])
						 ~?=
						 [("Name", "Value")]
					 , "Name:Val ue" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag <* P.eof)
							 () "" ("Name:Val ue"::Text)])
						 ~?=
						 [("Name", "Val ue")]
					 , "Name:," ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag <* P.eof)
							 () "" ("Name:,"::Text)])
						 ~?=
						 [("Name", ",")]
					 , "Name:Val,ue" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag <* P.eof)
							 () "" ("Name:Val,ue"::Text)])
						 ~?=
						 [("Name", "Val,ue")]
					 , "Name:Val,ue:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tag <* P.string ",ue:" <* P.eof)
							 () "" ("Name:Val,ue:"::Text)])
						 ~?=
						 [("Name", "Val")]
					 ]
				 , "tags" ~: TestList
					 [ "Name:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tags <* P.eof)
							 () "" ("Name:"::Text)])
						 ~?=
						 [Data.Map.fromList
							 [ ("Name", [""])
							 ]
						 ]
					 , "Name:," ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tags <* P.eof)
							 () "" ("Name:,"::Text)])
						 ~?=
						 [Data.Map.fromList
							 [ ("Name", [","])
							 ]
						 ]
					 , "Name:,Name:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tags <* P.eof)
							 () "" ("Name:,Name:"::Text)])
						 ~?=
						 [Data.Map.fromList
							 [ ("Name", ["", ""])
							 ]
						 ]
					 , "Name:,Name2:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tags <* P.eof)
							 () "" ("Name:,Name2:"::Text)])
						 ~?=
						 [Data.Map.fromList
							 [ ("Name", [""])
							 , ("Name2", [""])
							 ]
						 ]
					 , "Name: , Name2:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tags <* P.eof)
							 () "" ("Name: , Name2:"::Text)])
						 ~?=
						 [Data.Map.fromList
							 [ ("Name", [" "])
							 , ("Name2", [""])
							 ]
						 ]
					 , "Name:,Name2:,Name3:" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tags <* P.eof)
							 () "" ("Name:,Name2:,Name3:"::Text)])
						 ~?=
						 [Data.Map.fromList
							 [ ("Name", [""])
							 , ("Name2", [""])
							 , ("Name3", [""])
							 ]
						 ]
					 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.tags <* P.eof)
							 () "" ("Name:Val ue,Name2:V a l u e,Name3:V al ue"::Text)])
						 ~?=
						 [Data.Map.fromList
							 [ ("Name", ["Val ue"])
							 , ("Name2", ["V a l u e"])
							 , ("Name3", ["V al ue"])
							 ]
						 ]
					 ]
				 , "posting" ~: TestList
					 [ " A:B:C = Right A:B:C" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C"::Text)])
						 ~?=
						 [ ( Posting.nil
								 { Posting.account = ["A","B","C"]
								 , Posting.sourcepos = P.newPos "" 1 1
								 }
							 , Posting.Type_Regular
							 )
						 ]
					 , " !A:B:C = Right !A:B:C" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" !A:B:C"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.status = True
							 }
						 ]
					 , " *A:B:C = Right *A:B:C" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" *A:B:C"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList []
							 , Posting.comments = []
							 , Posting.dates = []
							 , Posting.status = True
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.tags = Data.Map.fromList []
							 }
						 ]
					 , " A:B:C $1 = Right A:B:C $1" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C $1"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C $1"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C  $1 = Right A:B:C  $1" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C  $1"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList
								 [ ("$", Amount.nil
									 { Amount.quantity = 1
									 , Amount.style = Amount.Style.nil
										 { Amount.Style.unit_side = Just Amount.Style.Side_Left
										 , Amount.Style.unit_spaced = Just False
										 }
									 , Amount.unit = "$"
									 })
								 ]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C  $1 + 1€ = Right A:B:C  $1 + 1€" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C  $1 + 1€"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList
								 [ ("$", Amount.nil
									 { Amount.quantity = 1
									 , Amount.style = Amount.Style.nil
										 { Amount.Style.unit_side = Just Amount.Style.Side_Left
										 , Amount.Style.unit_spaced = Just False
										 }
									 , Amount.unit = "$"
									 })
								 , ("€", Amount.nil
									 { Amount.quantity = 1
									 , Amount.style = Amount.Style.nil
										 { Amount.Style.unit_side = Just Amount.Style.Side_Right
										 , Amount.Style.unit_spaced = Just False
										 }
									 , Amount.unit = "€"
									 })
								 ]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C  $1 + 1$ = Right A:B:C  $2" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C  $1 + 1$"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList
								 [ ("$", Amount.nil
									 { Amount.quantity = 2
									 , Amount.style = Amount.Style.nil
										 { Amount.Style.unit_side = Just Amount.Style.Side_Left
										 , Amount.Style.unit_spaced = Just False
										 }
									 , Amount.unit = "$"
									 })
								 ]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C  $1 + 1$ + 1$ = Right A:B:C  $3" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C  $1 + 1$ + 1$"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList
								 [ ("$", Amount.nil
									 { Amount.quantity = 3
									 , Amount.style = Amount.Style.nil
										 { Amount.Style.unit_side = Just Amount.Style.Side_Left
										 , Amount.Style.unit_spaced = Just False
										 }
									 , Amount.unit = "$"
									 })
								 ]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C ; some comment = Right A:B:C ; some comment" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList []
							 , Posting.comments = [" some comment"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C ; some comment\\n  ; some other comment = Right A:B:C ; some comment\\n  ; some other comment" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment\n  ; some other comment"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList []
							 , Posting.comments = [" some comment", " some other comment"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C  $1 ; some comment = Right A:B:C  $1 ; some comment" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting)
								Format.Ledger.Read.nil_Context "" (" A:B:C  $1 ; some comment"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.amounts = Data.Map.fromList
								 [ ("$", Amount.nil
									 { Amount.quantity = 1
									 , Amount.style = Amount.Style.nil
										 { Amount.Style.unit_side = Just Amount.Style.Side_Left
										 , Amount.Style.unit_spaced = Just False
										 }
									 , Amount.unit = "$"
									 })
								 ]
							 , Posting.comments = [" some comment"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , " A:B:C ; N:V = Right A:B:C ; N:V" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.comments = [" N:V"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.tags = Data.Map.fromList
								 [ ("N", ["V"])
								 ]
							 }
						 ]
					 , " A:B:C ; some comment N:V = Right A:B:C ; some comment N:V" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.comments = [" some comment N:V"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.tags = Data.Map.fromList
								 [ ("N", ["V"])
								 ]
							 }
						 ]
					 , " A:B:C ; some comment N:V v, N2:V2 v2 = Right A:B:C ; some comment N:V v, N2:V2 v2" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting )
								Format.Ledger.Read.nil_Context "" (" A:B:C ; some comment N:V v, N2:V2 v2"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.comments = [" some comment N:V v, N2:V2 v2"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.tags = Data.Map.fromList
								 [ ("N", ["V v"])
								 , ("N2", ["V2 v2"])
								 ]
							 }
						 ]
					 , " A:B:C ; N:V\\n ; N:V2 = Right A:B:C ; N:V\\n ; N:V2" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N:V2"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.comments = [" N:V", " N:V2"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.tags = Data.Map.fromList
								 [ ("N", ["V", "V2"])
								 ]
							 }
						 ]
					 , " A:B:C ; N:V\\n ; N2:V = Right A:B:C ; N:V\\n ; N2:V" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C ; N:V\n ; N2:V"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.comments = [" N:V", " N2:V"]
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.tags = Data.Map.fromList
								 [ ("N", ["V"])
								 , ("N2", ["V"])
								 ]
							 }
						 ]
					 , " A:B:C ; date:2001/01/01 = Right A:B:C ; date:2001/01/01" ~:
						 (Data.List.map fst $
							Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" A:B:C ; date:2001/01/01"::Text)])
						 ~?=
						 [ Posting.nil
							 { Posting.account = ["A","B","C"]
							 , Posting.comments = [" date:2001/01/01"]
							 , Posting.dates =
								 [ Time.ZonedTime
									 (Time.LocalTime
										 (Time.fromGregorian 2001 01 01)
										 (Time.TimeOfDay 0 0 0))
									 Time.utc
								 ]
							 , Posting.sourcepos = P.newPos "" 1 1
							 , Posting.tags = Data.Map.fromList
								 [ ("date", ["2001/01/01"])
								 ]
							 }
						 ]
					 , " (A:B:C) = Right (A:B:C)" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" (A:B:C)"::Text)])
						 ~?=
						 [ ( Posting.nil
								 { Posting.account = ["A","B","C"]
								 , Posting.sourcepos = P.newPos "" 1 1
								 }
							 , Posting.Type_Virtual
							 )
						 ]
					 , " [A:B:C] = Right [A:B:C]" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.posting <* P.eof)
								Format.Ledger.Read.nil_Context "" (" [A:B:C]"::Text)])
						 ~?=
						 [ ( Posting.nil
								 { Posting.account = ["A","B","C"]
								 , Posting.sourcepos = P.newPos "" 1 1
								 }
							 , Posting.Type_Virtual_Balanced
							 )
						 ]
					 ]
				 , "transaction" ~: TestList
					 [ "2000/01/01 some description\\n A:B:C  $1\\n a:b:c" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.transaction <* P.eof)
								Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C  $1\n a:b:c"::Text)])
						 ~?=
						 [ Transaction.nil
							 { Transaction.dates=
								 ( Time.ZonedTime
									 (Time.LocalTime
										 (Time.fromGregorian 2000 01 01)
										 (Time.TimeOfDay 0 0 0))
									 (Time.utc)
								 , [] )
							 , Transaction.description="some description"
							 , Transaction.postings = Posting.from_List
								 [ Posting.nil
									 { Posting.account = ["A","B","C"]
									 , Posting.amounts = Data.Map.fromList
										 [ ("$", Amount.nil
											 { Amount.quantity = 1
											 , Amount.style = Amount.Style.nil
												 { Amount.Style.unit_side = Just Amount.Style.Side_Left
												 , Amount.Style.unit_spaced = Just False
												 }
											 , Amount.unit = "$"
											 })
										 ]
									 , Posting.sourcepos = P.newPos "" 2 1
									 }
								 , Posting.nil
									 { Posting.account = ["a","b","c"]
									 , Posting.sourcepos = P.newPos "" 3 1
									 }
								 ]
							 , Transaction.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , "2000/01/01 some description\\n A:B:C  $1\\n a:b:c\\n" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.transaction <* P.newline <* P.eof)
								Format.Ledger.Read.nil_Context "" ("2000/01/01 some description\n A:B:C  $1\n a:b:c\n"::Text)])
						 ~?=
						 [ Transaction.nil
							 { Transaction.dates=
								 ( Time.ZonedTime
									 (Time.LocalTime
										 (Time.fromGregorian 2000 01 01)
										 (Time.TimeOfDay 0 0 0))
									 (Time.utc)
								 , [] )
							 , Transaction.description="some description"
							 , Transaction.postings = Posting.from_List
								 [ Posting.nil
									 { Posting.account = ["A","B","C"]
									 , Posting.amounts = Data.Map.fromList
										 [ ("$", Amount.nil
											 { Amount.quantity = 1
											 , Amount.style = Amount.Style.nil
												 { Amount.Style.unit_side = Just Amount.Style.Side_Left
												 , Amount.Style.unit_spaced = Just False
												 }
											 , Amount.unit = "$"
											 })
										 ]
									 , Posting.sourcepos = P.newPos "" 2 1
									 }
								 , Posting.nil
									 { Posting.account = ["a","b","c"]
									 , Posting.sourcepos = P.newPos "" 3 1
									 }
								 ]
							 , Transaction.sourcepos = P.newPos "" 1 1
							 }
						 ]
					 , "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" ~:
						 (Data.Either.rights $
							[P.runParser
							 (Format.Ledger.Read.transaction <* P.eof)
								Format.Ledger.Read.nil_Context "" ("2000/01/01 some description  ;  some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C  $1\n a:b:c"::Text)])
						 ~?=
						 [ Transaction.nil
							 { Transaction.comments_after =
								 [ "  some comment"
								 , " some other;comment"
								 , " some Tag:"
								 , " some last comment"
								 ]
							 , Transaction.dates=
								 ( Time.ZonedTime
									 (Time.LocalTime
										 (Time.fromGregorian 2000 01 01)
										 (Time.TimeOfDay 0 0 0))
									 (Time.utc)
								 , [] )
							 , Transaction.description="some description"
							 , Transaction.postings = Posting.from_List
								 [ Posting.nil
									 { Posting.account = ["A","B","C"]
									 , Posting.amounts = Data.Map.fromList
										 [ ("$", Amount.nil
											 { Amount.quantity = 1
											 , Amount.style = Amount.Style.nil
												 { Amount.Style.unit_side = Just Amount.Style.Side_Left
												 , Amount.Style.unit_spaced = Just False
												 }
											 , Amount.unit = "$"
											 })
										 ]
									 , Posting.sourcepos = P.newPos "" 5 1
									 }
								 , Posting.nil
									 { Posting.account = ["a","b","c"]
									 , Posting.sourcepos = P.newPos "" 6 1
									 , Posting.tags = Data.Map.fromList []
									 }
								 ]
							 , Transaction.sourcepos = P.newPos "" 1 1
							 , Transaction.tags = Data.Map.fromList
								 [ ("Tag", [""])
								 ]
							 }
						 ]
					 ]
				 , "journal" ~: TestList
					 [ "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
						jnl <- liftIO $
							P.runParserT
							 (Format.Ledger.Read.journal "" {-<* P.eof-})
								Format.Ledger.Read.nil_Context "" ("2000/01/01 1° description\n A:B:C  $1\n a:b:c\n2000/01/02 2° description\n A:B:C  $1\n x:y:z"::Text)
						(Data.List.map
							 (\j -> j{Format.Ledger.Journal.last_read_time=
								Format.Ledger.Journal.last_read_time Format.Ledger.Journal.nil}) $
							Data.Either.rights [jnl])
						 @?=
						 [ Format.Ledger.Journal.nil
							 { Format.Ledger.Journal.transactions = Transaction.from_List
								 [ Transaction.nil
									 { Transaction.dates=
										 ( Time.ZonedTime
											 (Time.LocalTime
												 (Time.fromGregorian 2000 01 01)
												 (Time.TimeOfDay 0 0 0))
											 (Time.utc)
										 , [] )
									 , Transaction.description="1° description"
									 , Transaction.postings = Posting.from_List
										 [ Posting.nil
											 { Posting.account = ["A","B","C"]
											 , Posting.amounts = Data.Map.fromList
												 [ ("$", Amount.nil
													 { Amount.quantity = 1
													 , Amount.style = Amount.Style.nil
														 { Amount.Style.unit_side = Just Amount.Style.Side_Left
														 , Amount.Style.unit_spaced = Just False
														 }
													 , Amount.unit = "$"
													 })
												 ]
											 , Posting.sourcepos = P.newPos "" 2 1
											 }
										 , Posting.nil
											 { Posting.account = ["a","b","c"]
											 , Posting.sourcepos = P.newPos "" 3 1
											 }
										 ]
									 , Transaction.sourcepos = P.newPos "" 1 1
									 }
								 , Transaction.nil
									 { Transaction.dates=
										 ( Time.ZonedTime
											 (Time.LocalTime
												 (Time.fromGregorian 2000 01 02)
												 (Time.TimeOfDay 0 0 0))
											 (Time.utc)
										 , [] )
									 , Transaction.description="2° description"
									 , Transaction.postings = Posting.from_List
										 [ Posting.nil
											 { Posting.account = ["A","B","C"]
											 , Posting.amounts = Data.Map.fromList
												 [ ("$", Amount.nil
													 { Amount.quantity = 1
													 , Amount.style = Amount.Style.nil
														 { Amount.Style.unit_side = Just Amount.Style.Side_Left
														 , Amount.Style.unit_spaced = Just False
														 }
													 , Amount.unit = "$"
													 })
												 ]
											 , Posting.sourcepos = P.newPos "" 5 1
											 }
										 , Posting.nil
											 { Posting.account = ["x","y","z"]
											 , Posting.sourcepos = P.newPos "" 6 1
											 }
										 ]
									 , Transaction.sourcepos = P.newPos "" 4 1
									 }
								 ]
							 }
						 ]
					 ]
				 ]
			 , "Write" ~: TestList
				 [ "account" ~: TestList
					 [ "nil" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.account Posting.Type_Regular
						Account.nil)
						~?=
						"")
					 , "A" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.account Posting.Type_Regular
						["A"])
						~?=
						"A")
					 , "A:B:C" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.account Posting.Type_Regular
						["A", "B", "C"])
						~?=
						"A:B:C")
					 , "(A:B:C)" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.account Posting.Type_Virtual
						["A", "B", "C"])
						~?=
						"(A:B:C)")
					 , "[A:B:C]" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.account Posting.Type_Virtual_Balanced
						["A", "B", "C"])
						~?=
						"[A:B:C]")
					 ]
				 , "amount" ~: TestList
					 [ "nil" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil)
						~?=
						"0")
					 , "nil @ prec=2" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.style = Amount.Style.nil
							 { Amount.Style.precision = 2 }
						 })
						~?=
						"0.00")
					 , "123" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 0 123
						 })
						~?=
						"123")
					 , "-123" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 0 (- 123)
						 })
						~?=
						"-123")
					 , "12.3 @ prec=0" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 1 123
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 }
						 })
						~?=
						"12")
					 , "12.5 @ prec=0" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 1 125
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 }
						 })
						~?=
						"13")
					 , "12.3 @ prec=1" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 1 123
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 1
							 }
						 })
						~?=
						"12.3")
					 , "1,234.56 @ prec=2" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 2 123456
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 2
							 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
							 }
						 })
						~?=
						"1,234.56")
					 , "123,456,789,01,2.3456789 @ prec=7" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 7 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 7
							 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
							 }
						 })
						~?=
						"123,456,789,01,2.3456789")
					 , "1234567.8,90,123,456,789 @ prec=12" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 12 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 12
							 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
							 }
						 })
						~?=
						"1234567.8,90,123,456,789")
					 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 7 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 7
							 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
							 }
						 })
						~?=
						"1,2,3,4,5,6,7,89,012.3456789")
					 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.amount
						Amount.nil
						 { Amount.quantity = Decimal 12 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 12
							 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
							 }
						 })
						~?=
						"1234567.890,12,3,4,5,6,7,8,9")
					 ]
				 , "amount_length" ~: TestList
					 [ "nil" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil)
						~?=
						1)
					 , "nil @ prec=2" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.style = Amount.Style.nil
							 { Amount.Style.precision = 2 }
						 })
						~?=
						4)
					 , "123" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 0 123
						 })
						~?=
						3)
					 , "-123" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 0 (- 123)
						 })
						~?=
						4)
					 , "12.3 @ prec=0" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 1 123
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 }
						 })
						~?=
						2)
					 , "12.5 @ prec=0" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 1 125
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 }
						 })
						~?=
						2)
					 , "12.3 @ prec=1" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 1 123
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 1
							 }
						 })
						~?=
						4)
					 , "1,234.56 @ prec=2" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 2 123456
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 2
							 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3]
							 }
						 })
						~?=
						8)
					 , "123,456,789,01,2.3456789 @ prec=7" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 7 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 7
							 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [1, 2, 3]
							 }
						 })
						~?=
						24)
					 , "1234567.8,90,123,456,789 @ prec=12" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 12 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 12
							 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [1, 2, 3]
							 }
						 })
						~?=
						24)
					 , "1,2,3,4,5,6,7,89,012.3456789 @ prec=7" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 7 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 7
							 , Amount.Style.grouping_integral = Just $ Amount.Style.Grouping ',' [3, 2, 1]
							 }
						 })
						~?=
						28)
					 , "1234567.890,12,3,4,5,6,7,8,9 @ prec=12" ~:
						((Format.Ledger.Write.amount_length
						Amount.nil
						 { Amount.quantity = Decimal 12 1234567890123456789
						 , Amount.style = Amount.Style.nil
							 { Amount.Style.fractioning = Just '.'
							 , Amount.Style.precision = 12
							 , Amount.Style.grouping_fractional = Just $ Amount.Style.Grouping ',' [3, 2, 1]
							 }
						 })
						~?=
						28)
					 ]
				 , "date" ~: TestList
					 [ "nil" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.date
						Date.nil)
						~?=
						"1970/01/01")
					 , "2000/01/01 12:34:51 CET" ~:
						(Format.Ledger.Write.show False $
						Format.Ledger.Write.date $
						Time.ZonedTime
						 (Time.LocalTime
							 (Time.fromGregorian 2000 01 01)
							 (Time.TimeOfDay 12 34 51))
						 (Time.TimeZone 60 False "CET"))
						~?=
						"2000/01/01 12:34:51 CET"
					 , "2000/01/01 12:34:51 +0100" ~:
						(Format.Ledger.Write.show False $
						Format.Ledger.Write.date $
						Time.ZonedTime
						 (Time.LocalTime
							 (Time.fromGregorian 2000 01 01)
							 (Time.TimeOfDay 12 34 51))
						 (Time.TimeZone 60 False ""))
						~?=
						"2000/01/01 12:34:51 +0100"
					 , "2000/01/01 01:02:03" ~:
						(Format.Ledger.Write.show False $
						Format.Ledger.Write.date $
						Time.ZonedTime
						 (Time.LocalTime
							 (Time.fromGregorian 2000 01 01)
							 (Time.TimeOfDay 1 2 3))
						 (Time.utc))
						~?=
						"2000/01/01 01:02:03"
					 , "01/01 01:02" ~:
						(Format.Ledger.Write.show False $
						Format.Ledger.Write.date $
						Time.ZonedTime
						 (Time.LocalTime
							 (Time.fromGregorian 0 01 01)
							 (Time.TimeOfDay 1 2 0))
						 (Time.utc))
						~?=
						"01/01 01:02"
					 , "01/01 01:00" ~:
						(Format.Ledger.Write.show False $
						Format.Ledger.Write.date $
						Time.ZonedTime
						 (Time.LocalTime
							 (Time.fromGregorian 0 01 01)
							 (Time.TimeOfDay 1 0 0))
						 (Time.utc))
						~?=
						"01/01 01:00"
					 , "01/01 00:01" ~:
						(Format.Ledger.Write.show False $
						Format.Ledger.Write.date $
						Time.ZonedTime
						 (Time.LocalTime
							 (Time.fromGregorian 0 01 01)
							 (Time.TimeOfDay 0 1 0))
						 (Time.utc))
						~?=
						"01/01 00:01"
					 , "01/01" ~:
						(Format.Ledger.Write.show False $
						Format.Ledger.Write.date $
						Time.ZonedTime
						 (Time.LocalTime
							 (Time.fromGregorian 0 01 01)
							 (Time.TimeOfDay 0 0 0))
						 (Time.utc))
						~?=
						"01/01"
					 ]
				 , "transaction" ~: TestList
					 [ "nil" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.transaction
						Transaction.nil)
						~?=
						"1970/01/01\n")
					 , "2000/01/01 some description\\n\\ta:b:c\\n\\t\\t; first comment\\n\\t\\t; second comment\\n\\t\\t; third comment\\n\\tA:B:C  $1" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.transaction $
						Transaction.nil
						 { Transaction.dates=
							 ( Time.ZonedTime
								 (Time.LocalTime
									 (Time.fromGregorian 2000 01 01)
									 (Time.TimeOfDay 0 0 0))
								 (Time.utc)
							 , [] )
						 , Transaction.description="some description"
						 , Transaction.postings = Posting.from_List
							 [ Posting.nil
								 { Posting.account = ["A","B","C"]
								 , Posting.amounts = Data.Map.fromList
									 [ ("$", Amount.nil
										 { Amount.quantity = 1
										 , Amount.style = Amount.Style.nil
											 { Amount.Style.unit_side = Just Amount.Style.Side_Left
											 , Amount.Style.unit_spaced = Just False
											 }
										 , Amount.unit = "$"
										 })
									 ]
								 }
							 , Posting.nil
								 { Posting.account = ["a","b","c"]
								 , Posting.comments = ["first comment","second comment","third comment"]
								 }
							 ]
						 })
						~?=
						"2000/01/01 some description\n\ta:b:c\n\t\t; first comment\n\t\t; second comment\n\t\t; third comment\n\tA:B:C  $1")
					 , "2000/01/01 some description\\n\\tA:B:C       $1\\n\\tAA:BB:CC  $123" ~:
						((Format.Ledger.Write.show False $
						Format.Ledger.Write.transaction $
						Transaction.nil
						 { Transaction.dates=
							 ( Time.ZonedTime
								 (Time.LocalTime
									 (Time.fromGregorian 2000 01 01)
									 (Time.TimeOfDay 0 0 0))
								 (Time.utc)
							 , [] )
						 , Transaction.description="some description"
						 , Transaction.postings = Posting.from_List
							 [ Posting.nil
								 { Posting.account = ["A","B","C"]
								 , Posting.amounts = Data.Map.fromList
									 [ ("$", Amount.nil
										 { Amount.quantity = 1
										 , Amount.style = Amount.Style.nil
											 { Amount.Style.unit_side = Just Amount.Style.Side_Left
											 , Amount.Style.unit_spaced = Just False
											 }
										 , Amount.unit = "$"
										 })
									 ]
								 }
							 , Posting.nil
								 { Posting.account = ["AA","BB","CC"]
								 , Posting.amounts = Data.Map.fromList
									 [ ("$", Amount.nil
										 { Amount.quantity = 123
										 , Amount.style = Amount.Style.nil
											 { Amount.Style.unit_side = Just Amount.Style.Side_Left
											 , Amount.Style.unit_spaced = Just False
											 }
										 , Amount.unit = "$"
										 })
									 ]
								 }
							 ]
						 })
						~?=
						"2000/01/01 some description\n\tA:B:C       $1\n\tAA:BB:CC  $123")
					 ]
				 ]
			 ]
		 ]
	 ]