summaryrefslogtreecommitdiff
path: root/src/Tests/Arbitrary.hs
diff options
context:
space:
mode:
authordr@jones.dk <dr@jones.dk>2011-02-07 03:28:57 +0100
committerdr@jones.dk <dr@jones.dk>2011-02-07 03:28:57 +0100
commitb880b82b7f4b7c50d79f015eaf635f4b3bd8a1a3 (patch)
treef0bffd00ed41dbe294c71449c02b86d1738fe044 /src/Tests/Arbitrary.hs
parent91179df4907bec919e0884019da785be1ceb01b3 (diff)
Imported Upstream version 1.8.0.3
Diffstat (limited to 'src/Tests/Arbitrary.hs')
-rw-r--r--src/Tests/Arbitrary.hs77
1 files changed, 45 insertions, 32 deletions
diff --git a/src/Tests/Arbitrary.hs b/src/Tests/Arbitrary.hs
index 978717bef..39491431d 100644
--- a/src/Tests/Arbitrary.hs
+++ b/src/Tests/Arbitrary.hs
@@ -6,17 +6,20 @@ where
import Test.QuickCheck.Gen
import Test.QuickCheck.Arbitrary
import Control.Monad (liftM, liftM2)
-import Text.Pandoc
-import Text.Pandoc.Shared
+import Text.Pandoc.Definition
+import Text.Pandoc.Shared (normalize, escapeURI)
import Text.Pandoc.Builder
realString :: Gen String
-realString = resize 8 arbitrary -- elements wordlist
+realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127'])
+ , (1, elements ['\128'..'\9999']) ]
-{-
-wordlist :: [String]
-wordlist = ["foo","Bar","baz","\\","/",":","\"","'","féé"]
--}
+arbAttr :: Gen Attr
+arbAttr = do
+ id' <- elements ["","loc"]
+ classes <- elements [[],["haskell"],["c","numberLines"]]
+ keyvals <- elements [[],[("start","22")],[("a","11"),("b_2","a b c")]]
+ return (id',classes,keyvals)
instance Arbitrary Inlines where
arbitrary = liftM fromList arbitrary
@@ -27,69 +30,79 @@ instance Arbitrary Blocks where
instance Arbitrary Inline where
arbitrary = resize 3 $ arbInline 3
+arbInlines :: Int -> Gen [Inline]
+arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace)
+ where startsWithSpace (Space:_) = True
+ startsWithSpace _ = False
+
-- restrict to 3 levels of nesting max; otherwise we get
-- bogged down in indefinitely large structures
arbInline :: Int -> Gen Inline
arbInline n = frequency $ [ (60, liftM Str realString)
, (60, return Space)
- , (10, liftM2 Code arbitrary realString)
+ , (10, liftM2 Code arbAttr realString)
, (5, return EmDash)
, (5, return EnDash)
, (5, return Apostrophe)
, (5, return Ellipses)
- , (5, elements [ RawInline "html" "<a>*&amp;*</a>"
+ , (5, elements [ RawInline "html" "<a id=\"eek\">"
, RawInline "latex" "\\my{command}" ])
] ++ [ x | x <- nesters, n > 1]
- where nesters = [ (10, liftM Emph $ listOf $ arbInline (n-1))
- , (10, liftM Strong $ listOf $ arbInline (n-1))
- , (10, liftM Strikeout $ listOf $ arbInline (n-1))
- , (10, liftM Superscript $ listOf $ arbInline (n-1))
- , (10, liftM Subscript $ listOf $ arbInline (n-1))
- , (10, liftM SmallCaps $ listOf $ arbInline (n-1))
+ where nesters = [ (10, liftM Emph $ arbInlines (n-1))
+ , (10, liftM Strong $ arbInlines (n-1))
+ , (10, liftM Strikeout $ arbInlines (n-1))
+ , (10, liftM Superscript $ arbInlines (n-1))
+ , (10, liftM Subscript $ arbInlines (n-1))
+-- , (10, liftM SmallCaps $ arbInlines (n-1))
, (10, do x1 <- arbitrary
- x2 <- listOf $ arbInline (n-1)
+ x2 <- arbInlines (n-1)
return $ Quoted x1 x2)
, (10, do x1 <- arbitrary
x2 <- realString
return $ Math x1 x2)
- , (10, do x1 <- listOf $ arbInline (n-1)
+ , (10, do x1 <- arbInlines (n-1)
x3 <- realString
- x2 <- realString
+ x2 <- liftM escapeURI realString
return $ Link x1 (x2,x3))
- , (10, do x1 <- listOf $ arbInline (n-1)
+ , (10, do x1 <- arbInlines (n-1)
x3 <- realString
- x2 <- realString
+ x2 <- liftM escapeURI realString
return $ Image x1 (x2,x3))
- , (2, liftM Note $ resize 3 $ listOf1 arbitrary)
+ , (2, liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1))
]
instance Arbitrary Block where
arbitrary = resize 3 $ arbBlock 3
arbBlock :: Int -> Gen Block
-arbBlock n = frequency $ [ (10, liftM Plain arbitrary)
- , (15, liftM Para arbitrary)
- , (5, liftM2 CodeBlock arbitrary realString)
+arbBlock n = frequency $ [ (10, liftM Plain $ arbInlines (n-1))
+ , (15, liftM Para $ arbInlines (n-1))
+ , (5, liftM2 CodeBlock arbAttr realString)
, (2, elements [ RawBlock "html"
"<div>\n*&amp;*\n</div>"
, RawBlock "latex"
"\\begin[opt]{env}\nhi\n{\\end{env}"
])
, (5, do x1 <- choose (1 :: Int, 6)
- x2 <- arbitrary
+ x2 <- arbInlines (n-1)
return (Header x1 x2))
, (2, return HorizontalRule)
] ++ [x | x <- nesters, n > 0]
- where nesters = [ (5, liftM BlockQuote $ listOf $ arbBlock (n-1))
- , (5, liftM2 OrderedList arbitrary
- $ (listOf1 $ listOf1 $ arbBlock (n-1)))
+ where nesters = [ (5, liftM BlockQuote $ listOf1 $ arbBlock (n-1))
+ , (5, do x2 <- arbitrary
+ x3 <- arbitrary
+ x1 <- arbitrary `suchThat` (> 0)
+ x4 <- listOf1 $ listOf1 $ arbBlock (n-1)
+ return $ OrderedList (x1,x2,x3) x4 )
, (5, liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1)))
- , (5, do x1 <- listOf $ listOf1 $ listOf1 $ arbBlock (n-1)
- x2 <- arbitrary
- return (DefinitionList $ zip x2 x1))
+ , (5, do items <- listOf1 $ do
+ x1 <- listOf1 $ listOf1 $ arbBlock (n-1)
+ x2 <- arbInlines (n-1)
+ return (x2,x1)
+ return $ DefinitionList items)
, (2, do rs <- choose (1 :: Int, 4)
cs <- choose (1 :: Int, 4)
- x1 <- arbitrary
+ x1 <- arbInlines (n-1)
x2 <- vector cs
x3 <- vectorOf cs $ elements [0, 0.25]
x4 <- vectorOf cs $ listOf $ arbBlock (n-1)