git.iko.soy/typeable/pandoc
on 34412cf help sign in
typeable/pandoc/test/Tests/Helpers.hs
133 lines 4.3 kB history raw
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3-- Utility functions for the test suite.
5module Tests.Helpers ( test
6 , TestResult(..)
7 , showDiff
8 , findPandoc
9 , (=?>)
10 , purely
11 , ToString(..)
12 , ToPandoc(..)
13 )
14 where
16import Data.Algorithm.Diff
17import qualified Data.Map as M
18import System.Directory
19import System.Environment.Executable (getExecutablePath)
20import System.Exit
21import System.FilePath
22import Test.Tasty
23import Test.Tasty.HUnit
24import Text.Pandoc.Builder (Blocks, Inlines, doc, plain)
25import Text.Pandoc.Class
26import Text.Pandoc.Definition
27import Text.Pandoc.Options
28import Text.Pandoc.Shared (trimr)
29import Text.Pandoc.Writers.Native (writeNative)
30import Text.Printf
32test :: (ToString a, ToString b, ToString c)
33 => (a -> b) -- ^ function to test
34 -> String -- ^ name of test case
35 -> (a, c) -- ^ (input, expected value)
36 -> TestTree
37test fn name (input, expected) =
38 testCase name' $ assertBool msg (actual' == expected')
39 where msg = nl ++ dashes "input" ++ nl ++ input' ++ nl ++
40 dashes "result" ++ nl ++
41 unlines (map vividize diff) ++
42 dashes ""
43 nl = "\n"
44 name' = if length name > 54
45 then take 52 name ++ "..." -- avoid wide output
46 else name
47 input' = toString input
48 actual' = lines $ toString $ fn input
49 expected' = lines $ toString expected
50 diff = getDiff expected' actual'
51 dashes "" = replicate 72 '-'
52 dashes x = replicate (72 - length x - 5) '-' ++ " " ++ x ++ " ---"
54data TestResult = TestPassed
55 | TestError ExitCode
56 | TestFailed String FilePath [Diff String]
57 deriving (Eq)
59instance Show TestResult where
60 show TestPassed = "PASSED"
61 show (TestError ec) = "ERROR " ++ show ec
62 show (TestFailed cmd file d) = '\n' : dash ++
63 "\n--- " ++ file ++
64 "\n+++ " ++ cmd ++ "\n" ++ showDiff (1,1) d ++
65 dash
66 where dash = replicate 72 '-'
68showDiff :: (Int,Int) -> [Diff String] -> String
69showDiff _ [] = ""
70showDiff (l,r) (First ln : ds) =
71 printf "+%4d " l ++ ln ++ "\n" ++ showDiff (l+1,r) ds
72showDiff (l,r) (Second ln : ds) =
73 printf "-%4d " r ++ ln ++ "\n" ++ showDiff (l,r+1) ds
74showDiff (l,r) (Both _ _ : ds) =
75 showDiff (l+1,r+1) ds
77-- | Find pandoc executable relative to test-pandoc
78-- First, try in same directory (e.g. if both in ~/.cabal/bin)
79-- Second, try ../pandoc (e.g. if in dist/XXX/build/test-pandoc)
80findPandoc :: IO FilePath
81findPandoc = do
82 testExePath <- getExecutablePath
83 let testExeDir = takeDirectory testExePath
84 found <- doesFileExist (testExeDir </> "pandoc")
85 return $ if found
86 then testExeDir </> "pandoc"
87 else case splitDirectories testExeDir of
88 [] -> error "test-pandoc: empty testExeDir"
89 xs -> joinPath (init xs) </> "pandoc" </> "pandoc"
92vividize :: Diff String -> String
93vividize (Both s _) = " " ++ s
94vividize (First s) = "- " ++ s
95vividize (Second s) = "+ " ++ s
97purely :: (b -> PandocPure a) -> b -> a
98purely f = either (error . show) id . runPure . f
100infix 5 =?>
101(=?>) :: a -> b -> (a,b)
102x =?> y = (x, y)
104class ToString a where
105 toString :: a -> String
107instance ToString Pandoc where
108 toString d = purely (writeNative def{ writerTemplate = s }) $ toPandoc d
109 where s = case d of
110 (Pandoc (Meta m) _)
111 | M.null m -> Nothing
112 | otherwise -> Just "" -- need this to get meta output
114instance ToString Blocks where
115 toString = purely (writeNative def) . toPandoc
117instance ToString Inlines where
118 toString = trimr . purely (writeNative def) . toPandoc
120instance ToString String where
121 toString = id
123class ToPandoc a where
124 toPandoc :: a -> Pandoc
126instance ToPandoc Pandoc where
127 toPandoc = id
129instance ToPandoc Blocks where
130 toPandoc = doc
132instance ToPandoc Inlines where
133 toPandoc = doc . plain