summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <fiddlosopher@gmail.com>2013-08-10 19:04:15 -0700
committerJohn MacFarlane <fiddlosopher@gmail.com>2013-08-10 19:04:15 -0700
commit6f736dfa7578faab7b90546ee5b2c275185968c8 (patch)
treeefb29a4478c223faa1aa03a4cb9acc4307297391
parent02a125d0aa8becd258c99b27c5e30116f0cbacb4 (diff)
Added Tests.Walk.
This verifies that walk and query match the generic traversals.
-rw-r--r--pandoc.cabal1
-rw-r--r--tests/Tests/Walk.hs47
-rw-r--r--tests/test-pandoc.hs2
3 files changed, 50 insertions, 0 deletions
diff --git a/pandoc.cabal b/pandoc.cabal
index 3903fe606..e22908918 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -406,6 +406,7 @@ Test-Suite test-pandoc
Tests.Helpers
Tests.Arbitrary
Tests.Shared
+ Tests.Walk
Tests.Readers.LaTeX
Tests.Readers.Markdown
Tests.Readers.RST
diff --git a/tests/Tests/Walk.hs b/tests/Tests/Walk.hs
new file mode 100644
index 000000000..f6aa1beae
--- /dev/null
+++ b/tests/Tests/Walk.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-}
+module Tests.Walk (tests) where
+
+import Text.Pandoc.Definition
+import Text.Pandoc.Walk
+import Test.Framework
+import Tests.Helpers
+import Data.Char (toUpper)
+import Tests.Arbitrary()
+import Data.Generics
+import Data.Monoid
+
+tests :: [Test]
+tests = [ testGroup "Walk"
+ [ property "p_walk inlineTrans" (p_walk inlineTrans)
+ , property "p_walk blockTrans" (p_walk blockTrans)
+ , property "p_query inlineQuery" (p_query inlineQuery)
+ , property "p_query blockQuery" (p_query blockQuery)
+ ]
+ ]
+
+p_walk :: (Typeable a, Walkable a Pandoc)
+ => (a -> a) -> Pandoc -> Bool
+p_walk f = (\(d :: Pandoc) -> everywhere (mkT f) d == walk f d)
+
+p_query :: (Eq a, Typeable a1, Monoid a, Walkable a1 Pandoc)
+ => (a1 -> a) -> Pandoc -> Bool
+p_query f = (\(d :: Pandoc) -> everything mappend (mempty `mkQ` f) d == query f d)
+
+inlineTrans :: Inline -> Inline
+inlineTrans (Str xs) = Str $ map toUpper xs
+inlineTrans (Emph xs) = Strong xs
+inlineTrans x = x
+
+blockTrans :: Block -> Block
+blockTrans (Plain xs) = Para xs
+blockTrans (BlockQuote xs) = Div ("",["special"],[]) xs
+blockTrans x = x
+
+inlineQuery :: Inline -> String
+inlineQuery (Str xs) = xs
+inlineQuery _ = ""
+
+blockQuery :: Block -> [Int]
+blockQuery (Header lev _ _) = [lev]
+blockQuery _ = []
+
diff --git a/tests/test-pandoc.hs b/tests/test-pandoc.hs
index 24b7a8261..67ca5eae2 100644
--- a/tests/test-pandoc.hs
+++ b/tests/test-pandoc.hs
@@ -14,11 +14,13 @@ import qualified Tests.Writers.HTML
import qualified Tests.Writers.Native
import qualified Tests.Writers.Markdown
import qualified Tests.Shared
+import qualified Tests.Walk
import Text.Pandoc.Shared (inDirectory)
tests :: [Test]
tests = [ testGroup "Old" Tests.Old.tests
, testGroup "Shared" Tests.Shared.tests
+ , testGroup "Walk" Tests.Walk.tests
, testGroup "Writers"
[ testGroup "Native" Tests.Writers.Native.tests
, testGroup "ConTeXt" Tests.Writers.ConTeXt.tests