{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

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

import           Control.Applicative (Applicative(..))
import           Control.Monad (Monad(..))
import           Control.Monad.IO.Class (liftIO)
import           Data.Bool (Bool(..))
import           Data.Decimal (DecimalRaw(..))
import qualified Data.Either
import           Data.Either (rights, either)
import           Data.Eq (Eq(..))
import           Data.Function (($), (.), id, const)
import           Data.Functor (Functor(..), (<$>))
import           Data.List ((++))
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..), maybe)
import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Time.Calendar  as Time
import qualified Data.Time.LocalTime as Time
import           System.IO (IO)
import qualified Text.Parsec     as R hiding (char, space, spaces, string)
import qualified Text.Parsec.Pos as R

import qualified Hcompta.Chart as Chart
import qualified Hcompta.Date as Date
import qualified Hcompta.Lib.Parsec as R
import qualified Hcompta.Posting as Posting
import qualified Hcompta.Tag as Tag
import qualified Hcompta.Transaction as Transaction

import qualified Hcompta.Format.Ledger       as Ledger
import qualified Hcompta.Format.Ledger.Read  as Ledger
import qualified Hcompta.Format.Ledger.Write as Ledger

deriving instance Eq Ledger.Amount

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

test :: Test
test = TestList
 [ "Read" ~: TestList
	 [ "read_date" ~:
		let (==>) (txt::Text) =
			(~:) (Text.unpack txt) .
			(~?=)
			 (rights [R.runParser_with_Error
				 (Ledger.read_date id Nothing <* R.eof) () "" txt])
		in TestList $
		 [ "2000-01-01" ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 0 0 0))
				 (Time.utc) ]
		 , "2000/01/01" ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 0 0 0))
				 (Time.utc) ]
		 , "2000-01-01_12:34" ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 12 34 0))
				 (Time.utc) ]
		 , "2000-01-01_12:34:56" ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 12 34 56))
				 (Time.utc) ]
		 , "2000-01-01_12:34_CET" ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 12 34 0))
				 (Time.TimeZone 60 True "CET") ]
		 , "2000-01-01_12:34+01:30" ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 12 34 0))
				 (Time.TimeZone 90 False "+01:30") ]
		 , "2000-01-01_12:34:56_CET" ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 12 34 56))
				 (Time.TimeZone 60 True "CET") ]
		 , "2001-02-29" ==> []
		 ] ++
		let (==>) (txt::Text, def) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser_with_Error
				 (Ledger.read_date id (Just def) <* R.eof) () "" txt])
		in
		 [ ("01-01", 2000) ==>
			 [ Time.zonedTimeToUTC $
				Time.ZonedTime
				 (Time.LocalTime
					 (Time.fromGregorian 2000 01 01)
					 (Time.TimeOfDay 0 0 0))
				 (Time.utc)]
		 ]
	 , "read_account_section" ~:
		let (==>) (txt::Text) b =
			(~:) (Text.unpack txt) $
			(~?=)
			 (rights [R.runParser (Ledger.read_account_section <* R.eof) () "" txt])
			 (if b then [txt] else [])
		in TestList
		 [ ""      ==> False
		 , "A"     ==> True
		 , "AA"    ==> True
		 , " "     ==> False
		 , ":"     ==> False
		 , "A:"    ==> False
		 , ":A"    ==> False
		 , "A "    ==> False
		 , "A A"   ==> True
		 , "A "    ==> False
		 , "A\t"   ==> False
		 , "A \n"  ==> False
		 , "(A)A"  ==> True
		 , "( )A"  ==> True
		 , "(A) A" ==> True
		 , "[ ] A" ==> True
		 , "(A)  " ==> False
		 , "(A)"   ==> True
		 , "A(A)"  ==> True
		 , "[A]A"  ==> True
		 , "[A] A" ==> True
		 , "[A]  " ==> False
		 , "[A]"   ==> True
		 , "\"A \"" ~:
			 (rights
				[R.runParser
				 (Ledger.read_account_section)
				 () "" ("A "::Text)])
			 ~?=
			 ["A"]
		 ]
	 , "read_account" ~:
		let (==>) (txt::Text) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser
				 (Ledger.read_account <* R.eof) () "" txt])
		in TestList
		 [ "" ==> []
		 , "A" ==> ["A":|[]]
		 , "A:" ==> []
		 , ":A" ==> []
		 , "A " ==> []
		 , " A" ==> []
		 , "A:B" ==> ["A":|["B"]]
		 , "A:B:C" ==> ["A":|["B","C"]]
		 , "Aa:Bbb:Cccc" ==> ["Aa":|["Bbb", "Cccc"]]
		 , "A a : B b b : C c c c" ==> ["A a ":|[" B b b ", " C c c c"]]
		 , "A: :C" ==> ["A":|[" ", "C"]]
		 , "A::C" ==> []
		 , "A:B:(C)" ==> ["A":|["B", "(C)"]]
		 ]
	 , "read_amount" ~:
		let (==>) (txt::Text) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser (Ledger.read_amount <* R.eof) () "" txt])
		in TestList
		 [ ""  ==> []
		 , "0" ==>
			 [( mempty
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
		 , "00" ==>
			 [( mempty
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
		 , "0." ==>
			 [( mempty { Ledger.amount_style_fractioning = Just '.' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
		 , ".0" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just '.' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
		 , "0," ==>
			 [( mempty { Ledger.amount_style_fractioning = Just ',' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
		 , ",0" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just ',' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
		 , "0_" ==> []
		 , "_0" ==> []
		 , "0.0" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just '.' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
		 , "00.00" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just '.' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
		 , "0,0" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just ',' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 1 0 } )]
		 , "00,00" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just ',' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
		 , "0_0" ==>
			 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
		 , "00_00" ==>
			 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 0 } )]
		 , "0,000.00" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning       = Just '.'
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
		 , "0.000,00" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning       = Just ','
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )]
		 , "1,000.00" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning       = Just '.'
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 100000 } )]
		 , "1.000,00" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning       = Just ','
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 100000 } )]
		 , "1,000.00." ==> []
		 , "1.000,00," ==> []
		 , "1,000.00_" ==> []
		 , "123" ==>
			 [( mempty
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
		 , "1.2" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just '.' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
		 , "1,2" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just ',' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 1 12 } )]
		 , "12.34" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just '.' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
		 , "12,34" ==>
			 [( mempty { Ledger.amount_style_fractioning = Just ',' }
				, Ledger.amount { Ledger.amount_quantity = Decimal 2 1234 } )]
		 , "1_2" ==>
			 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [1] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 12 } )]
		 , "1_23" ==>
			 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [2] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )]
		 , "1_23_456" ==>
			 [( mempty { Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '_' [3, 2] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 0 123456 } )]
		 , "1_23_456,7890_12345_678901" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning         = Just ','
				 , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '_' [3, 2]
				 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
		 , "1_23_456.7890_12345_678901" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning         = Just '.'
				 , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '_' [3, 2]
				 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
		 , "1,23,456.7890_12345_678901" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning         = Just '.'
				 , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping ',' [3, 2]
				 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
		 , "1.23.456,7890_12345_678901" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning         = Just ','
				 , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '.' [3, 2]
				 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 15 123456789012345678901 } )]
		 , "123456_78901_2345.678_90_1" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning         = Just '.'
				 , Ledger.amount_style_grouping_integral   = Just $ Ledger.Amount_Style_Grouping '_' [4, 5, 6]
				 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [3, 2] }
				, Ledger.amount { Ledger.amount_quantity = Decimal 6 123456789012345678901 } )]
		 , "$1" ==>
			 [( mempty
				 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
				 , Ledger.amount_style_unit_spaced = Just False }
			 , Ledger.amount
				 { Ledger.amount_quantity = Decimal 0 1
				 , Ledger.amount_unit     = "$" } )]
		 , "1$" ==>
			 [( mempty
				 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Right
				 , Ledger.amount_style_unit_spaced = Just False }
			 , Ledger.amount
				 { Ledger.amount_quantity = Decimal 0 1
				 , Ledger.amount_unit     = "$" } )]
		 , "$ 1" ==>
			 [( mempty
				 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
				 , Ledger.amount_style_unit_spaced = Just True }
			 , Ledger.amount
				 { Ledger.amount_quantity = Decimal 0 1
				 , Ledger.amount_unit     = "$" } )]
		 , "1 $" ==>
			 [( mempty
				 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Right
				 , Ledger.amount_style_unit_spaced = Just True }
			 , Ledger.amount
				 { Ledger.amount_quantity = Decimal 0 1
				 , Ledger.amount_unit     = "$" } )]
		 , "-$1" ==>
			 [( mempty
				 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
				 , Ledger.amount_style_unit_spaced = Just False }
			 , Ledger.amount
				 { Ledger.amount_quantity = Decimal 0 (-1)
				 , Ledger.amount_unit     = "$" } )]
		 , "\"4 2\"1" ==>
			 [( mempty
				 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
				 , Ledger.amount_style_unit_spaced = Just False }
			 , Ledger.amount
				 { Ledger.amount_quantity = Decimal 0 1
				 , Ledger.amount_unit     = "4 2" } )]
		 , "1\"4 2\"" ==>
			 [( mempty
				 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Right
				 , Ledger.amount_style_unit_spaced = Just False }
			 , Ledger.amount
				 { Ledger.amount_quantity = Decimal 0 1
				 , Ledger.amount_unit     = "4 2" } )]
		 , "$1.000,00" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning       = Just ','
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3]
				 , Ledger.amount_style_unit_side         = Just Ledger.Amount_Style_Side_Left
				 , Ledger.amount_style_unit_spaced       = Just False }
				, Ledger.amount
				 { Ledger.amount_quantity = Decimal 2 100000
				 , Ledger.amount_unit     = "$" } )]
		 , "1.000,00$" ==>
			 [( mempty
				 { Ledger.amount_style_fractioning       = Just ','
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping '.' [3]
				 , Ledger.amount_style_unit_side         = Just Ledger.Amount_Style_Side_Right
				 , Ledger.amount_style_unit_spaced       = Just False }
				, Ledger.amount
				 { Ledger.amount_quantity = Decimal 2 100000
				 , Ledger.amount_unit     = "$" } )]
		 ]
	 , "read_posting_type" ~:
		let (==>) a (ty, ac) =
			let read (t::Text) = rights [R.runParser
				 (Ledger.read_account <* R.eof) () "" t] in
			(~:) (Text.unpack a) $
			(~?=)
			 (Ledger.read_posting_type <$> read a)
			 (Ledger.Posting_Typed ty  <$> read (maybe a id ac))
		in TestList
		 [ "A"       ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "("       ==> (Ledger.Posting_Type_Regular, Nothing)
		 , ")"       ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "()"      ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "( )"     ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "(A)"     ==> (Ledger.Posting_Type_Virtual, Just "A")
		 , "(A:B:C)" ==> (Ledger.Posting_Type_Virtual, Just "A:B:C")
		 , "A:B:C"   ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "(A):B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "A:(B):C" ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "A:B:(C)" ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "["       ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "]"       ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "[]"      ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "[ ]"     ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "[A]"     ==> (Ledger.Posting_Type_Virtual_Balanced, Just "A")
		 , "[A:B:C]" ==> (Ledger.Posting_Type_Virtual_Balanced, Just "A:B:C")
		 , "A:B:C"   ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "[A]:B:C" ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "A:[B]:C" ==> (Ledger.Posting_Type_Regular, Nothing)
		 , "A:B:[C]" ==> (Ledger.Posting_Type_Regular, Nothing)
		 ]
	 , "read_comment" ~:
		let (==>) (txt::Text, end) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser (Ledger.read_comment <* end) () "" txt])
		in TestList
		 [ ("; some comment", R.eof) ==> [" some comment"]
		 , ("; some comment \n", R.newline <* R.eof) ==> [ " some comment " ]
		 , ("; some comment \r\n", R.string "\r\n" <* R.eof) ==> [ " some comment " ]
		 ]
	 , "read_comments" ~:
		let (==>) (txt::Text, end) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser (Ledger.read_comments <* end) () "" txt])
		in TestList
		 [ ("; some comment\n  ; some other comment", R.eof) ==> [ [" some comment", " some other comment"] ]
		 , ("; some comment \n", R.string "\n" <* R.eof) ==> [ [" some comment "] ]
		 ]
	 , "read_tag_value" ~:
		let (==>) (txt::Text, end) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser (Ledger.read_tag_value <* end) () "" txt])
		in TestList
		 [ (",", R.eof) ==> [","]
		 , (",\n", R.char '\n' <* R.eof) ==> [","]
		 , (",x", R.eof) ==> [",x"]
		 , (",x:", R.string ",x:" <* R.eof) ==> [""]
		 , ("v, v, n:", R.string ", n:" <* R.eof) ==> ["v, v"]
		 ]
	 , "read_tag" ~:
		let (==>) (txt::Text, end) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser (Ledger.read_tag <* end) () "" txt])
		in TestList
		 [ ("Name:"        , R.eof)                    ==> [("Name":|[], "")]
		 , ("Name:Value"   , R.eof)                    ==> [("Name":|[], "Value")]
		 , ("Name:Value\n" , R.string "\n" <* R.eof)   ==> [("Name":|[], "Value")]
		 , ("Name:Val ue"  , R.eof)                    ==> [("Name":|[], "Val ue")]
		 , ("Name:,"       , R.eof)                    ==> [("Name":|[], ",")]
		 , ("Name:Val,ue"  , R.eof)                    ==> [("Name":|[], "Val,ue")]
		 , ("Name:Val,ue:" , R.string ",ue:" <* R.eof) ==> [("Name":|[], "Val")]
		 , ("Name:Val,ue :", R.eof)                    ==> [("Name":|[], "Val,ue :")]
		 ]
	 , "read_tags" ~:
		let (==>) (txt::Text) =
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser (Ledger.read_tags <* R.eof) () "" txt]) .
			pure . Map.fromList
		in TestList
		 [ "Name:" ==> [ ("Name":|[], [""]) ]
		 , "Name:," ==> [ ("Name":|[], [","]) ]
		 , "Name:,Name:" ==> [ ("Name":|[], ["", ""]) ]
		 , "Name:,Name2:" ==>
			 [ ("Name":|[], [""])
			 , ("Name2":|[], [""])
			 ]
		 , "Name: , Name2:" ==>
			 [ ("Name":|[], [" "])
			 , ("Name2":|[], [""])
			 ]
		 , "Name:,Name2:,Name3:" ==>
			 [ ("Name":|[], [""])
			 , ("Name2":|[], [""])
			 , ("Name3":|[], [""])
			 ]
		 , "Name:Val ue,Name2:V a l u e,Name3:V al ue" ==>
			 [ ("Name":|[], ["Val ue"])
			 , ("Name2":|[], ["V a l u e"])
			 , ("Name3":|[], ["V al ue"])
			 ]
		 ]
	 , "read_posting" ~:
		let (==>) (txt::Text) =
			let read_context =
				 ( Ledger.read_context (const ()) Ledger.journal
				 ::Ledger.Read_Context ()        ()) in
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser_with_Error
				 (Ledger.read_posting <* R.eof) read_context "" txt]) .
			fmap (\p -> Ledger.Posting_Typed Ledger.Posting_Type_Regular
				p { Ledger.posting_sourcepos = R.newPos "" 1 1 })
		in TestList
		 [ " A:B:C" ==> [Ledger.posting ("A":|["B", "C"])]
		 , "A:B:C" ==> []
		 , " !A:B:C" ==> [(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_status = True }]
		 , " *A:B:C" ==> [(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_status = True }]
		 , " A:B:C $1" ==> [Ledger.posting ("A":|["B", "C $1"])]
		 , " A:B:C  $1" ==> [(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_amounts = Map.fromList [("$", 1)] }]
		 , " A:B:C  $1 + 1€" ==> [(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_amounts = Map.fromList [("$", 1), ("€", 1)] }]
		 , " A:B:C  $1 + 1$" ==> [(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_amounts = Map.fromList [("$", 2)] }]
		 , " A:B:C  $1 + 1$ + 1$" ==> [(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_amounts = Map.fromList [("$", 3)] }]
		 , " A:B:C ; some comment" ==> [(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_amounts  = Map.fromList []
			 , Ledger.posting_comments = [" some comment"] }]
		 , " A:B:C ; some comment\n  ; some other comment" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_amounts  = Map.fromList []
			 , Ledger.posting_comments = [" some comment", " some other comment"] }]
		 , " A:B:C  $1 ; some comment" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_amounts  = Map.fromList [("$", 1)]
			 , Ledger.posting_comments = [" some comment"] }]
		 , " A:B:C ; N:V" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_comments = [" N:V"]
			 , Ledger.posting_tags     = Posting.Posting_Tags $
				Tag.from_List [ ("N":|[], "V") ] }]
		 , " A:B:C ; some comment N:V" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_comments = [" some comment N:V"]
			 , Ledger.posting_tags = Posting.Posting_Tags $
				Tag.from_List [ ("N":|[], "V") ] }]
		 , " A:B:C ; some comment N:V v, N2:V2 v2" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_comments = [" some comment N:V v, N2:V2 v2"]
			 , Ledger.posting_tags     = Posting.Posting_Tags $
				Tag.from_List
				 [ ("N":|[], "V v")
				 , ("N2":|[], "V2 v2") ] }]
		 , " A:B:C ; N:V\n ; N:V2" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_comments = [" N:V", " N:V2"]
			 , Ledger.posting_tags     = Posting.Posting_Tags $
				Tag.from_List
				 [ ("N":|[], "V")
				 , ("N":|[], "V2")
				 ] }]
		 , " A:B:C ; N:V\n ; N2:V" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_comments = [" N:V", " N2:V"]
			 , Ledger.posting_tags     = Posting.Posting_Tags $
				Tag.from_List
				 [ ("N":|[], "V")
				 , ("N2":|[], "V")
				 ] }]
		 , " A:B:C ; date:2001-01-01" ==>
			[(Ledger.posting ("A":|["B", "C"]))
			 { Ledger.posting_comments = [" date:2001-01-01"]
			 , Ledger.posting_dates =
				 [ Time.zonedTimeToUTC $
					Time.ZonedTime
					 (Time.LocalTime
						 (Time.fromGregorian 2001 01 01)
						 (Time.TimeOfDay 0 0 0))
					 Time.utc
				 ]
			 , Ledger.posting_tags = Posting.Posting_Tags $
				Tag.from_List
				 [ ("date":|[], "2001-01-01") ] }]
		 , " (A:B:C) = Right (A:B:C)" ~:
			 (rights [R.runParser_with_Error
				 (Ledger.read_posting <* R.eof)
					 ( Ledger.read_context (const ()) Ledger.journal
					 ::Ledger.Read_Context () ())
					 "" (" (A:B:C)"::Text)]) ~?=
			 [Ledger.Posting_Typed
				 Ledger.Posting_Type_Virtual
				 (Ledger.posting ("A":|["B", "C"]))]
		 , " [A:B:C] = Right [A:B:C]" ~:
			 (rights [R.runParser_with_Error
				 (Ledger.read_posting <* R.eof)
					 ( Ledger.read_context (const ()) Ledger.journal
					 ::Ledger.Read_Context () ())
					 "" (" [A:B:C]"::Text)]) ~?=
			 [Ledger.Posting_Typed
				 Ledger.Posting_Type_Virtual_Balanced
				 (Ledger.posting ("A":|["B", "C"]))]
		 ]
	 , "read_transaction" ~:
		let (==>) (txt::Text) =
			let read_context =
				 ( Ledger.read_context (const ()) Ledger.journal
				 ::Ledger.Read_Context () ()) in
			(~:) (Text.unpack txt) .
			(~?=) (rights [R.runParser_with_Error
				 (Ledger.read_transaction <* R.eof) read_context "" txt]) .
			fmap (\t -> t { Ledger.transaction_sourcepos = R.newPos "" 1 1 })
		in TestList
		 [ "2000-01-01 some wording\n A:B:C  $1\n a:b:c" ==>
			[Ledger.transaction
			 { Ledger.transaction_dates=
				 ( Time.zonedTimeToUTC $
					Time.ZonedTime
					 (Time.LocalTime
						 (Time.fromGregorian 2000 01 01)
						 (Time.TimeOfDay 0 0 0))
					 (Time.utc)
				 , [] )
			 , Ledger.transaction_wording="some wording"
			 , Ledger.transaction_postings = Ledger.postings_by_account
				 [ (Ledger.posting ("A":|["B", "C"]))
					 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
					 , Ledger.posting_sourcepos = R.newPos "" 2 1 }
				 , (Ledger.posting ("a":|["b", "c"]))
					 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
					 , Ledger.posting_sourcepos = R.newPos "" 3 1 }
				 ]
			 }]
		 , "2000-01-01 some wording\n A:B:C  $1\n a:b:c\n" ==> []
		 , "2000-01-01 some wording  ;  some comment\n ; some other;comment\n ; some Tag:\n ; some last comment\n A:B:C  $1\n a:b:c" ==>
			[Ledger.transaction
			 { Ledger.transaction_comments_after =
				 [ "  some comment"
				 , " some other;comment"
				 , " some Tag:"
				 , " some last comment"
				 ]
			 , Ledger.transaction_dates=
				 ( Time.zonedTimeToUTC $
					Time.ZonedTime
					 (Time.LocalTime
						 (Time.fromGregorian 2000 01 01)
						 (Time.TimeOfDay 0 0 0))
					 (Time.utc)
				 , [] )
			 , Ledger.transaction_wording="some wording"
			 , Ledger.transaction_postings = Ledger.postings_by_account
				 [ (Ledger.posting ("A":|["B", "C"]))
					 { Ledger.posting_amounts = Map.fromList [ ("$", 1) ]
					 , Ledger.posting_sourcepos = R.newPos "" 5 1 }
				 , (Ledger.posting ("a":|["b", "c"]))
					 { Ledger.posting_amounts = Map.fromList [ ("$", -1) ]
					 , Ledger.posting_sourcepos = R.newPos "" 6 1 } ]
			 , Ledger.transaction_tags = Transaction.Transaction_Tags $
				Tag.from_List [ ("Tag":|[], "") ] }]
		 ]
	 , "read_journal" ~: TestList
		 [ "2000-01-01 1° wording\\n A:B:C  $1\\n a:b:c\\n2000-01-02 2° wording\\n A:B:C  $1\\n x:y:z" ~: TestCase $ do
			jnl <- liftIO $
				R.runParserT_with_Error
				 (Ledger.read_journal "" {-<* R.eof-})
					 ( Ledger.read_context id  Ledger.journal
					 ::Ledger.Read_Context (Ledger.Charted Ledger.Transaction)
					                      ([Ledger.Charted Ledger.Transaction]))
					 "" ("2000-01-01 1° wording\n A:B:C  $1\n a:b:c\n2000-01-02 2° wording\n A:B:C  $1\n x:y:z"::Text)
			((\j -> j{Ledger.journal_last_read_time=Date.nil}) <$>
				Data.Either.rights [jnl])
			 @?=
			 [Ledger.journal
				 { Ledger.journal_content =
					 fmap (Chart.Charted mempty) $
					 [ Ledger.transaction
						 { Ledger.transaction_dates=
							 ( Time.zonedTimeToUTC $
								Time.ZonedTime
								 (Time.LocalTime
									 (Time.fromGregorian 2000 01 02)
									 (Time.TimeOfDay 0 0 0))
								 (Time.utc)
							 , [] )
						 , Ledger.transaction_wording="2° wording"
						 , Ledger.transaction_postings = Ledger.postings_by_account
							 [ (Ledger.posting ("A":|["B", "C"]))
								 { Ledger.posting_amounts = Map.fromList
									 [ ("$", 1)
									 ]
								 , Ledger.posting_sourcepos = R.newPos "" 5 1
								 }
							 , (Ledger.posting ("x":|["y", "z"]))
								 { Ledger.posting_amounts = Map.fromList
									 [ ("$", -1)
									 ]
								 , Ledger.posting_sourcepos = R.newPos "" 6 1
								 }
							 ]
						 , Ledger.transaction_sourcepos = R.newPos "" 4 1
						 }
					 , Ledger.transaction
						 { Ledger.transaction_dates=
							 ( Time.zonedTimeToUTC $
								Time.ZonedTime
								 (Time.LocalTime
									 (Time.fromGregorian 2000 01 01)
									 (Time.TimeOfDay 0 0 0))
								 (Time.utc)
							 , [] )
						 , Ledger.transaction_wording="1° wording"
						 , Ledger.transaction_postings = Ledger.postings_by_account
							 [ (Ledger.posting ("A":|["B", "C"]))
								 { Ledger.posting_amounts = Map.fromList
									 [ ("$", 1)
									 ]
								 , Ledger.posting_sourcepos = R.newPos "" 2 1
								 }
							 , (Ledger.posting ("a":|["b", "c"]))
								 { Ledger.posting_amounts = Map.fromList
									 [ ("$", -1)
									 ]
								 , Ledger.posting_sourcepos = R.newPos "" 3 1
								 }
							 ]
						 , Ledger.transaction_sourcepos = R.newPos "" 1 1
						 }
					 ]
				 , Ledger.journal_files = [""]
				 , Ledger.journal_amount_styles = Ledger.Amount_Styles $ Map.fromList
					 [ ( Ledger.Unit "$"
						 , mempty
							 { Ledger.amount_style_unit_side   = Just Ledger.Amount_Style_Side_Left
							 , Ledger.amount_style_unit_spaced = Just False }
						 )
					 ]
				 }
			 ]
		 ]
	 ]
 , "Write" ~: TestList
	 [ "write_date" ~:
		let (==>) (txt::Text) e =
			(~:) (Text.unpack txt) $
			(~?=)
			 (Ledger.write
				Ledger.write_style
				 { Ledger.write_style_color = False
				 , Ledger.write_style_align = True } .
				Ledger.write_date <$>
				rights [R.runParser_with_Error
				 (Ledger.read_date id Nothing <* R.eof) () "" txt])
			 [e]
		in TestList
		 [ "" ~:
			((Ledger.write
			Ledger.write_style
			 { Ledger.write_style_color = False
			 , Ledger.write_style_align = True } $
			Ledger.write_date Date.nil)
			~?= "1970-01-01")
		 , "2000-01-01"                ==> "2000-01-01"
		 , "2000-01-01_12:34:51_CET"   ==> "2000-01-01_11:34:51"
		 , "2000-01-01_12:34:51+01:10" ==> "2000-01-01_11:24:51"
		 , "2000-01-01_12:34:51-01:10" ==> "2000-01-01_13:44:51"
		 , "2000-01-01_01:02:03"       ==> "2000-01-01_01:02:03"
		 , "2000-01-01_01:02"          ==> "2000-01-01_01:02"
		 , "2000-01-01_01:00"          ==> "2000-01-01_01:00"
		 ]
	 , "write_amount" ~:
		let (<==) (txt::Text) e =
			(~:) (Text.unpack txt) $
			(~?=)
			 (Ledger.write
				Ledger.write_style
				 { Ledger.write_style_color = False
				 , Ledger.write_style_align = True } $
				Ledger.write_amount e)
			 (TL.fromStrict txt)
		in TestList
		 [ "0" <==
			( mempty
			, Ledger.amount )
		 , "0.00" <==
			( mempty
			, Ledger.amount { Ledger.amount_quantity = Decimal 2 0 } )
		 , "123" <==
			( mempty
			, Ledger.amount { Ledger.amount_quantity = Decimal 0 123 } )
		 , "-123" <==
			( mempty
			, Ledger.amount { Ledger.amount_quantity = Decimal 0 (- 123) } )
		 , "12.3" <==
			( mempty { Ledger.amount_style_fractioning = Just '.' }
			, Ledger.amount { Ledger.amount_quantity = Decimal 1 123 } )
		 , "1,234.56" <==
			( mempty
				 { Ledger.amount_style_fractioning       = Just '.'
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3]
				 }
			, Ledger.amount { Ledger.amount_quantity = Decimal 2 123456 })
		 , "123,456,789,01,2.3456789" <==
			( mempty
				 { Ledger.amount_style_fractioning       = Just '.'
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [1, 2, 3]
				 }
			, Ledger.amount { Ledger.amount_quantity = Decimal 7 1234567890123456789 } )
		 , "1234567.8_90_123_456_789" <==
			( mempty
				 { Ledger.amount_style_fractioning         = Just '.'
				 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [1, 2, 3]
				 }
			, Ledger.amount { Ledger.amount_quantity = Decimal 12 1234567890123456789 })
		 , "1,2,3,4,5,6,7,89,012.3456789" <==
			( mempty
				 { Ledger.amount_style_fractioning       = Just '.'
				 , Ledger.amount_style_grouping_integral = Just $ Ledger.Amount_Style_Grouping ',' [3, 2, 1]
				 }
			, Ledger.amount { Ledger.amount_quantity = Decimal 7 1234567890123456789 })
		 , "1234567.890_12_3_4_5_6_7_8_9" <==
			( mempty
				 { Ledger.amount_style_fractioning         = Just '.'
				 , Ledger.amount_style_grouping_fractional = Just $ Ledger.Amount_Style_Grouping '_' [3, 2, 1]
				 }
			, Ledger.amount { Ledger.amount_quantity = Decimal 12 1234567890123456789 })
		 ]
	 , "write_amount_length" ~:
		let (==>) (txt::Text) =
			(~:) (Text.unpack txt) $
			(~?=)
			 (Ledger.write_amount_length <$>
				rights [R.runParser (Ledger.read_amount <* R.eof) () "" txt])
			 [Text.length txt]
		in TestList $ (==>) <$>
		 [ "0.00"
		 , "123"
		 , "-123"
		 , "12.3"
		 , "12.5"
		 , "12.3"
		 , "1,234.56"
		 , "123,456,789,01,2.3456789"
		 , "1234567.8_90_123_456_789"
		 , "1,2,3,4,5,6,7,89,012.3456789"
		 , "1234567.890_12_3_4_5_6_7_8_9"
		 , "1000000.000_00_0_0_0_0_0_0_0"
		 , "999"
		 , "1000"
		 , "10,00€"
		 , "10,00 €"
		 , "€10,00"
		 , "€ 10,00"
		 , "EUR 10,00"
		 , "10,00 EUR"
		 , "\"4 2\" 10,00"
		 ]
	 , "write_account" ~:
		let (==>) txt =
			(~:) (Text.unpack txt) $
			(~?=)
			 (let read (t::Text) =
					rights [R.runParser
					 (Ledger.read_account <* R.eof)
					 () "" t] in
				Ledger.write
				 Ledger.write_style
					 { Ledger.write_style_color = False
					 , Ledger.write_style_align = True } <$>
				 (read txt >>= \a ->
					let Ledger.Posting_Typed ty ac = Ledger.read_posting_type a in
					return $ Ledger.write_account ty ac)
			 )
			 [TL.fromStrict txt]
		in TestList $ (==>) <$>
		 [ "A"
		 , "(A:B:C)"
		 , "[A:B:C]"
		 ]
	 , "write_transaction" ~:
		let (==>) (txt::Text) =
			(~:) (Text.unpack txt) .
			(~?=) (
				let write (txn, ctx) =
					Ledger.write
					 Ledger.write_style
						 { Ledger.write_style_color = False
						 , Ledger.write_style_align = True } $
						let jnl = Ledger.read_context_journal ctx in
						let sty = Ledger.journal_amount_styles jnl in
						Ledger.write_transaction sty txn in
				either (const []) (pure . write) $
				R.runParser_with_Error
				 (R.and_state (Ledger.read_transaction <* R.eof))
				 ( Ledger.read_context Chart.charted Ledger.journal
				 ::Ledger.Read_Context Ledger.Transaction [Ledger.Transaction] )
				 "" txt)
		in TestList $
		 [ "2000-01-01 some wording\n A:B:C  $1\n a:b:c" ==>
			["2000-01-01 some wording\n\tA:B:C   $1\n\ta:b:c  $-1\n"]
		 , "2000-01-01 some wording\n\tA:B:C  $1\n\ta:b:c\n\t ; first comment\n\t ; second comment\n\t ; third comment" ==>
			["2000-01-01 some wording\n\tA:B:C   $1\n\ta:b:c  $-1\n\t ; first comment\n\t ; second comment\n\t ; third comment\n"]
		 , "2000-01-01 some wording\n\tA:B:C       $1\n\tAA:BB:CC  $123" ==> []
		 ] ++
		 [ "nil" ~:
			((Ledger.write
			Ledger.write_style
			 { Ledger.write_style_color = False
			 , Ledger.write_style_align = True } $
			Ledger.write_transaction
			Ledger.amount_styles
			Ledger.transaction)
			~?= "1970-01-01\n\n")
		 ]
	 ]
 ]