Skip to content

Commit

Permalink
Test suite cleanup
Browse files Browse the repository at this point in the history
  • Loading branch information
jaspervdj committed Dec 3, 2010
1 parent 61a3adf commit 3f3b4f1
Show file tree
Hide file tree
Showing 4 changed files with 136 additions and 161 deletions.
8 changes: 4 additions & 4 deletions tests/TestSuite.hs
Expand Up @@ -3,14 +3,14 @@
module TestSuite where

import Test.Framework (defaultMain, testGroup)
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2

import qualified Text.Blaze.Tests
import qualified Text.Blaze.Tests.Cases
import qualified Util.Tests

main :: IO ()
main = defaultMain
[ testGroup "Text.Blaze.Tests" Text.Blaze.Tests.tests
, testGroup "Util.Tests" Util.Tests.tests
[ testGroup "Text.Blaze.Tests" Text.Blaze.Tests.tests
, testGroup "Text.Blaze.Tests.Cases" Text.Blaze.Tests.Cases.tests
, testGroup "Util.Tests" Util.Tests.tests
]
180 changes: 23 additions & 157 deletions tests/Text/Blaze/Tests.hs
Expand Up @@ -4,83 +4,35 @@ module Text.Blaze.Tests
) where

import Prelude hiding (div, id)
import Data.Monoid (mconcat, mempty, mappend)
import Control.Monad (replicateM, forM_, sequence_)
import Data.Monoid (mempty)
import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.Word (Word8)
import Data.Char (ord)
import Data.List (isInfixOf)

import Data.Text.Lazy.Encoding (encodeUtf8)
import Debug.Trace (traceShow)
import qualified Data.ByteString.Lazy.Char8 as LBC
import qualified Data.ByteString.Lazy as LB
import Test.Framework
import Test.Framework.Providers.QuickCheck2
import Test.QuickCheck
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)

import Text.Blaze.Html5 hiding (map)
import Text.Blaze.Html5.Attributes (id, class_, name)
import Text.Blaze.Internal
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes
import qualified Text.Blaze.Renderer.Utf8 as Utf8 (renderHtml)
import qualified Text.Blaze.Renderer.Text as Text (renderHtml)
import qualified Text.Blaze.Renderer.String as String (renderHtml)
import Blaze.ByteString.Builder as B (toLazyByteString)
import Blaze.ByteString.Builder.Char.Utf8 as B (fromString)
import Text.Blaze.Tests.Util

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
, testCase "escaping case 1" escaping1
, testCase "escaping case 2" escaping2
, testProperty "post escaping characters" postEscapingCharacters
, testCase "template case 1" template1
, testCase "template case 2" template2
, testCase "template case 3" template3
, testCase "template case 4" template4
, testCase "template case 5" template5
, testCase "template case 6" template6
, testCase "template case 7" template7
, testCase "template case 8" template8
, testCase "template case 9" template9
, testProperty "valid UTF-8" isValidUtf8
, testProperty "external </ sequence" externalEndSequence
, testProperty "well nested <>" wellNestedBrackets
]

-- | Render HTML to an UTF-8 encoded ByteString using the String renderer
--
renderUsingString :: Html -> LB.ByteString
renderUsingString = toLazyByteString . fromString . String.renderHtml

-- | Render HTML to an UTF-8 encoded ByteString using the Text renderer
--
renderUsingText :: Html -> LB.ByteString
renderUsingText = encodeUtf8 . Text.renderHtml

-- | Render HTML to an UTF-8 encoded ByteString using the Utf8 renderer
--
renderUsingUtf8 :: Html -> LB.ByteString
renderUsingUtf8 = Utf8.renderHtml

-- | Auxiliary function to create a template test
--
testTemplate :: LB.ByteString -- ^ Expected output
-> Html -- ^ HTML to render
-> Assertion -- ^ Resulting text
testTemplate expected html = condition @?
"Expected: " ++ show expected ++ " but got: " ++ show (r1, r2, r3)
where
r1 = renderUsingString html
r2 = renderUsingText html
r3 = renderUsingUtf8 html
condition = expected == r1 && expected == r2 && expected == r3

-- | The left identity Monoid law.
--
monoidLeftIdentity :: Html -> Bool
Expand All @@ -101,104 +53,18 @@ monoidAssociativity x y z = (x >> (y >> z)) == ((x >> y) >> z)
monoidConcat :: [Html] -> Bool
monoidConcat xs = sequence_ xs == foldr (>>) (return ()) xs

-- | Simple escaping test case.
--
escaping1 :: Assertion
escaping1 = testTemplate "&quot;&amp;&quot;" (string "\"&\"")

-- | Simple escaping test case.
--
escaping2 :: Assertion
escaping2 = testTemplate "&lt;img&gt;" (text "<img>")

-- | Escaped content cannot contain certain characters.
--
postEscapingCharacters :: String -> Bool
postEscapingCharacters str =
LB.all (`notElem` forbidden) $ Utf8.renderHtml (string str)
LB.all (`notElem` forbidden) $ renderUsingUtf8 (string str)
where
forbidden = map (fromIntegral . ord) "\"'<>"

