Unverified Commit ca73ae38 authored by Xia Li-yao's avatar Xia Li-yao Committed by GitHub
Browse files

Modularize property tests (#323)

parent 160cec62
This diff is collapsed.
-- | Test basic text functions
{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
module Tests.Properties.Basics
( testBasics
) where
import Control.Arrow (first, second)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Tests.QuickCheckUtils
import Text.Show.Functions ()
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Internal.Fusion as S
import qualified Data.Text.Internal.Fusion.Common as S
import qualified Data.Text.Internal.Lazy.Fusion as SL
import qualified Data.Text.Lazy as TL
s_cons x = (x:) `eqP` (unpackS . S.cons x)
s_cons_s x = (x:) `eqP` (unpackS . S.unstream . S.cons x)
sf_cons p x = ((x:) . L.filter p) `eqP` (unpackS . S.cons x . S.filter p)
t_cons x = (x:) `eqP` (unpackS . T.cons x)
tl_cons x = (x:) `eqP` (unpackS . TL.cons x)
s_snoc x = (++ [x]) `eqP` (unpackS . (flip S.snoc) x)
t_snoc x = (++ [x]) `eqP` (unpackS . (flip T.snoc) x)
tl_snoc x = (++ [x]) `eqP` (unpackS . (flip TL.snoc) x)
s_append s = (s++) `eqP` (unpackS . S.append (S.streamList s))
s_append_s s = (s++) `eqP`
(unpackS . S.unstream . S.append (S.streamList s))
sf_append p s = (L.filter p s++) `eqP`
(unpackS . S.append (S.filter p $ S.streamList s))
t_append s = (s++) `eqP` (unpackS . T.append (packS s))
uncons (x:xs) = Just (x,xs)
uncons _ = Nothing
s_uncons = uncons `eqP` (fmap (second unpackS) . S.uncons)
sf_uncons p = (uncons . L.filter p) `eqP`
(fmap (second unpackS) . S.uncons . S.filter p)
t_uncons = uncons `eqP` (fmap (second unpackS) . T.uncons)
tl_uncons = uncons `eqP` (fmap (second unpackS) . TL.uncons)
unsnoc xs@(_:_) = Just (init xs, last xs)
unsnoc [] = Nothing
t_unsnoc = unsnoc `eqP` (fmap (first unpackS) . T.unsnoc)
tl_unsnoc = unsnoc `eqP` (fmap (first unpackS) . TL.unsnoc)
s_head = head `eqP` S.head
sf_head p = (head . L.filter p) `eqP` (S.head . S.filter p)
t_head = head `eqP` T.head
tl_head = head `eqP` TL.head
s_last = last `eqP` S.last
sf_last p = (last . L.filter p) `eqP` (S.last . S.filter p)
t_last = last `eqP` T.last
tl_last = last `eqP` TL.last
s_tail = tail `eqP` (unpackS . S.tail)
s_tail_s = tail `eqP` (unpackS . S.unstream . S.tail)
sf_tail p = (tail . L.filter p) `eqP` (unpackS . S.tail . S.filter p)
t_tail = tail `eqP` (unpackS . T.tail)
tl_tail = tail `eqP` (unpackS . TL.tail)
s_init = init `eqP` (unpackS . S.init)
s_init_s = init `eqP` (unpackS . S.unstream . S.init)
sf_init p = (init . L.filter p) `eqP` (unpackS . S.init . S.filter p)
t_init = init `eqP` (unpackS . T.init)
tl_init = init `eqP` (unpackS . TL.init)
s_null = null `eqP` S.null
sf_null p = (null . L.filter p) `eqP` (S.null . S.filter p)
t_null = null `eqP` T.null
tl_null = null `eqP` TL.null
s_length = length `eqP` S.length
sf_length p = (length . L.filter p) `eqP` (S.length . S.filter p)
sl_length = (fromIntegral . length) `eqP` SL.length
t_length = length `eqP` T.length
tl_length = L.genericLength `eqP` TL.length
t_compareLength t = (compare (T.length t)) `eq` T.compareLength t
tl_compareLength t= (compare (TL.length t)) `eq` TL.compareLength t
-- Regression tests.
s_filter_eq s = S.filter p t == S.streamList (filter p s)
where p = (/= S.last t)
t = S.streamList s
testBasics :: TestTree
testBasics =
testGroup "basics" [
testProperty "s_cons" s_cons,
testProperty "s_cons_s" s_cons_s,
testProperty "sf_cons" sf_cons,
testProperty "t_cons" t_cons,
testProperty "tl_cons" tl_cons,
testProperty "s_snoc" s_snoc,
testProperty "t_snoc" t_snoc,
testProperty "tl_snoc" tl_snoc,
testProperty "s_append" s_append,
testProperty "s_append_s" s_append_s,
testProperty "sf_append" sf_append,
testProperty "t_append" t_append,
testProperty "s_uncons" s_uncons,
testProperty "sf_uncons" sf_uncons,
testProperty "t_uncons" t_uncons,
testProperty "tl_uncons" tl_uncons,
testProperty "t_unsnoc" t_unsnoc,
testProperty "tl_unsnoc" tl_unsnoc,
testProperty "s_head" s_head,
testProperty "sf_head" sf_head,
testProperty "t_head" t_head,
testProperty "tl_head" tl_head,
testProperty "s_last" s_last,
testProperty "sf_last" sf_last,
testProperty "t_last" t_last,
testProperty "tl_last" tl_last,
testProperty "s_tail" s_tail,
testProperty "s_tail_s" s_tail_s,
testProperty "sf_tail" sf_tail,
testProperty "t_tail" t_tail,
testProperty "tl_tail" tl_tail,
testProperty "s_init" s_init,
testProperty "s_init_s" s_init_s,
testProperty "sf_init" sf_init,
testProperty "t_init" t_init,
testProperty "tl_init" tl_init,
testProperty "s_null" s_null,
testProperty "sf_null" sf_null,
testProperty "t_null" t_null,
testProperty "tl_null" tl_null,
testProperty "s_length" s_length,
testProperty "sf_length" sf_length,
testProperty "sl_length" sl_length,
testProperty "t_length" t_length,
testProperty "tl_length" tl_length,
testProperty "t_compareLength" t_compareLength,
testProperty "tl_compareLength" tl_compareLength,
testGroup "regressions" [
testProperty "s_filter_eq" s_filter_eq
]
]
-- | Test @Builder@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
module Tests.Properties.Builder
( testBuilder
) where
import Data.Monoid (Monoid(..))
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Word (Word, Word8, Word16, Word32, Word64)
import Numeric (showEFloat, showFFloat, showGFloat, showHex)
import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Tests.QuickCheckUtils
import Text.Show.Functions ()
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_fromText = 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 -> Bool
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 (BigBounded (a::Int)) = tb_decimal a
tb_decimal_big_int64 (BigBounded (a::Int64)) = tb_decimal a
tb_decimal_big_word (BigBounded (a::Word)) = tb_decimal a
tb_decimal_big_word64 (BigBounded (a::Word64)) = tb_decimal a
tb_hex :: (Integral a, Show a) => a -> Bool
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 -> Bool
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_fromText" tb_fromText,
testProperty "tb_singleton" tb_singleton,
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
]
]
-- | Test folds, scans, and unfolds
{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
module Tests.Properties.Folds
( testFolds
) where
import Control.Arrow (second)
import Data.Word (Word8, Word16)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Tests.QuickCheckUtils
import Text.Show.Functions ()
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Internal.Fusion as S
import qualified Data.Text.Internal.Fusion.Common as S
import qualified Data.Text.Lazy as TL
-- Folds
sf_foldl p f z = (L.foldl f z . L.filter p) `eqP` (S.foldl f z . S.filter p)
where _types = f :: Char -> Char -> Char
t_foldl f z = L.foldl f z `eqP` (T.foldl f z)
where _types = f :: Char -> Char -> Char
tl_foldl f z = L.foldl f z `eqP` (TL.foldl f z)
where _types = f :: Char -> Char -> Char
sf_foldl' p f z = (L.foldl' f z . L.filter p) `eqP`
(S.foldl' f z . S.filter p)
where _types = f :: Char -> Char -> Char
t_foldl' f z = L.foldl' f z `eqP` T.foldl' f z
where _types = f :: Char -> Char -> Char
tl_foldl' f z = L.foldl' f z `eqP` TL.foldl' f z
where _types = f :: Char -> Char -> Char
sf_foldl1 p f = (L.foldl1 f . L.filter p) `eqP` (S.foldl1 f . S.filter p)
t_foldl1 f = L.foldl1 f `eqP` T.foldl1 f
tl_foldl1 f = L.foldl1 f `eqP` TL.foldl1 f
sf_foldl1' p f = (L.foldl1' f . L.filter p) `eqP` (S.foldl1' f . S.filter p)
t_foldl1' f = L.foldl1' f `eqP` T.foldl1' f
tl_foldl1' f = L.foldl1' f `eqP` TL.foldl1' f
sf_foldr p f z = (L.foldr f z . L.filter p) `eqP` (S.foldr f z . S.filter p)
where _types = f :: Char -> Char -> Char
t_foldr f z = L.foldr f z `eqP` T.foldr f z
where _types = f :: Char -> Char -> Char
tl_foldr f z = unsquare $
L.foldr f z `eqP` TL.foldr f z
where _types = f :: Char -> Char -> Char
sf_foldr1 p f = unsquare $
(L.foldr1 f . L.filter p) `eqP` (S.foldr1 f . S.filter p)
t_foldr1 f = L.foldr1 f `eqP` T.foldr1 f
tl_foldr1 f = unsquare $
L.foldr1 f `eqP` TL.foldr1 f
-- Special folds
s_concat_s = unsquare $
L.concat `eq` (unpackS . S.unstream . S.concat . map packS)
sf_concat p = unsquare $
(L.concat . map (L.filter p)) `eq`
(unpackS . S.concat . map (S.filter p . packS))
t_concat = unsquare $
L.concat `eq` (unpackS . T.concat . map packS)
tl_concat = unsquare $
L.concat `eq` (unpackS . TL.concat . map TL.pack)
sf_concatMap p f = unsquare $ (L.concatMap f . L.filter p) `eqP`
(unpackS . S.concatMap (packS . f) . S.filter p)
t_concatMap f = unsquare $
L.concatMap f `eqP` (unpackS . T.concatMap (packS . f))
tl_concatMap f = unsquare $
L.concatMap f `eqP` (unpackS . TL.concatMap (TL.pack . f))
sf_any q p = (L.any p . L.filter q) `eqP` (S.any p . S.filter q)
t_any p = L.any p `eqP` T.any p
tl_any p = L.any p `eqP` TL.any p
sf_all q p = (L.all p . L.filter q) `eqP` (S.all p . S.filter q)
t_all p = L.all p `eqP` T.all p
tl_all p = L.all p `eqP` TL.all p
sf_maximum p = (L.maximum . L.filter p) `eqP` (S.maximum . S.filter p)
t_maximum = L.maximum `eqP` T.maximum
tl_maximum = L.maximum `eqP` TL.maximum
sf_minimum p = (L.minimum . L.filter p) `eqP` (S.minimum . S.filter p)
t_minimum = L.minimum `eqP` T.minimum
tl_minimum = L.minimum `eqP` TL.minimum
-- Scans
sf_scanl p f z = (L.scanl f z . L.filter p) `eqP`
(unpackS . S.scanl f z . S.filter p)
t_scanl f z = L.scanl f z `eqP` (unpackS . T.scanl f z)
tl_scanl f z = L.scanl f z `eqP` (unpackS . TL.scanl f z)
t_scanl1 f = L.scanl1 f `eqP` (unpackS . T.scanl1 f)
tl_scanl1 f = L.scanl1 f `eqP` (unpackS . TL.scanl1 f)
t_scanr f z = L.scanr f z `eqP` (unpackS . T.scanr f z)
tl_scanr f z = L.scanr f z `eqP` (unpackS . TL.scanr f z)
t_scanr1 f = L.scanr1 f `eqP` (unpackS . T.scanr1 f)
tl_scanr1 f = L.scanr1 f `eqP` (unpackS . TL.scanr1 f)
t_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . T.mapAccumL f z)
where _types = f :: Int -> Char -> (Int,Char)
tl_mapAccumL f z = L.mapAccumL f z `eqP` (second unpackS . TL.mapAccumL f z)
where _types = f :: Int -> Char -> (Int,Char)
t_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . T.mapAccumR f z)
where _types = f :: Int -> Char -> (Int,Char)
tl_mapAccumR f z = L.mapAccumR f z `eqP` (second unpackS . TL.mapAccumR f z)
where _types = f :: Int -> Char -> (Int,Char)
-- Unfolds
tl_repeat n = (L.take m . L.repeat) `eq`
(unpackS . TL.take (fromIntegral m) . TL.repeat)
where m = fromIntegral (n :: Word8)
any_replicate n l = concat (L.replicate n l)
s_replicate n = any_replicate m `eq`
(unpackS . S.replicateI (fromIntegral m) . packS)
where m = fromIntegral (n :: Word8)
t_replicate n = any_replicate m `eq` (unpackS . T.replicate m . packS)
where m = fromIntegral (n :: Word8)
tl_replicate n = any_replicate m `eq`
(unpackS . TL.replicate (fromIntegral m) . packS)
where m = fromIntegral (n :: Word8)
tl_cycle n = (L.take m . L.cycle) `eq`
(unpackS . TL.take (fromIntegral m) . TL.cycle . packS)
where m = fromIntegral (n :: Word8)
tl_iterate f n = (L.take m . L.iterate f) `eq`
(unpackS . TL.take (fromIntegral m) . TL.iterate f)
where m = fromIntegral (n :: Word8)
unf :: Int -> Char -> Maybe (Char, Char)
unf n c | fromEnum c * 100 > n = Nothing
| otherwise = Just (c, succ c)
t_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . T.unfoldr (unf m))
where m = fromIntegral (n :: Word16)
tl_unfoldr n = L.unfoldr (unf m) `eq` (unpackS . TL.unfoldr (unf m))
where m = fromIntegral (n :: Word16)
t_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
(unpackS . T.unfoldrN i (unf j))
where i = fromIntegral (n :: Word16)
j = fromIntegral (m :: Word16)
tl_unfoldrN n m = (L.take i . L.unfoldr (unf j)) `eq`
(unpackS . TL.unfoldrN (fromIntegral i) (unf j))
where i = fromIntegral (n :: Word16)
j = fromIntegral (m :: Word16)
testFolds :: TestTree
testFolds =
testGroup "folds-unfolds" [
testGroup "folds" [
testProperty "sf_foldl" sf_foldl,
testProperty "t_foldl" t_foldl,
testProperty "tl_foldl" tl_foldl,
testProperty "sf_foldl'" sf_foldl',
testProperty "t_foldl'" t_foldl',
testProperty "tl_foldl'" tl_foldl',
testProperty "sf_foldl1" sf_foldl1,
testProperty "t_foldl1" t_foldl1,
testProperty "tl_foldl1" tl_foldl1,
testProperty "t_foldl1'" t_foldl1',
testProperty "sf_foldl1'" sf_foldl1',
testProperty "tl_foldl1'" tl_foldl1',
testProperty "sf_foldr" sf_foldr,
testProperty "t_foldr" t_foldr,
testProperty "tl_foldr" tl_foldr,
testProperty "sf_foldr1" sf_foldr1,
testProperty "t_foldr1" t_foldr1,
testProperty "tl_foldr1" tl_foldr1,
testGroup "special" [
testProperty "s_concat_s" s_concat_s,
testProperty "sf_concat" sf_concat,
testProperty "t_concat" t_concat,
testProperty "tl_concat" tl_concat,
testProperty "sf_concatMap" sf_concatMap,
testProperty "t_concatMap" t_concatMap,
testProperty "tl_concatMap" tl_concatMap,
testProperty "sf_any" sf_any,
testProperty "t_any" t_any,
testProperty "tl_any" tl_any,
testProperty "sf_all" sf_all,
testProperty "t_all" t_all,
testProperty "tl_all" tl_all,
testProperty "sf_maximum" sf_maximum,
testProperty "t_maximum" t_maximum,
testProperty "tl_maximum" tl_maximum,
testProperty "sf_minimum" sf_minimum,
testProperty "t_minimum" t_minimum,
testProperty "tl_minimum" tl_minimum
]
],
testGroup "scans" [
testProperty "sf_scanl" sf_scanl,
testProperty "t_scanl" t_scanl,
testProperty "tl_scanl" tl_scanl,
testProperty "t_scanl1" t_scanl1,
testProperty "tl_scanl1" tl_scanl1,
testProperty "t_scanr" t_scanr,
testProperty "tl_scanr" tl_scanr,
testProperty "t_scanr1" t_scanr1,
testProperty "tl_scanr1" tl_scanr1
],
testGroup "mapAccum" [
testProperty "t_mapAccumL" t_mapAccumL,
testProperty "tl_mapAccumL" tl_mapAccumL,
testProperty "t_mapAccumR" t_mapAccumR,
testProperty "tl_mapAccumR" tl_mapAccumR
],
testGroup "unfolds" [
testProperty "tl_repeat" tl_repeat,
testProperty "s_replicate" s_replicate,
testProperty "t_replicate" t_replicate,
testProperty "tl_replicate" tl_replicate,
testProperty "tl_cycle" tl_cycle,
testProperty "tl_iterate" tl_iterate,
testProperty "t_unfoldr" t_unfoldr,
testProperty "tl_unfoldr" tl_unfoldr,
testProperty "t_unfoldrN" t_unfoldrN,
testProperty "tl_unfoldrN" tl_unfoldrN
]
]
-- | Test instances
{-# OPTIONS_GHC -fno-enable-rewrite-rules -fno-warn-missing-signatures #-}
module Tests.Properties.Instances
( testInstances
) where
import Data.Monoid (Monoid(..))
import Data.String (IsString(fromString))
import Test.QuickCheck
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Tests.QuickCheckUtils
import Text.Show.Functions ()
import qualified Data.List as L
import qualified Data.Text as T
import qualified Data.Text.Internal.Fusion.Common as S
import qualified Data.Text.Lazy as TL
s_Eq s = (s==) `eq` ((S.streamList s==) . S.streamList)
where _types = s :: String
sf_Eq p s =
((L.filter p s==) . L.filter p) `eq`
(((S.filter p $ S.streamList s)==) . S.filter p . S.streamList)
t_Eq s = (s==) `eq` ((T.pack s==) . T.pack)
tl_Eq s = (s==) `eq` ((TL.pack s==) . TL.pack)
s_Ord s = (compare s) `eq` (compare (S.streamList s) . S.streamList)
where _types = s :: String
sf_Ord p s =
((compare $ L.filter p s) . L.filter p) `eq`
(compare (S.filter p $ S.streamList s) . S.filter p . S.streamList)
t_Ord s = (compare s) `eq` (compare (T.pack s) . T.pack)
tl_Ord s = (compare s) `eq` (compare (TL.pack s) . TL.pack)
t_Read = id `eq` (T.unpack . read . show)
tl_Read = id `eq` (TL.unpack . read . show)
t_Show = show `eq` (show . T.pack)
tl_Show = show `eq` (show . TL.pack)
t_mappend s = mappend s`eqP` (unpackS . mappend (T.pack s))
tl_mappend s = mappend s`eqP` (unpackS . mappend (TL.pack s))
t_mconcat = unsquare $
mconcat `eq` (unpackS . mconcat . L.map T.pack)
tl_mconcat = unsquare $
mconcat `eq` (unpackS . mconcat . L.map TL.pack)
t_mempty = mempty === (unpackS (mempty :: T.Text))
tl_mempty = mempty === (unpackS (mempty :: TL.Text))
t_IsString = fromString `eqP` (T.unpack . fromString)
tl_IsString = fromString `eqP` (TL.unpack . fromString)
testInstances :: TestTree
testInstances =
testGroup "instances" [
testProperty "s_Eq" s_Eq,
testProperty "sf_Eq" sf_Eq,
testProperty "t_Eq" t_Eq,
testProperty "tl_Eq" tl_Eq,
testProperty "s_Ord" s_Ord,
testProperty "sf_Ord" sf_Ord,
testProperty "t_Ord" t_Ord,