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

module Read.Test where

import           Control.Applicative (Applicative(..), (<*))
import           Control.Arrow (right)
import           Control.Monad.IO.Class (MonadIO(..))
import           Data.Bool
import           Data.Data ()
import           Data.Decimal (DecimalRaw(..))
import           Data.Either (rights)
import           Data.Function (($), (.), id, const)
import           Data.Functor ((<$>))
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..), fromMaybe)
import           Data.Monoid (Monoid(..), (<>))
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Time.Calendar  as Time
import qualified Data.Time.LocalTime as Time
import           Test.Tasty
import           Test.Tasty.HUnit
import qualified Text.Parsec as R hiding
                  ( char
                  , anyChar
                  , crlf
                  , newline
                  , noneOf
                  , oneOf
                  , satisfy
                  , space
                  , spaces
                  , string
                  , tab
                  )
import qualified Text.Parsec.Combinator.CorrectSourcePosWithTab as R
import qualified Text.Parsec.Error.Custom as R
import qualified Text.Parsec.Pos as R

import qualified Hcompta as H
import qualified Hcompta.Ledger as Ledger

tests :: TestTree
tests = testGroup "Read"
 [ testGroup "read_date" $
	(let (==>) (txt::Text) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParserWithError
		 (Ledger.read_date id Nothing <* R.eof) () "" txt]) in
	 [ "2000-01-01" ==>
		 [ Time.zonedTimeToUTC $
			Time.ZonedTime
			 (Time.LocalTime
				 (Time.fromGregorian 2000 01 01)
				 (Time.TimeOfDay 0 0 0))
			 Time.utc ]
	 , "2000/01/01" ==> []
	 , "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) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParserWithError
		 (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]
	 ])
 , testGroup "read_account_section" $
	let (==>) (txt::Text) b =
		testCase (Text.unpack txt) $
		(@?=) (rights [R.runParser
			 (Ledger.read_account_section <* R.eof) () "" txt])
		 [txt | b] in
	 [ ""      ==> 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
	 , testCase "\"A \"" $
			rights [R.runParser
			 Ledger.read_account_section
			 () "" ("A "::Text)]
		 @?=
			["A"]
	 ]
 , testGroup "read_account" $
	let (==>) (txt::Text) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParser
			 (Ledger.read_account <* R.eof) () "" txt]) in
	 [ "" ==> []
	 , "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)"] ]
	 ]
 , testGroup "read_amount" $
	let (==>) (txt::Text) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParser
			 (Ledger.read_amount <* R.eof) () "" txt]) in
	 [ ""  ==> []
	 , "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     = "$" } )]
	 ]
 , testGroup "read_posting_type" $
	let (==>) a (ty, ac) =
		let read (t::Text) = rights [R.runParser
			 (Ledger.read_account <* R.eof) () "" t] in
		testCase (Text.unpack a) $
		(@?=)
		 (Ledger.read_posting_type <$> read a)
		 (Ledger.Posting_Typed ty  <$> read (fromMaybe a ac)) in
	 [ "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)
	 ]
 , testGroup "read_comment" $
	let (==>) (txt::Text, end) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParser
			 (Ledger.read_comment <* end) () "" txt]) in
	 [ ("; 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 " ]
	 ]
 , testGroup "read_comments" $
	let (==>) (txt::Text, end) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParser
			 (Ledger.read_comments <* end) () "" txt]) in
	 [ ("; some comment\n  ; some other comment", R.eof) ==> [ [" some comment", " some other comment"] ]
	 , ("; some comment \n", R.string "\n" <* R.eof) ==> [ [" some comment "] ]
	 ]
 , testGroup "read_tag_value" $
	let (==>) (txt::Text, end) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParser
			 (Ledger.read_tag_value <* end) () "" txt]) in
	 [ (",", 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"]
	 ]
 , testGroup "read_tag" $
	let (==>) (txt::Text, end) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParser
			 (Ledger.read_tag <* end) () "" txt]) in
	 [ ("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 :") ]
	 ]
 , testGroup "read_tags" $
	let (==>) (txt::Text) =
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParser
			 (Ledger.read_tags <* R.eof) () "" txt]) .
		pure . Map.fromList in
	 [ "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"])
		 ]
	 ]
 , testGroup "read_posting" $
	let (==>) (txt::Text) =
		let context_read =
			 ( Ledger.context_read (const ()) Ledger.journal
			 ::Ledger.Context_Read ()        ()) in
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParserWithError
			 (Ledger.read_posting <* R.eof) context_read "" txt]) .
		((\p -> Ledger.Posting_Typed Ledger.Posting_Type_Regular
			p { Ledger.posting_sourcepos = R.newPos "" 1 1 }) <$>) in
	 [ " 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     = H.Posting_Tags $
			H.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 = H.Posting_Tags $
			H.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     = H.Posting_Tags $
			H.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     = H.Posting_Tags $
			H.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     = H.Posting_Tags $
			H.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 = H.Posting_Tags $
			H.tag_from_List
			 [ ("date":|[], "2001-01-01") ] }]
	 , testCase " (A:B:C) = Right (A:B:C)" $
			rights [R.runParserWithError
			 (Ledger.read_posting <* R.eof)
				 ( Ledger.context_read (const ()) Ledger.journal
				 ::Ledger.Context_Read () ())
				 "" (" (A:B:C)"::Text)] @?=
		 [Ledger.Posting_Typed
			 Ledger.Posting_Type_Virtual
			 (Ledger.posting ("A":|["B", "C"]))]
	 , testCase " [A:B:C] = Right [A:B:C]" $
			rights [R.runParserWithError
			 (Ledger.read_posting <* R.eof)
				 ( Ledger.context_read (const ()) Ledger.journal
				 ::Ledger.Context_Read () ())
				 "" (" [A:B:C]"::Text)] @?=
		 [Ledger.Posting_Typed
			 Ledger.Posting_Type_Virtual_Balanced
			 (Ledger.posting ("A":|["B", "C"]))]
	 ]
 , testGroup "read_transaction" $
	let (==>) (txt::Text) =
		let context_read =
			 ( Ledger.context_read (const ()) Ledger.journal
			 ::Ledger.Context_Read () ()) in
		testCase (Text.unpack txt) .
		(@?=) (rights [R.runParserWithError
			 (Ledger.read_transaction <* R.eof) context_read "" txt]) .
		((\t -> t { Ledger.transaction_sourcepos = R.newPos "" 1 1 }) <$>) in
	 [ "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 = H.Transaction_Tags $
			H.tag_from_List [ ("Tag":|[], "") ] }]
	 ]
 , testGroup "read_journal"
	 [ testCase "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" $ do
		jnl <- liftIO $
			R.runParserTWithError
			 (Ledger.read_journal "" {-<* R.eof-})
				 ( Ledger.context_read id  Ledger.journal
				 ::Ledger.Context_Read (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=H.date_epoch}) <$> rights [jnl])
		 @?=
		 [Ledger.journal
			 { Ledger.journal_content =
				Ledger.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 }
					 )
				 ]
			 }
		 ]
	 ]
 , testGroup "read_journal" $
	let (==>) (txt::Text) e =
		testCase (Text.unpack txt) $ do
		jnl <-
			liftIO $
			right (\j -> j{Ledger.journal_last_read_time=H.date_epoch}) <$>
			R.runParserTWithError
			 (Ledger.read_journal "" {-<* R.eof-})
				 ( Ledger.context_read id  Ledger.journal
				 ::Ledger.Context_Read (Ledger.Charted Ledger.Transaction)
				                       [Ledger.Charted Ledger.Transaction])
				 "" (txt::Text)
		(@?=) (rights [jnl]) e in
	 [ Text.unlines
		 [ "2000-01-01 1° wording"
		 , " A:B:C  $1"
		 , " a:b:c"
		 , "2000-01-02 2° wording"
		 , " A:B:C  $1"
		 , " x:y:z"
		 ] ==>
		[ Ledger.journal
			 { Ledger.journal_content =
				 Ledger.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 }
					 )
				 ]
			 }
		 ]
	 ]
 ]