-
Notifications
You must be signed in to change notification settings - Fork 22
/
Tests.hs
98 lines (77 loc) · 3.26 KB
/
Tests.hs
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
-- | Tests for the Blaze builder
--
{-# LANGUAGE OverloadedStrings #-}
module Tests where
import Control.Applicative ((<$>))
import Data.Monoid (mempty, mappend, mconcat)
import Data.Word (Word8)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.ByteString.Lazy as LB
import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.Framework.Providers.HUnit
import Test.QuickCheck
import Test.HUnit hiding (Test)
import Codec.Binary.UTF8.String (decode)
import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char.Utf8
import Blaze.ByteString.Builder.Html.Utf8
main :: IO ()
main = defaultMain $ return $ testGroup "Tests" tests
tests :: [Test]
tests =
[ testProperty "left identity Monoid law" monoidLeftIdentity
, testProperty "right identity Monoid law" monoidRightIdentity
, testProperty "associativity Monoid law" monoidAssociativity
, testProperty "mconcat Monoid law" monoidConcat
, testProperty "string → builder → string" fromStringToString
, testProperty "string and text" stringAndText
, testProperty "lazy bytestring identity" identityLazyByteString
, testProperty "flushing identity" identityFlushing
, testCase "escaping case 1" escaping1
, testCase "escaping case 2" escaping2
, testCase "escaping case 3" escaping3
]
monoidLeftIdentity :: Builder -> Bool
monoidLeftIdentity b = mappend mempty b == b
monoidRightIdentity :: Builder -> Bool
monoidRightIdentity b = mappend b mempty == b
monoidAssociativity :: Builder -> Builder -> Builder -> Bool
monoidAssociativity x y z = mappend x (mappend y z) == mappend (mappend x y) z
monoidConcat :: [Builder] -> Bool
monoidConcat xs = mconcat xs == foldr mappend mempty xs
fromStringToString :: String -> Bool
fromStringToString string = string == convert string
where
convert = decode . LB.unpack . toLazyByteString . fromString
stringAndText :: String -> Bool
stringAndText string = fromString string == fromText (T.pack string)
identityLazyByteString :: LB.ByteString -> Bool
identityLazyByteString lbs = lbs == toLazyByteString (fromLazyByteString lbs)
identityFlushing :: String -> String -> Bool
identityFlushing s1 s2 =
let b1 = fromString s1
b2 = fromString s2
in b1 `mappend` b2 == b1 `mappend` flush `mappend` b2
escaping1 :: Assertion
escaping1 = fromString "<hello>" @?= fromHtmlEscapedString "<hello>"
escaping2 :: Assertion
escaping2 = fromString "f &&& g" @?= fromHtmlEscapedString "f &&& g"
escaping3 :: Assertion
escaping3 = fromString ""'" @?= fromHtmlEscapedString "\"'"
instance Show Builder where
show = show . toLazyByteString
instance Eq Builder where
b1 == b2 =
-- different and small buffer sizses for testing wrapping behaviour
toLazyByteStringWith 1024 1024 b1 ==
toLazyByteStringWith 2001 511 b2
-- | Artificially scale up size to ensures that buffer wrapping behaviour is
-- also tested.
numRepetitions :: Int
numRepetitions = 250
instance Arbitrary Builder where
arbitrary = (mconcat . replicate numRepetitions . fromString) <$> arbitrary
instance Arbitrary LB.ByteString where
arbitrary = (LB.concat . replicate numRepetitions . LB.pack) <$> arbitrary