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