f869f7e08d
* Depend on pandoc 1.12. * Added yaml dependency. * `Text.Pandoc.XML`: Removed `stripTags`. (API change.) * `Text.Pandoc.Shared`: Added `metaToJSON`. This will be used in writers to create a JSON object for use in the templates from the pandoc metadata. * Revised readers and writers to use the new Meta type. * `Text.Pandoc.Options`: Added `Ext_yaml_title_block`. * Markdown reader: Added support for YAML metadata block. Note that it must come at the beginning of the document. * `Text.Pandoc.Parsing.ParserState`: Replace `stateTitle`, `stateAuthors`, `stateDate` with `stateMeta`. * RST reader: Improved metadata. Treat initial field list as metadata when standalone specified. Previously ALL fields "title", "author", "date" in field lists were treated as metadata, even if not at the beginning. Use `subtitle` metadata field for subtitle. * `Text.Pandoc.Templates`: Export `renderTemplate'` that takes a string instead of a compiled template.. * OPML template: Use 'for' loop for authors. * Org template: '#+TITLE:' is inserted before the title. Previously the writer did this.
193 lines
8 KiB
Haskell
193 lines
8 KiB
Haskell
{-# 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 :: Inlines) <- arbitrary
|
|
(x2 :: [Inlines]) <- liftM (filter (not . isNull)) arbitrary
|
|
(x3 :: Inlines) <- arbitrary
|
|
return $ setMeta "title" x1
|
|
$ setMeta "author" x2
|
|
$ setMeta "date" x3
|
|
$ nullMeta
|
|
|
|
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"
|
|
|