1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
-- Utility functions for the test suite.
module Tests.Helpers ( 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, trimr)
import Text.Pandoc.Options
import Text.Pandoc.Writers.Native (writeNative)
import qualified Test.QuickCheck.Property as QP
import Data.Algorithm.Diff
import qualified Data.Map as M
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 "result" ++ nl ++
unlines (map vividize diff) ++
dashes ""
nl = "\n"
input' = toString input
actual' = lines $ toString $ fn input
expected' = lines $ toString expected
diff = getDiff expected' actual'
dashes "" = replicate 72 '-'
dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
vividize :: Diff String -> String
vividize (Both s _) = " " ++ s
vividize (First s) = "- " ++ s
vividize (Second s) = "+ " ++ s
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 def{ writerStandalone = s } $ toPandoc d
where s = case d of
(Pandoc (Meta m) _)
| M.null m -> False
| otherwise -> True
instance ToString Blocks where
toString = writeNative def . toPandoc
instance ToString Inlines where
toString = trimr . writeNative def . 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
|