-- | Simple template test case
--
template1 :: Assertion
template1 = testTemplate expected template
where
expected = "<div id=\"foo\"><p>banana</p><span>banana</span></div>"
template = div ! id "foo" $ do
p "banana"
H.span "banana"

-- | Simple template test case
--
template2 :: Assertion
template2 = testTemplate expected template
where
expected = "<img src=\"foo.png\" alt=\"bar\" />"
template = img ! src "foo.png" ! alt "bar"

-- | Simple template test case
--
template3 :: Assertion
template3 = testTemplate expected template
where
-- Note how we write λ in UTF-8 encoded notation
expected = "<span id=\"&amp;\">\206\187</span>"
template = H.span ! id "&" $ "λ"

-- | Simple template test case
--
template4 :: Assertion
template4 = testTemplate expected template
where
-- Three-byte UTF-8
expected = "\226\136\128x. x \226\136\136 A"
template = "∀x. x ∈ A"

-- | Simple template test case
--
template5 :: Assertion
template5 = testTemplate expected template
where
expected = "<li>4</li><li>5</li><li>6</li>"
template = forM_ [4 .. 6] (li . showHtml)

-- | Simple template test case
--
template6 :: Assertion
template6 = testTemplate expected template
where
expected = "<br /><img /><area />"
template = sequence_ [br, img, area]

-- | Simple template test case
--
template7 :: Assertion
template7 = testTemplate expected template
where
expected = "$6, \226\130\172\&7.01, \194\163\&75"
template = "$6, €7.01, £75"

-- | Simple template test case
--
template8 :: Assertion
template8 = testTemplate expected template
where
expected = "<p data-foo=\"bar\">A paragraph</p>"
template = p ! (dataAttribute "foo" "bar") $ "A paragraph"

-- | Simple template test case
--
template9 :: Assertion
template9 = testTemplate expected template
where
expected = "<p dojoType=\"select\">A paragraph</p>"
template = p ! (customAttribute "dojoType" "select") $ "A paragraph"

