diff --git a/pandoc.cabal b/pandoc.cabal
index b3665df27..95c08b0f1 100644
--- a/pandoc.cabal
+++ b/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
diff --git a/tests/Tests/Helpers.hs b/tests/Tests/Helpers.hs
index 67de55dcc..028f93fe7 100644
--- a/tests/Tests/Helpers.hs
+++ b/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
diff --git a/tests/Tests/Readers/LaTeX.hs b/tests/Tests/Readers/LaTeX.hs
index 55bd0400f..9db909b17 100644
--- a/tests/Tests/Readers/LaTeX.hs
+++ b/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")
]
]
diff --git a/tests/Tests/Writers/ConTeXt.hs b/tests/Tests/Writers/ConTeXt.hs
index 1a887de1f..9b59c617d 100644
--- a/tests/Tests/Writers/ConTeXt.hs
+++ b/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|]
]
]