From 714303b210b249292b83eb13ed37dd897999380d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 4 Feb 2011 18:32:30 -0800 Subject: Improved Arbitrary instance. --- src/Tests/Arbitrary.hs | 77 +++++++++++++++++++++++++++++--------------------- 1 file 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" "*&*" + , (5, elements [ RawInline "html" "" , 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" "
\n*&*\n
" , 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) -- cgit v1.2.3