summaryrefslogtreecommitdiff
path: root/src/Tests/Helpers.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Tests/Helpers.hs')
-rw-r--r--src/Tests/Helpers.hs114
1 files changed, 0 insertions, 114 deletions
diff --git a/src/Tests/Helpers.hs b/src/Tests/Helpers.hs
deleted file mode 100644
index 66879efed..000000000
--- a/src/Tests/Helpers.hs
+++ /dev/null
@@ -1,114 +0,0 @@
-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TemplateHaskell #-}
--- Utility functions for the test suite.
-
-module Tests.Helpers ( lit
- , file
- , test
- , (=?>)
- , property
- , ToString(..)
- , ToPandoc(..)
- )
- where
-
-import Text.Pandoc.Definition
-import Text.Pandoc.Builder (Inlines, Blocks, doc, plain)
-import Test.Framework
-import Test.Framework.Providers.HUnit
-import Test.Framework.Providers.QuickCheck2
-import Test.HUnit (assertBool)
-import Text.Pandoc.Shared (normalize, defaultWriterOptions,
- WriterOptions(..), removeTrailingSpace)
-import Text.Pandoc.Writers.Native (writeNative)
-import Language.Haskell.TH.Quote (QuasiQuoter(..))
-import Language.Haskell.TH.Syntax (Q, runIO)
-import qualified Test.QuickCheck.Property as QP
-import System.Console.ANSI
-import Data.Algorithm.Diff
-
-lit :: QuasiQuoter
-lit = QuasiQuoter {
- quoteExp = (\a -> let b = rnl a in [|b|]) . filter (/= '\r')
- , quotePat = error "Cannot use lit as a pattern"
- }
- where rnl ('\n':xs) = xs
- rnl xs = xs
-
-file :: QuasiQuoter
-file = quoteFile lit
-
--- adapted from TH 2.5 code
-quoteFile :: QuasiQuoter -> QuasiQuoter
-quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp }) =
- QuasiQuoter { quoteExp = get qe, quotePat = get qp }
- where
- get :: (String -> Q a) -> String -> Q a
- get old_quoter file_name = do { file_cts <- runIO (readFile file_name)
- ; old_quoter file_cts }
-
-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 = nl ++ dashes "input" ++ nl ++ input' ++ nl ++
- dashes "expected" ++ nl ++ expected'' ++
- dashes "got" ++ nl ++ actual'' ++
- dashes ""
- nl = "\n"
- input' = toString input
- actual' = toString $ fn input
- expected' = toString expected
- diff = getDiff (lines expected') (lines actual')
- expected'' = unlines $ map vividize $ filter (\(d,_) -> d /= S) diff
- actual'' = unlines $ map vividize $ filter (\(d,_) -> d /= F) diff
- dashes "" = replicate 72 '-'
- dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
-
-vividize :: (DI,String) -> String
-vividize (B,s) = s
-vividize (F,s) = s
-vividize (S,s) = setSGRCode [SetColor Background Dull Red
- , SetColor Foreground Vivid White] ++ s
- ++ setSGRCode [Reset]
-
-property :: QP.Testable a => TestName -> a -> Test
-property = testProperty
-
-infix 5 =?>
-(=?>) :: a -> b -> (a,b)
-x =?> y = (x, y)
-
-class ToString a where
- toString :: a -> String
-
-instance ToString Pandoc where
- toString d = writeNative defaultWriterOptions{ writerStandalone = s }
- $ toPandoc d
- where s = case d of
- (Pandoc (Meta [] [] []) _) -> False
- _ -> True
-
-instance ToString Blocks where
- toString = writeNative defaultWriterOptions . toPandoc
-
-instance ToString Inlines where
- toString = removeTrailingSpace . writeNative defaultWriterOptions .
- toPandoc
-
-instance ToString String where
- toString = id
-
-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