git.iko.soy/typeable/pandoc
on de79021 help sign in
typeable/pandoc/src/Tests/Helpers.hs
116 lines 3.8 kB history raw
1{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TemplateHaskell #-}
2-- Utility functions for the test suite.
4module Tests.Helpers ( lit
5 , file
6 , test
7 , (=?>)
8 , property
9 , ToString(..)
10 , ToPandoc(..)
11 )
12 where
14import Text.Pandoc.Definition
15import Text.Pandoc.Builder (Inlines, Blocks, doc, plain)
16import Test.Framework
17import Test.Framework.Providers.HUnit
18import Test.Framework.Providers.QuickCheck2
19import Test.HUnit (assertBool)
20import Text.Pandoc.Shared (normalize, defaultWriterOptions,
21 WriterOptions(..), removeTrailingSpace)
22import Text.Pandoc.Writers.Native (writeNative)
23import Language.Haskell.TH.Quote (QuasiQuoter(..))
24import Language.Haskell.TH.Syntax (Q, runIO)
25import qualified Test.QuickCheck.Property as QP
26import System.Console.ANSI
27import Data.Algorithm.Diff
29lit :: QuasiQuoter
30lit = QuasiQuoter {
31 quoteExp = (\a -> let b = rnl a in [|b|]) . filter (/= '\r')
32 , quotePat = error "Cannot use lit as a pattern"
33 }
34 where rnl ('\n':xs) = xs
35 rnl xs = xs
37file :: QuasiQuoter
38file = quoteFile lit
40-- adapted from TH 2.5 code
41quoteFile :: QuasiQuoter -> QuasiQuoter
42quoteFile (QuasiQuoter { quoteExp = qe, quotePat = qp }) =
43 QuasiQuoter { quoteExp = get qe, quotePat = get qp }
44 where
45 get :: (String -> Q a) -> String -> Q a
46 get old_quoter file_name = do { file_cts <- runIO (readFile file_name)
47 ; old_quoter file_cts }
49test :: (ToString a, ToString b, ToString c)
50 => (a -> b) -- ^ function to test
51 -> String -- ^ name of test case
52 -> (a, c) -- ^ (input, expected value)
53 -> Test
54test fn name (input, expected) =
55 testCase name $ assertBool msg (actual' == expected')
56 where msg = nl ++ dashes "input" ++ nl ++ input' ++ nl ++
57 dashes "expected" ++ nl ++ expected'' ++
58 dashes "got" ++ nl ++ actual'' ++
59 dashes ""
60 nl = "\n"
61 input' = toString input
62 actual' = toString $ fn input
63 expected' = toString expected
64 diff = getDiff (lines expected') (lines actual')
65 expected'' = unlines $ map vividize $ filter (\(d,_) -> d /= S) diff
66 actual'' = unlines $ map vividize $ filter (\(d,_) -> d /= F) diff
67 dashes "" = replicate 72 '-'
68 dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
70vividize :: (DI,String) -> String
71vividize (B,s) = s
72vividize (_,s) = vivid s
74property :: QP.Testable a => TestName -> a -> Test
75property = testProperty
77vivid :: String -> String
78vivid s = setSGRCode [SetColor Background Dull Red
79 , SetColor Foreground Vivid White] ++ s
80 ++ setSGRCode [Reset]
82infix 6 =?>
83(=?>) :: a -> b -> (a,b)
84x =?> y = (x, y)
86class ToString a where
87 toString :: a -> String
89instance ToString Pandoc where
90 toString d = writeNative defaultWriterOptions{ writerStandalone = s }
91 $ toPandoc d
92 where s = case d of
93 (Pandoc (Meta [] [] []) _) -> False
94 _ -> True
96instance ToString Blocks where
97 toString = writeNative defaultWriterOptions . toPandoc
99instance ToString Inlines where
100 toString = removeTrailingSpace . writeNative defaultWriterOptions .
101 toPandoc
103instance ToString String where
104 toString = id
106class ToPandoc a where
107 toPandoc :: a -> Pandoc
109instance ToPandoc Pandoc where
110 toPandoc = normalize
112instance ToPandoc Blocks where
113 toPandoc = normalize . doc
115instance ToPandoc Inlines where
116 toPandoc = normalize . doc . plain