{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}
-- provides Arbitrary instance for Pandoc types
module Tests.Arbitrary ()
where
import Test.QuickCheck.Gen
import Test.QuickCheck.Arbitrary
import Control.Monad (liftM, liftM2)
import Text.Pandoc.Definition
import Text.Pandoc.Shared (normalize, escapeURI)
import Text.Pandoc.Builder
realString :: Gen String
realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127'])
, (1, elements ['\128'..'\9999']) ]
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 :: [Inline] -> Inlines) arbitrary
instance Arbitrary Blocks where
arbitrary = liftM (fromList :: [Block] -> Blocks) arbitrary
instance Arbitrary Inline where
arbitrary = resize 3 $ arbInline 2
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 arbAttr realString)
, (5, elements [ RawInline "html" "<a id=\"eek\">"
, RawInline "latex" "\\my{command}" ])
] ++ [ x | x <- nesters, 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 <- arbInlines (n-1)
return $ Quoted x1 x2)
, (10, do x1 <- arbitrary
x2 <- realString
return $ Math x1 x2)
, (10, do x1 <- arbInlines (n-1)
x3 <- realString
x2 <- liftM escapeURI realString
return $ Link x1 (x2,x3))
, (10, do x1 <- arbInlines (n-1)
x3 <- realString
x2 <- liftM escapeURI realString
return $ Image x1 (x2,x3))
, (2, liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1))
]
instance Arbitrary Block where
arbitrary = resize 3 $ arbBlock 2
arbBlock :: Int -> Gen Block
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*&*\n</div>"
, RawBlock "latex"
"\\begin[opt]{env}\nhi\n{\\end{env}"
])
, (5, do x1 <- choose (1 :: Int, 6)
x2 <- arbInlines (n-1)
return (Header x1 nullAttr x2))
, (2, return HorizontalRule)
] ++ [x | x <- nesters, n > 0]
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 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 <- arbInlines (n-1)
x2 <- vector cs
x3 <- vectorOf cs $ elements [0, 0.25]
x4 <- vectorOf cs $ listOf $ arbBlock (n-1)
x5 <- vectorOf rs $ vectorOf cs
$ listOf $ arbBlock (n-1)
return (Table x1 x2 x3 x4 x5))
]
instance Arbitrary Pandoc where
arbitrary = resize 8 $ liftM normalize
$ liftM2 Pandoc arbitrary arbitrary
{-
instance Arbitrary CitationMode where
arbitrary
= do x <- choose (0 :: Int, 2)
case x of
0 -> return AuthorInText
1 -> return SuppressAuthor
2 -> return NormalCitation
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance Arbitrary Citation where
arbitrary
= do x1 <- liftM (filter (`notElem` ",;]@ \t\n")) arbitrary
x2 <- arbitrary
x3 <- arbitrary
x4 <- arbitrary
x5 <- arbitrary
x6 <- arbitrary
return (Citation x1 x2 x3 x4 x5 x6)
-}
instance Arbitrary MathType where
arbitrary
= do x <- choose (0 :: Int, 1)
case x of
0 -> return DisplayMath
1 -> return InlineMath
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance Arbitrary QuoteType where
arbitrary
= do x <- choose (0 :: Int, 1)
case x of
0 -> return SingleQuote
1 -> return DoubleQuote
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance Arbitrary Meta where
arbitrary
= do x1 <- arbitrary
x2 <- liftM (filter (not . null)) arbitrary
x3 <- arbitrary
return (Meta x1 x2 x3)
instance Arbitrary Alignment where
arbitrary
= do x <- choose (0 :: Int, 3)
case x of
0 -> return AlignLeft
1 -> return AlignRight
2 -> return AlignCenter
3 -> return AlignDefault
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance Arbitrary ListNumberStyle where
arbitrary
= do x <- choose (0 :: Int, 6)
case x of
0 -> return DefaultStyle
1 -> return Example
2 -> return Decimal
3 -> return LowerRoman
4 -> return UpperRoman
5 -> return LowerAlpha
6 -> return UpperAlpha
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
instance Arbitrary ListNumberDelim where
arbitrary
= do x <- choose (0 :: Int, 3)
case x of
0 -> return DefaultDelim
1 -> return Period
2 -> return OneParen
3 -> return TwoParens
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"