module Main where
import qualified Data.ByteString as ByteString
import qualified Data.Char as Char
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TextLazy
import qualified Data.Text.Lazy.Builder as TextLazyBuilder
import Numeric.Compat
import Test.QuickCheck.Classes
import Test.QuickCheck.Instances ()
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck hiding ((.&.))
import qualified TextBuilderDev as B
import qualified TextBuilderDev.TastyExtras as Extras
import Prelude hiding (choose, showBin)
main :: IO ()
main =
defaultMain
$ testGroup "All tests"
$ [ testProperty "ASCII ByteString"
$ let gen = listOf $ do
list <- listOf (choose (0, 127))
return (ByteString.pack list)
in forAll gen $ \chunks ->
mconcat chunks
=== Text.encodeUtf8 (B.buildText (foldMap B.asciiByteString chunks)),
testProperty "Intercalation has the same effect as in Text"
$ \separator texts ->
Text.intercalate separator texts
=== B.buildText (B.intercalate (B.text separator) (fmap B.text texts)),
testProperty "intercalateMap sep mapper == intercalate sep . fmap mapper"
$ \separator ints ->
Text.intercalate separator (fmap (fromString . show @Int) ints)
=== B.buildText (B.intercalateMap (B.text separator) B.decimal ints),
testProperty "Packing a list of chars is isomorphic to appending a list of builders"
$ \chars ->
Text.pack chars
=== B.buildText (foldMap B.char chars),
testProperty "Concatting a list of texts is isomorphic to fold-mapping with builders"
$ \texts ->
mconcat texts
=== B.buildText (foldMap B.text texts),
testProperty "Concatting a list of texts is isomorphic to concatting a list of builders"
$ \texts ->
mconcat texts
=== B.buildText (mconcat (map B.text texts)),
testProperty "Concatting a list of trimmed texts is isomorphic to concatting a list of builders"
$ \texts ->
let trimmedTexts = fmap (Text.drop 3) texts
in mconcat trimmedTexts
=== B.buildText (mconcat (map B.text trimmedTexts)),
testProperty "TextBuilderDev.null is isomorphic to Text.null" $ \(text :: Text) ->
B.null (B.toTextBuilder text) === Text.null text,
testProperty "(TextBuilderDev.unicodeCodePoint <>) is isomorphic to Text.cons"
$ withMaxSuccess bigTest
$ \(text :: Text) (c :: Char) ->
B.buildText (B.unicodeCodePoint (Char.ord c) <> B.text text) === Text.cons c text,
testGroup "Time interval"
$ [ testCase "59s" $ assertEqual "" "00:00:00:59" $ B.buildText $ B.intervalInSeconds 59,
testCase "minute" $ assertEqual "" "00:00:01:00" $ B.buildText $ B.intervalInSeconds 60,
testCase "90s" $ assertEqual "" "00:00:01:30" $ B.buildText $ B.intervalInSeconds 90,
testCase "hour" $ assertEqual "" "00:01:00:00" $ B.buildText $ B.intervalInSeconds 3600,
testCase "day" $ assertEqual "" "01:00:00:00" $ B.buildText $ B.intervalInSeconds 86400
],
testGroup "By function name"
$ [ testGroup "utf8CodeUnitsN"
$ [ testProperty "Text.cons isomporphism"
$ withMaxSuccess bigTest
$ \(text :: Text) (c :: Char) ->
let cp = Char.ord c
cuBuilder
| cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)
| cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)
| cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2)
| otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2) (cuAt 3)
where
-- Use Data.Text.Encoding for comparison
codeUnits = Text.encodeUtf8 $ Text.singleton c
cuAt = (codeUnits `ByteString.index`)
in B.buildText (cuBuilder <> B.text text) === Text.cons c text,
testProperty "Text.singleton isomorphism"
$ withMaxSuccess bigTest
$ \(c :: Char) ->
let text = Text.singleton c
codeUnits = Text.encodeUtf8 text
cp = Char.ord c
cuBuilder
| cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)
| cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)
| cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2)
| otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2) (cuAt 3)
where
cuAt = ByteString.index codeUnits
in B.buildText cuBuilder === text
],
testGroup "utf16CodeUnitsN"
$ [ testProperty "is isomorphic to Text.cons"
$ withMaxSuccess bigTest
$ \(text :: Text) (c :: Char) ->
let cp = Char.ord c
cuBuilder
| cp < 0x10000 = B.utf16CodeUnits1 (cuAt 0)
| otherwise = B.utf16CodeUnits2 (cuAt 0) (cuAt 1)
where
-- Use Data.Text.Encoding for comparison
codeUnits = Text.encodeUtf16LE $ Text.singleton c
cuAt i =
(fromIntegral $ codeUnits `ByteString.index` (2 * i))
.|. ((fromIntegral $ codeUnits `ByteString.index` (2 * i + 1)) `shiftL` 8)
in B.buildText (cuBuilder <> B.text text) === Text.cons c text
],
testCase "thousandSeparatedUnsignedDecimal" $ do
assertEqual "" "0" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 0))
assertEqual "" "123" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 123))
assertEqual "" "1,234" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 1234))
assertEqual "" "1,234,567" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 1234567)),
testCase "padFromLeft" $ do
assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' ""))
assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' "0"))
assertEqual "" "01" (B.buildText (B.padFromLeft 2 '0' "1"))
assertEqual "" "12" (B.buildText (B.padFromLeft 2 '0' "12"))
assertEqual "" "123" (B.buildText (B.padFromLeft 2 '0' "123")),
testCase "padFromRight" $ do
assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' ""))
assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' "0"))
assertEqual "" "10" (B.buildText (B.padFromRight 2 '0' "1"))
assertEqual "" "12" (B.buildText (B.padFromRight 2 '0' "12"))
assertEqual "" "123" (B.buildText (B.padFromRight 2 '0' "123"))
assertEqual "" "1 " (B.buildText (B.padFromRight 3 ' ' "1")),
testProperty "decimal" $ \(x :: Integer) ->
(fromString . show) x === (B.buildText (B.decimal x)),
testGroup "hexadecimal"
$ [ testProperty "show isomorphism" $ \(x :: Integer) ->
x >= 0 ==>
(fromString . showHex x) "" === (B.buildText . B.hexadecimal) x,
testCase "Positive"
$ assertEqual "" "1f23" (B.buildText (B.hexadecimal 0x01f23)),
testCase "Negative"
$ assertEqual "" "-1f23" (B.buildText (B.hexadecimal (-0x01f23)))
],
testCase "dataSizeInBytesInDecimal" $ do
assertEqual "" "999B" (B.buildText (B.dataSizeInBytesInDecimal ',' 999))
assertEqual "" "1kB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1000))
assertEqual "" "1.1kB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1100))
assertEqual "" "1.1MB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1150000))
assertEqual "" "9.9MB" (B.buildText (B.dataSizeInBytesInDecimal ',' 9990000))
assertEqual "" "10MB" (B.buildText (B.dataSizeInBytesInDecimal ',' 10100000))
assertEqual "" "1,000YB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1000000000000000000000000000)),
testCase "fixedDouble" $ do
assertEqual "" "0.0" (B.buildText (B.fixedDouble 1 0.05))
assertEqual "" "0.1" (B.buildText (B.fixedDouble 1 0.06))
assertEqual "" "10.0000" (B.buildText (B.fixedDouble 4 10))
assertEqual "" "0.9000" (B.buildText (B.fixedDouble 4 0.9)),
testCase "doublePercent" $ do
assertEqual "" "90.4%" (B.buildText (B.doublePercent 1 0.904)),
testGroup "unsignedBinary"
$ [ testProperty "Produces the same output as showBin" $ \(x :: Natural) ->
fromString (showBin x "")
=== B.buildText (B.unsignedBinary x)
],
testGroup "finiteBitsUnsignedBinary"
$ [ testProperty "Produces the same output as showBin" $ \(x :: Word) ->
fromString (showBin x "")
=== B.buildText (B.finiteBitsUnsignedBinary x)
],
testGroup "fixedUnsignedDecimal"
$ [ testProperty "Same as printf" $ \(size :: Word8, val :: Natural) ->
let rendered = show val
renderedLength = length rendered
intSize = fromIntegral size
padded =
if renderedLength > intSize
then drop (renderedLength - intSize) rendered
else replicate (intSize - renderedLength) '0' <> rendered
in fromString padded
=== B.buildText (B.fixedUnsignedDecimal (fromIntegral size) val)
],
testGroup "utcTimeInIso8601"
$ [ testProperty "Same as iso8601Show" $ \x ->
let roundedToSecondsTime =
x {utctDayTime = (fromIntegral . round . utctDayTime) x}
in (fromString . flip mappend "Z" . take 19 . iso8601Show) roundedToSecondsTime
=== B.buildText (B.utcTimeInIso8601 roundedToSecondsTime)
]
],
testGroup "IsomorphicToTextBuilder instances"
$ [ Extras.isomorphismLaws "Text" $ Proxy @Text,
Extras.isomorphismLaws "Lazy Text" $ Proxy @TextLazy.Text,
Extras.isomorphismLaws "Lazy Text Builder" $ Proxy @TextLazyBuilder.Builder,
Extras.isomorphismLaws "String" $ Proxy @String
],
testLaws $ showLaws (Proxy @B.TextBuilder),
testLaws $ eqLaws (Proxy @B.TextBuilder),
testLaws $ semigroupLaws (Proxy @B.TextBuilder),
testLaws $ monoidLaws (Proxy @B.TextBuilder)
]
where
bigTest = 10000
testLaws :: Laws -> TestTree
testLaws Laws {..} =
testProperties lawsTypeclass lawsProperties