@@ -23,6 +23,8 @@ import Text.Pandoc.Writers.Native (writeNative)
2323import Language.Haskell.TH.Quote
2424import Language.Haskell.TH.Syntax (Q, runIO)
2525import qualified Test.QuickCheck.Property as QP
26+import System.Console.ANSI
27+import Data.Algorithm.Diff
2628
2729lit :: QuasiQuoter
2830lit = QuasiQuoter ((\a -> let b = rnl a in [|b|]) . filter (/= '\r')) $
@@ -49,20 +51,32 @@ test :: (ToString a, ToString b, ToString c)
4951 -> Test
5052test fn name (input, expected) =
5153 testCase name $ assertBool msg (actual' == expected')
52− where msg = dashes "input" ++ input' ++
53− dashes "expected" ++ expected' ++
54− dashes "got" ++ actual' ++
54+ where msg = nl ++ dashes "input" ++ nl ++ input' ++ nl ++
55+ dashes "expected" ++ nl ++ expected'' ++
56+ dashes "got" ++ nl ++ actual'' ++
5557 dashes ""
58+ nl = "\n"
5659 input' = toString input
5760 actual' = toString $ fn input
5861 expected' = toString expected
59− dashes "" = '\n' : replicate 72 '-'
60− dashes x = '\n' : replicate (72 - length x - 5) '-' ++ " " ++
61− x ++ " ---\n"
62+ diff = getDiff (lines expected') (lines actual')
63+ expected'' = unlines $ map vividize $ filter (\(d,_) -> d /= S) diff
64+ actual'' = unlines $ map vividize $ filter (\(d,_) -> d /= F) diff
65+ dashes "" = replicate 72 '-'
66+ dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
67+
68+vividize :: (DI,String) -> String
69+vividize (B,s) = s
70+vividize (_,s) = vivid s
6271
6372property :: QP.Testable a => TestName -> a -> Test
6473property = testProperty
6574
75+vivid :: String -> String
76+vivid s = setSGRCode [SetColor Background Dull Red
77+ , SetColor Foreground Vivid White] ++ s
78+ ++ setSGRCode [Reset]
79+
6680infix 6 =?>
6781(=?>) :: a -> b -> (a,b)
6882x =?> y = (x, y)