{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Write.Test where import Control.Applicative (Applicative(..), (<*)) import Data.Bool import Data.Data () import Data.Decimal (DecimalRaw(..)) import Data.Either (either, rights) import Data.Function (($), (.), const, id) import Data.Functor ((<$>)) import Data.Maybe (Maybe(..)) import Data.Monoid (Monoid(..)) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Lazy as TL 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 Text.Show (Show(..)) import qualified Hcompta as H import qualified Hcompta.LCC as LCC import qualified Hcompta.LCC.Lib.Parsec as R import Read.Test (test) tests :: TestTree tests = testGroup "Write" [ testGroup "write_date" $ let (==>) (txt::Text) e = test (Text.unpack txt) $ (@?=) (LCC.write LCC.write_style { LCC.write_style_color = False , LCC.write_style_align = True } . LCC.write_date <$> rights [R.runParserWithError (LCC.read_date id Nothing <* R.eof) () "" txt]) [e] in [ test "date_epoch" $ LCC.write LCC.write_style { LCC.write_style_color = False , LCC.write_style_align = True } (LCC.write_date H.date_epoch) @?= "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" ] , testGroup "write_amount" $ let (<==) (txt::Text) e = test (Text.unpack txt) $ (@?=) (LCC.write LCC.write_style { LCC.write_style_color = False , LCC.write_style_align = True } $ LCC.write_amount e) (TL.fromStrict txt) in [ "0" <== ( mempty , LCC.amount ) , "0.00" <== ( mempty , LCC.amount { LCC.amount_quantity = Decimal 2 0 } ) , "123" <== ( mempty , LCC.amount { LCC.amount_quantity = Decimal 0 123 } ) , "-123" <== ( mempty , LCC.amount { LCC.amount_quantity = Decimal 0 (- 123) } ) , "12.3" <== ( mempty { LCC.amount_style_fractioning = Just '.' } , LCC.amount { LCC.amount_quantity = Decimal 1 123 } ) , "1,234.56" <== ( mempty { LCC.amount_style_fractioning = Just '.' , LCC.amount_style_grouping_integral = Just $ LCC.Amount_Style_Grouping ',' [3] } , LCC.amount { LCC.amount_quantity = Decimal 2 123456 }) , "123,456,789,01,2.3456789" <== ( mempty { LCC.amount_style_fractioning = Just '.' , LCC.amount_style_grouping_integral = Just $ LCC.Amount_Style_Grouping ',' [1, 2, 3] } , LCC.amount { LCC.amount_quantity = Decimal 7 1234567890123456789 } ) , "1234567.8_90_123_456_789" <== ( mempty { LCC.amount_style_fractioning = Just '.' , LCC.amount_style_grouping_fractional = Just $ LCC.Amount_Style_Grouping '_' [1, 2, 3] } , LCC.amount { LCC.amount_quantity = Decimal 12 1234567890123456789 }) , "1,2,3,4,5,6,7,89,012.3456789" <== ( mempty { LCC.amount_style_fractioning = Just '.' , LCC.amount_style_grouping_integral = Just $ LCC.Amount_Style_Grouping ',' [3, 2, 1] } , LCC.amount { LCC.amount_quantity = Decimal 7 1234567890123456789 }) , "1234567.890_12_3_4_5_6_7_8_9" <== ( mempty { LCC.amount_style_fractioning = Just '.' , LCC.amount_style_grouping_fractional = Just $ LCC.Amount_Style_Grouping '_' [3, 2, 1] } , LCC.amount { LCC.amount_quantity = Decimal 12 1234567890123456789 }) ] , testGroup "write_amount_length" $ let (==>) (txt::Text) = test (Text.unpack txt) $ (@?=) (LCC.write_amount_length <$> rights [R.runParser (LCC.read_amount <* R.eof) () "" txt]) [Text.length txt] in (==>) <$> [ "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" ] , testGroup "write_account" $ let (==>) txt = test (Text.unpack txt) $ (@?=) (let read (t::Text) = rights [R.runParser (LCC.read_account <* R.eof) () "" t] in LCC.write LCC.write_style { LCC.write_style_color = False , LCC.write_style_align = True } <$> (LCC.write_account <$> read txt) ) [TL.fromStrict txt] in (==>) <$> [ "/A/B/C" ] , testGroup "write_transaction" $ let (==>) (lines::[Text]) = let txt = Text.unlines lines in test (Text.unpack txt) . (@?=) ( let write (txn, ctx) = LCC.write LCC.write_style { LCC.write_style_color = False , LCC.write_style_align = True } $ let jnl = LCC.context_read_journal ctx in let sty = LCC.journal_amount_styles jnl in LCC.write_transaction sty txn in either (const []) -- (pure . TL.pack . show) (pure . write) $ R.runParserWithError (R.and_state (LCC.read_transaction <* R.newline <* R.eof)) ( LCC.context_read LCC.charted LCC.journal ::LCC.Context_Read LCC.Transaction [LCC.Transaction] ) "" txt) . (TL.unlines <$>) in [ [ "2000-01-01 some wording" , " /A/B/C $1" , " /a/b/c" ] ==> [ [ "2000-01-01 some wording" , " /A/B/C $1" , " /a/b/c $-1" ]] , [ "2000-01-01 some wording" , " /A/B/C $1" , " /a/b/c" , " ; first comment" , " ; second comment" , " ; third comment" ] ==> [ [ "2000-01-01 some wording" , " /A/B/C $1" , " /a/b/c $-1" , " ; first comment" , " ; second comment" , " ; third comment" ]] , [ "2000-01-01 some wording" , " /A/B/C $1" , " /AA/BB/CC $123" ] ==> [] , test "empty" $ LCC.write LCC.write_style { LCC.write_style_color = False , LCC.write_style_align = True } (LCC.write_transaction LCC.amount_styles LCC.transaction) @?= "1970-01-01\n\n" ] ]