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
|
{-# LANGUAGE OverloadedStrings, FlexibleInstances, TypeSynonymInstances #-}
module Text.XML.Expat.Tests
( TCursor
, TNode
, testTagSet
, testTextSet
, testAttrSet )
where
import Control.Applicative
import Control.Monad (liftM)
import Data.ByteString.Char8 (ByteString)
import qualified Data.Map as M
import Test.QuickCheck
import Text.XML.Expat.Cursor (Cursor)
import Text.XML.Expat.Tree
------------------------------------------------------------------------------
type TCursor = Cursor ByteString ByteString
type TNode = Node ByteString ByteString
testTagSet :: [ByteString]
testTagSet = [ "apple"
, "banana"
, "cauliflower"
, "duck"
, "eel"
, "ferret"
, "grape" ]
testTextSet :: [ByteString]
testTextSet = [ "zoo"
, "yellow"
, "xylophone"
, "wet"
, "vulture"
, "ululate"
, "tympani" ]
testAttrSet :: [ByteString]
testAttrSet = [ "sheep"
, "ram"
, "quail"
, "penguin"
, "ox"
, "narwhal" ]
instance Arbitrary TNode where
arbitrary = mkElem 0
where
depth :: Int -> Gen TNode
depth n = do
prob <- (choose (0, 1) :: Gen Float)
if prob < 0.75 then mkElem n else mkText
mkAttr = do
key <- elements testAttrSet
val <- elements testAttrSet
return (key,val)
mkText = liftM Text $ elements testTextSet
mkElem n = do
nchildren <- if n > 3
then return 0
else choose ((0,6) :: (Int,Int))
nattrs <- choose ((0,4) :: (Int,Int))
attrs <- M.toList . M.fromList -- remove duplicate attributes
<$> sequence (replicate nattrs mkAttr)
children <- sequence $ replicate nchildren (depth (n+1))
tagname <- elements testTagSet
return $ Element tagname attrs children
|
