git.iko.soy/typeable/pandoc
on master help sign in
Added Tests.Walk.

This verifies that walk and query match the generic traversals.

commit6f736dfa7578faab7b90546ee5b2c275185968c8 authorJohn MacFarlane <fiddlosopher@gmail.com> dateSat 10 Aug 2013, 19:04 (13 years ago) parent02a125d
3 files changed+50
pandoc.cabal+1 tests/Tests/Walk.hs+47 tests/test-pandoc.hs+2
pandoc.cabal+1
@@ -406,6 +406,7 @@ Test-Suite test-pandoc
406406 Tests.Helpers
407407 Tests.Arbitrary
408408 Tests.Shared
409+ Tests.Walk
409410 Tests.Readers.LaTeX
410411 Tests.Readers.Markdown
411412 Tests.Readers.RST
tests/Tests/Walk.hsnew file+47
@@ -0,0 +1,47 @@
1+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
2+module Tests.Walk (tests) where
3+
4+import Text.Pandoc.Definition
5+import Text.Pandoc.Walk
6+import Test.Framework
7+import Tests.Helpers
8+import Data.Char (toUpper)
9+import Tests.Arbitrary()
10+import Data.Generics
11+import Data.Monoid
12+
13+tests :: [Test]
14+tests = [ testGroup "Walk"
15+ [ property "p_walk inlineTrans" (p_walk inlineTrans)
16+ , property "p_walk blockTrans" (p_walk blockTrans)
17+ , property "p_query inlineQuery" (p_query inlineQuery)
18+ , property "p_query blockQuery" (p_query blockQuery)
19+ ]
20+ ]
21+
22+p_walk :: (Typeable a, Walkable a Pandoc)
23+ => (a -> a) -> Pandoc -> Bool
24+p_walk f = (\(d :: Pandoc) -> everywhere (mkT f) d == walk f d)
25+
26+p_query :: (Eq a, Typeable a1, Monoid a, Walkable a1 Pandoc)
27+ => (a1 -> a) -> Pandoc -> Bool
28+p_query f = (\(d :: Pandoc) -> everything mappend (mempty `mkQ` f) d == query f d)
29+
30+inlineTrans :: Inline -> Inline
31+inlineTrans (Str xs) = Str $ map toUpper xs
32+inlineTrans (Emph xs) = Strong xs
33+inlineTrans x = x
34+
35+blockTrans :: Block -> Block
36+blockTrans (Plain xs) = Para xs
37+blockTrans (BlockQuote xs) = Div ("",["special"],[]) xs
38+blockTrans x = x
39+
40+inlineQuery :: Inline -> String
41+inlineQuery (Str xs) = xs
42+inlineQuery _ = ""
43+
44+blockQuery :: Block -> [Int]
45+blockQuery (Header lev _ _) = [lev]
46+blockQuery _ = []
47+
tests/test-pandoc.hs+2
@@ -14,11 +14,13 @@ import qualified Tests.Writers.HTML
1414import qualified Tests.Writers.Native
1515import qualified Tests.Writers.Markdown
1616import qualified Tests.Shared
17+import qualified Tests.Walk
1718import Text.Pandoc.Shared (inDirectory)
1819
1920tests :: [Test]
2021tests = [ testGroup "Old" Tests.Old.tests
2122 , testGroup "Shared" Tests.Shared.tests
23+ , testGroup "Walk" Tests.Walk.tests
2224 , testGroup "Writers"
2325 [ testGroup "Native" Tests.Writers.Native.tests
2426 , testGroup "ConTeXt" Tests.Writers.ConTeXt.tests