Improved test framework.

Now there is a uniform interface for reader and writer tests.
Also added a quasiquoter, for multiline strings.

pandoc.cabal

@@ -341,7 +341,8 @@ Executable test-pandoc
     Extensions:       CPP
     Build-Depends:    base >= 4 && < 5, Diff, test-framework >= 0.3 && < 0.4,
                       test-framework-hunit >= 0.2 && < 0.3,
-                      HUnit >= 1.2 && < 1.3
+                      HUnit >= 1.2 && < 1.3,
+                      template-haskell == 2.4.*
     Other-Modules:    Tests.Old
                       Tests.Helpers
                       Tests.Arbitrary

tests/Tests/Helpers.hs

@@ -1,39 +1,74 @@
-{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TemplateHaskell #-}
 -- Utility functions for the test suite.
 
 module Tests.Helpers where
 
-import Text.Pandoc
-import Text.Pandoc.Builder
+import Text.Pandoc.Definition
+import Text.Pandoc.Builder (Inlines, Blocks, doc, plain)
 import Test.Framework
 import Test.Framework.Providers.HUnit
 import Test.HUnit hiding (Test)
+import Text.Pandoc.Shared (normalize, defaultWriterOptions,
+                           WriterOptions(..), removeTrailingSpace)
+import Text.Pandoc.Writers.Native (writeNative)
+import Language.Haskell.TH.Quote
 
-infix 8 -->
+lit :: QuasiQuoter
+lit = QuasiQuoter ((\a -> let b = rnl a in [|b|]) . filter (/= '\r')) $
+         error "Cannot use lit as a pattern"
+       where rnl ('\n':xs) = xs
+             rnl xs        = xs
 
-(-->) :: (Eq a, Show a, Show b) => (b, a) -> a -> Assertion
-(b,a) --> e = assertEqual (show b) e a
+test :: (ToString a, ToString b, ToString c)
+     => (a -> b)  -- ^ function to test
+     -> String    -- ^ name of test case
+     -> (a, c)    -- ^ (input, expected value)
+     -> Test
+test fn name (input, expected) =
+  testCase name $ assertBool msg (actual' == expected')
+     where msg = dashes "input" ++ input' ++
+                 dashes "expected" ++ expected' ++
+                 dashes "got" ++ actual' ++
+                 dashes ""
+           input'  = toString input
+           actual' = toString $ fn input
+           expected' = toString expected
+           dashes "" = '\n' : replicate 72 '-'
+           dashes x  = '\n' : replicate (72 - length x - 5) '-' ++ " " ++
+                              x ++ " ---\n"
 
--- In the first argument, the String is the input, and the Pandoc
--- the output, of a pandoc reader.  The input is shown in case
--- the test fails.
-class Expect a where
-  (=?>) :: (String, Pandoc) -> a -> Assertion
+infix 6 =?>
+(=?>) :: a -> b -> (a,b)
+x =?> y = (x, y)
 
-infix 8 =?>
+class ToString a where
+  toString :: a -> String
 
-(=:) :: TestName -> Assertion -> Test
-(=:) = testCase
+instance ToString Pandoc where
+  toString d = writeNative defaultWriterOptions{ writerStandalone = s }
+               $ toPandoc d
+   where s = case d of
+                  (Pandoc (Meta [] [] []) _) -> False
+                  _                          -> True
 
-infix 6 =:
+instance ToString Blocks where
+  toString = writeNative defaultWriterOptions . toPandoc
 
-instance Expect Inlines where
-  (s, Pandoc _ [Para ils]) =?> e = assertEqual (show s) (toList e) ils
-  (s, g)                   =?> e = assertEqual (show s) (doc $ para e) g
+instance ToString Inlines where
+  toString = removeTrailingSpace . writeNative defaultWriterOptions .
+             toPandoc
 
-instance Expect Blocks where
-  (s, Pandoc _ bls)        =?> e = assertEqual (show s) (toList e) bls
+instance ToString String where
+  toString = id
 
-instance Expect Pandoc where
-  (s, g) =?> e = assertEqual (show s) e g
+class ToPandoc a where
+  toPandoc :: a -> Pandoc
 
+instance ToPandoc Pandoc where
+  toPandoc = normalize
+
+instance ToPandoc Blocks where
+  toPandoc = normalize . doc
+
+instance ToPandoc Inlines where
+  toPandoc = normalize . doc . plain

tests/Tests/Readers/LaTeX.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Tests.Readers.LaTeX (tests) where
 
 import Text.Pandoc.Definition
@@ -5,34 +6,38 @@ import Test.Framework
 import Tests.Helpers
 import Text.Pandoc.Builder
 import Text.Pandoc
-import Text.Pandoc.Shared (normalize)
 
-latex :: String -> (String, Pandoc)
-latex s = (s, normalize . readLaTeX defaultParserState{stateSmart = True} $ s)
+latex :: String -> Pandoc
+latex = readLaTeX defaultParserState
+
+infix 5 =:
+(=:) :: ToString c
+     => String -> (String, c) -> Test
+(=:) = test latex
 
 tests :: [Test]
 tests = [ testGroup "basic"
           [ "simple" =:
-            latex "word" =?> str "word"
+            "wo rd" =?> para "word"
           , "space" =:
-            latex "some text" =?> text "some text"
+            "some text" =?> para ("some text")
           , "emphasized" =:
-            latex "\\emph{emphasized}" =?> (emph $ str "emphasized")
+            "\\emph{emphasized}" =?> para (emph "emphasized")
           ]
 
         , testGroup "headers"
           [ "level 1" =:
-            latex "\\section{header}" =?> header 1 (str "header")
+            "\\section{header}" =?> header 1 "header"
           , "level 2" =:
-            latex "\\subsection{header}" =?> header 2 (str "header")
+            "\\subsection{header}" =?> header 2 "header"
           , "level 3" =:
-            latex "\\subsubsection{header}" =?> header 3 (str "header")
+            "\\subsubsection{header}" =?> header 3 "header"
           , "emph" =:
-            latex "\\section{text \\emph{emph}}" =?>
-              header 1 (str "text" +++ space +++ emph (str "emph"))
+            "\\section{text \\emph{emph}}" =?>
+             header 1 ("text" +++ space +++ emph "emph")
           , "link" =:
-            latex "\\section{text \\href{/url}{link}}" =?>
-              header 1 (str "text" +++ space +++ link "/url" "" (str "link"))
+            "\\section{text \\href{/url}{link}}" =?>
+              header 1 ("text" +++ space +++ link "/url" "" "link")
           ]
         ]
 

tests/Tests/Writers/ConTeXt.hs

@@ -1,29 +1,60 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
 module Tests.Writers.ConTeXt (tests) where
 
 import Test.Framework
 import Text.Pandoc.Builder
 import Text.Pandoc
-import Text.Pandoc.Shared (removeTrailingSpace)
 import Tests.Helpers
 
-inlines :: Inlines -> (Inlines, String)
-inlines ils = (ils, removeTrailingSpace .
-                    writeConTeXt defaultWriterOptions . doc . plain $ ils)
+context :: (ToString a, ToPandoc a) => a -> String
+context = writeConTeXt defaultWriterOptions . toPandoc
 
-blocks :: Blocks -> (Blocks, String)
-blocks bls =  (bls, writeConTeXt defaultWriterOptions . doc $ bls)
+{-
+  "my test" =: X =?> Y
+
+is shorthand for
+
+  test context "my test" $ X =?> Y
+
+which is in turn shorthand for
+
+  test context "my test" (X,Y)
+-}
+
+infix 5 =:
+(=:) :: (ToString a, ToPandoc a)
+     => String -> (a, String) -> Test
+(=:) = test context
 
 tests :: [Test]
 tests = [ testGroup "inline code"
-          [ "with '}'" =:
-            inlines (code "}") --> "\\mono{\\letterclosebrace{x}}"
-          , "without '}'" =:
-            inlines (code "]") --> "\\type{]}"
+          [ "with '}'" =: code "}" =?> "\\mono{\\letterclosebrace{}}"
+          , "without '}'" =: code "]" =?> "\\type{]}"
           ]
         , testGroup "headers"
           [ "level 1" =:
-            blocks (header 1 "My header") --> "\\subject{My header}"
+            header 1 "My header" =?> "\\subject{My header}"
+          ]
+        , testGroup "bullet lists"
+          [ "nested" =:
+            bulletList [plain (text "top")
+                        ,bulletList [plain (text "next")
+                         ,bulletList [plain (text "bot")]]]
+              =?> [$lit|
+\startitemize
+\item
+  top
+\item
+  \startitemize
+  \item
+    next
+  \item
+    \startitemize
+    \item
+      bot
+    \stopitemize
+  \stopitemize
+\stopitemize|]
           ]
         ]