-- | Check if the produced bytes are valid UTF-8
--
isValidUtf8 :: Html -> Bool
isValidUtf8 = isValidUtf8' . LB.unpack . Utf8.renderHtml
isValidUtf8 = isValidUtf8' . LB.unpack . renderUsingUtf8
where
isIn x y z = (x <= z) && (z <= y)
isValidUtf8' :: [Word8] -> Bool
Expand All @@ -208,28 +74,28 @@ isValidUtf8 = isValidUtf8' . LB.unpack . Utf8.renderHtml
| isIn 0x00 0x7f x = isValidUtf8' t
-- Two bytes
| isIn 0xc0 0xdf x = case t of
(y:t) -> isIn 0x80 0xbf y && isValidUtf8' t
_ -> False
(y:t') -> isIn 0x80 0xbf y && isValidUtf8' t'
_ -> False
-- Three bytes
| isIn 0xe0 0xef x = case t of
(y:z:t) -> all (isIn 0x80 0xbf) [y, z] && isValidUtf8' t
_ -> False
(y:z:t') -> all (isIn 0x80 0xbf) [y, z] && isValidUtf8' t'
_ -> False
-- Four bytes
| isIn 0xf0 0xf7 x = case t of
(y:z:u:t) -> all (isIn 0x80 0xbf) [y, z, u] && isValidUtf8' t
_ -> False
(y:z:u:t') -> all (isIn 0x80 0xbf) [y, z, u] && isValidUtf8' t'
_ -> False
| otherwise = False

-- | Check if the "</" sequence does not appear in @<script>@ or @<style>@ tags.
--
externalEndSequence :: String -> Bool
externalEndSequence = not . isInfixOf "</" . LBC.unpack
. Utf8.renderHtml . external . string
. renderUsingUtf8 . external . string

-- | Check that the "<>" characters are well-nested.
--
wellNestedBrackets :: Html -> Bool
wellNestedBrackets = wellNested False . LBC.unpack . Utf8.renderHtml
wellNestedBrackets = wellNested False . LBC.unpack . renderUsingUtf8
where
wellNested isOpen [] = not isOpen
wellNested isOpen (x:xs) = case x of
Expand All @@ -240,17 +106,17 @@ wellNestedBrackets = wellNested False . LBC.unpack . Utf8.renderHtml
-- Show instance for the HTML type, so we can debug.
--
instance Show Html where
show = String.renderHtml
show = show . renderUsingUtf8

-- Eq instance for the HTML type, so we can compare the results.
--
instance Eq Html where
h1 == h2 = renderUsingString h1 == renderUsingString h2
&& renderUsingText h1 == renderUsingText h2
&& renderUsingUtf8 h1 == renderUsingUtf8 h2
-- Some cross-checks
&& renderUsingString h1 == renderUsingText h2
&& renderUsingText h1 == renderUsingUtf8 h2
x == y = renderUsingString x == renderUsingString y
&& renderUsingText x == renderUsingText y
&& renderUsingUtf8 x == renderUsingUtf8 y
-- Some cross-checks
&& renderUsingString x == renderUsingText y
&& renderUsingText x == renderUsingUtf8 y

-- Arbitrary instance for the HTML type.
--
Expand Down Expand Up @@ -298,6 +164,6 @@ arbitraryHtml depth = do

-- Generate an arbitrary HTML attribute.
arbitraryAttribute = do
attribute <- elements [id, class_, name]
attr <- elements [id, class_, name]
value <- arbitrary
return $ attribute $ stringValue value
return $ attr $ stringValue value
78 changes: 78 additions & 0 deletions tests/Text/Blaze/Tests/Cases.hs
@@ -0,0 +1,78 @@
-- | A whole bunch of simple test cases
--
{-# LANGUAGE OverloadedStrings #-}
module Text.Blaze.Tests.Cases
( tests
) where

import Prelude hiding (div, id)
import Control.Monad (forM_)

import Test.HUnit ((@=?))
import Test.Framework.Providers.HUnit (testCase)
import Test.Framework (Test)
import qualified Data.ByteString.Lazy.Char8 as LBC

import Text.Blaze.Html5 hiding (map)
import qualified Text.Blaze.Html5 as H
import Text.Blaze.Html5.Attributes
import Text.Blaze.Tests.Util

-- | Type for a simple HTML test. This data type contains the expected output
-- and the HTML template.
--
data HtmlTest = HtmlTest LBC.ByteString Html

-- | Create tests from an HTML test
--
makeTests :: String -> HtmlTest -> [Test]
makeTests baseName (HtmlTest expected h) =
[ testCase (baseName ++ " (String)") $ expected @=? renderUsingString h
, testCase (baseName ++ " (Text)") $ expected @=? renderUsingText h
, testCase (baseName ++ " (Utf8)") $ expected @=? renderUsingUtf8 h
]

-- | Actual tests
--
tests :: [Test]
tests = concatMap (uncurry makeTests) $ zip names
-- Escaping cases
[ HtmlTest "&quot;&amp;&quot;" $ string "\"&\""

, HtmlTest "&lt;img&gt;" $ text "<img>"

-- Simple cases
, HtmlTest "<div id=\"foo\"><p>banana</p><span>banana</span></div>" $
div ! id "foo" $ do
p "banana"
H.span "banana"

, HtmlTest "<img src=\"foo.png\" alt=\"bar\" />" $
img ! src "foo.png" ! alt "bar"

-- Unicode cases
, HtmlTest "<span id=\"&amp;\">\206\187</span>" $
H.span ! id "&" $ "λ"

, HtmlTest "\226\136\128x. x \226\136\136 A"
"∀x. x ∈ A"

, HtmlTest "$6, \226\130\172\&7.01, \194\163\&75"
"$6, €7.01, £75"

-- Control cases
, HtmlTest "<li>4</li><li>5</li><li>6</li>" $
forM_ [4 :: Int .. 6] (li . showHtml)

, HtmlTest "<br /><img /><area />" $
sequence_ [br, img, area]

-- Attribute tests
, HtmlTest "<p data-foo=\"bar\">A paragraph</p>" $
p ! (dataAttribute "foo" "bar") $ "A paragraph"

, HtmlTest "<p dojoType=\"select\">A paragraph</p>" $
p ! (customAttribute "dojoType" "select") $ "A paragraph"
]
where
names = map (("Test case " ++) . show) [1 :: Int ..]
31 changes: 31 additions & 0 deletions tests/Text/Blaze/Tests/Util.hs
@@ -0,0 +1,31 @@
-- | Utility functions for the blaze tests
--
module Text.Blaze.Tests.Util
( renderUsingString
, renderUsingText
, renderUsingUtf8
) where

import Text.Blaze.Html5 hiding (map)
import qualified Data.ByteString.Lazy as LB
import qualified Text.Blaze.Renderer.Utf8 as Utf8 (renderHtml)
import qualified Text.Blaze.Renderer.Text as Text (renderHtml)
import qualified Text.Blaze.Renderer.String as String (renderHtml)
import Blaze.ByteString.Builder as B (toLazyByteString)
import Blaze.ByteString.Builder.Char.Utf8 as B (fromString)
import Data.Text.Lazy.Encoding (encodeUtf8)

-- | Render HTML to an UTF-8 encoded ByteString using the String renderer
--
renderUsingString :: Html -> LB.ByteString
renderUsingString = toLazyByteString . fromString . String.renderHtml

-- | Render HTML to an UTF-8 encoded ByteString using the Text renderer
--
renderUsingText :: Html -> LB.ByteString
renderUsingText = encodeUtf8 . Text.renderHtml

-- | Render HTML to an UTF-8 encoded ByteString using the Utf8 renderer
--
renderUsingUtf8 :: Html -> LB.ByteString
renderUsingUtf8 = Utf8.renderHtml

0 comments on commit 3f3b4f1

Please sign in to comment.