-- | Test @Builder@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} module Tests.Properties.Builder ( testBuilder ) where import Data.Int (Int8, Int16, Int32, Int64) import Data.Word import Numeric (showEFloat, showFFloat, showGFloat, showHex) import Test.QuickCheck import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck (testProperty) import Tests.QuickCheckUtils import qualified Data.List as L import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Builder.Int as TB import qualified Data.Text.Lazy.Builder.RealFloat as TB -- Builder. tb_singleton = id `eqP` (unpackS . TB.toLazyText . mconcat . map TB.singleton) tb_fromString = id `eq` (TL.unpack . TB.toLazyText . TB.fromString) tb_fromText = id `eqP` (unpackS . TB.toLazyText . TB.fromText) tb_fromStrings = L.concat `eq` (TL.unpack . TB.toLazyText . mconcat . map TB.fromString) tb_fromTexts = L.concat `eq` (unpackS . TB.toLazyText . mconcat . map (TB.fromText . packS)) tb_associative s1 s2 s3 = TB.toLazyText (b1 `mappend` (b2 `mappend` b3)) === TB.toLazyText ((b1 `mappend` b2) `mappend` b3) where b1 = TB.fromText (packS s1) b2 = TB.fromText (packS s2) b3 = TB.fromText (packS s3) -- Numeric builder stuff. tb_decimal :: (Integral a, Show a) => a -> Property tb_decimal = (TB.toLazyText . TB.decimal) `eq` (TL.pack . show) tb_decimal_integer (a::Integer) = tb_decimal a tb_decimal_integer_big (Big a) = tb_decimal a tb_decimal_int (a::Int) = tb_decimal a tb_decimal_int8 (a::Int8) = tb_decimal a tb_decimal_int16 (a::Int16) = tb_decimal a tb_decimal_int32 (a::Int32) = tb_decimal a tb_decimal_int64 (a::Int64) = tb_decimal a tb_decimal_word (a::Word) = tb_decimal a tb_decimal_word8 (a::Word8) = tb_decimal a tb_decimal_word16 (a::Word16) = tb_decimal a tb_decimal_word32 (a::Word32) = tb_decimal a tb_decimal_word64 (a::Word64) = tb_decimal a tb_decimal_big_int (Large (a::Int)) = tb_decimal a tb_decimal_big_int64 (Large (a::Int64)) = tb_decimal a tb_decimal_big_word (Large (a::Word)) = tb_decimal a tb_decimal_big_word64 (Large (a::Word64)) = tb_decimal a tb_hex :: (Integral a, Show a) => a -> Property tb_hex = (TB.toLazyText . TB.hexadecimal) `eq` (TL.pack . flip showHex "") tb_hexadecimal_integer (a::Integer) = tb_hex a tb_hexadecimal_int (a::Int) = tb_hex a tb_hexadecimal_int8 (a::Int8) = tb_hex a tb_hexadecimal_int16 (a::Int16) = tb_hex a tb_hexadecimal_int32 (a::Int32) = tb_hex a tb_hexadecimal_int64 (a::Int64) = tb_hex a tb_hexadecimal_word (a::Word) = tb_hex a tb_hexadecimal_word8 (a::Word8) = tb_hex a tb_hexadecimal_word16 (a::Word16) = tb_hex a tb_hexadecimal_word32 (a::Word32) = tb_hex a tb_hexadecimal_word64 (a::Word64) = tb_hex a tb_realfloat :: (RealFloat a, Show a) => a -> Property tb_realfloat = (TB.toLazyText . TB.realFloat) `eq` (TL.pack . show) tb_realfloat_float (a::Float) = tb_realfloat a tb_realfloat_double (a::Double) = tb_realfloat a showFloat :: (RealFloat a) => TB.FPFormat -> Maybe Int -> a -> ShowS showFloat TB.Exponent (Just 0) = showEFloat (Just 1) -- see gh-231 showFloat TB.Exponent p = showEFloat p showFloat TB.Fixed p = showFFloat p showFloat TB.Generic p = showGFloat p tb_formatRealFloat :: (RealFloat a, Show a) => a -> TB.FPFormat -> Precision a -> Property tb_formatRealFloat a fmt prec = cond ==> TB.formatRealFloat fmt p a === TB.fromString (showFloat fmt p a "") where p = precision a prec cond = case (p,fmt) of #if MIN_VERSION_base(4,12,0) (Just 0, TB.Generic) -> False -- skipping due to gh-231 #endif _ -> True tb_formatRealFloat_float (a::Float) = tb_formatRealFloat a tb_formatRealFloat_double (a::Double) = tb_formatRealFloat a testBuilder :: TestTree testBuilder = testGroup "builder" [ testProperty "tb_singleton" tb_singleton, testProperty "tb_fromString" tb_fromString, testProperty "tb_fromText" tb_fromText, testProperty "tb_fromStrings" tb_fromStrings, testProperty "tb_fromTexts" tb_fromTexts, testProperty "tb_associative" tb_associative, testGroup "decimal" [ testProperty "tb_decimal_int" tb_decimal_int, testProperty "tb_decimal_int8" tb_decimal_int8, testProperty "tb_decimal_int16" tb_decimal_int16, testProperty "tb_decimal_int32" tb_decimal_int32, testProperty "tb_decimal_int64" tb_decimal_int64, testProperty "tb_decimal_integer" tb_decimal_integer, testProperty "tb_decimal_integer_big" tb_decimal_integer_big, testProperty "tb_decimal_word" tb_decimal_word, testProperty "tb_decimal_word8" tb_decimal_word8, testProperty "tb_decimal_word16" tb_decimal_word16, testProperty "tb_decimal_word32" tb_decimal_word32, testProperty "tb_decimal_word64" tb_decimal_word64, testProperty "tb_decimal_big_int" tb_decimal_big_int, testProperty "tb_decimal_big_word" tb_decimal_big_word, testProperty "tb_decimal_big_int64" tb_decimal_big_int64, testProperty "tb_decimal_big_word64" tb_decimal_big_word64 ], testGroup "hexadecimal" [ testProperty "tb_hexadecimal_int" tb_hexadecimal_int, testProperty "tb_hexadecimal_int8" tb_hexadecimal_int8, testProperty "tb_hexadecimal_int16" tb_hexadecimal_int16, testProperty "tb_hexadecimal_int32" tb_hexadecimal_int32, testProperty "tb_hexadecimal_int64" tb_hexadecimal_int64, testProperty "tb_hexadecimal_integer" tb_hexadecimal_integer, testProperty "tb_hexadecimal_word" tb_hexadecimal_word, testProperty "tb_hexadecimal_word8" tb_hexadecimal_word8, testProperty "tb_hexadecimal_word16" tb_hexadecimal_word16, testProperty "tb_hexadecimal_word32" tb_hexadecimal_word32, testProperty "tb_hexadecimal_word64" tb_hexadecimal_word64 ], testGroup "realfloat" [ testProperty "tb_realfloat_double" tb_realfloat_double, testProperty "tb_realfloat_float" tb_realfloat_float, testProperty "tb_formatRealFloat_float" tb_formatRealFloat_float, testProperty "tb_formatRealFloat_double" tb_formatRealFloat_double ] ]