1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
|
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
|
