git.iko.soy/typeable/pandoc
on 1dfda7e help sign in
typeable/pandoc/test/Tests/Command.hs
95 lines 3.8 kB history raw
1module Tests.Command (findPandoc, runTest, tests)
2where
4import Data.Algorithm.Diff
5import qualified Data.ByteString as BS
6import Data.List (isSuffixOf)
7import Prelude hiding (readFile)
8import System.Directory
9import System.Exit
10import System.FilePath (joinPath, splitDirectories, takeDirectory, (</>))
11import System.IO (hPutStr, stderr)
12import System.IO.Unsafe (unsafePerformIO)
13import System.Process
14import Test.Tasty
15import Test.Tasty.HUnit
16import Tests.Helpers
17import Text.Pandoc
18import qualified Text.Pandoc.UTF8 as UTF8
20-- | Run a test with normalize function, return True if test passed.
21runTest :: String -- ^ Title of test
22 -> FilePath -- ^ Path to pandoc
23 -> String -- ^ Shell command
24 -> String -- ^ Input text
25 -> String -- ^ Expected output
26 -> TestTree
27runTest testname pandocpath cmd inp norm = testCase testname $ do
28 let findDynlibDir [] = Nothing
29 findDynlibDir ("build":xs) = Just $ joinPath (reverse xs) </> "build"
30 findDynlibDir (_:xs) = findDynlibDir xs
31 let mbDynlibDir = findDynlibDir (reverse $ splitDirectories $
32 takeDirectory $ takeWhile (/=' ') cmd)
33 let dynlibEnv = case mbDynlibDir of
34 Nothing -> []
35 Just d -> [("DYLD_LIBRARY_PATH", d),
36 ("LD_LIBRARY_PATH", d)]
37 let env' = dynlibEnv ++ [("PATH",takeDirectory pandocpath),("TMP","."),("LANG","en_US.UTF-8"),("HOME", "./"),("pandoc_datadir", "..")]
38 let pr = (shell cmd){ env = Just env' }
39 (ec, out', err') <- readCreateProcessWithExitCode pr inp
40 -- filter \r so the tests will work on Windows machines
41 let out = filter (/= '\r') $ err' ++ out'
42 result <- if ec == ExitSuccess
43 then
44 if out == norm
45 then return TestPassed
46 else return
47 $ TestFailed cmd "expected"
48 $ getDiff (lines out) (lines norm)
49 else do
50 hPutStr stderr err'
51 return $ TestError ec
52 assertBool (show result) (result == TestPassed)
54tests :: TestTree
55{-# NOINLINE tests #-}
56tests = unsafePerformIO $ do
57 pandocpath <- findPandoc
58 files <- filter (".md" `isSuffixOf`) <$>
59 getDirectoryContents "command"
60 let cmds = map (extractCommandTest pandocpath) files
61 return $ testGroup "Command:" cmds
63isCodeBlock :: Block -> Bool
64isCodeBlock (CodeBlock _ _) = True
65isCodeBlock _ = False
67extractCode :: Block -> String
68extractCode (CodeBlock _ code) = code
69extractCode _ = ""
71dropPercent :: String -> String
72dropPercent ('%':xs) = dropWhile (== ' ') xs
73dropPercent xs = xs
75runCommandTest :: FilePath -> (Int, String) -> TestTree
76runCommandTest pandocpath (num, code) =
77 let codelines = lines code
78 (continuations, r1) = span ("\\" `isSuffixOf`) codelines
79 (cmd, r2) = (dropPercent (unwords (map init continuations ++ take 1 r1)),
80 drop 1 r1)
81 (inplines, r3) = break (=="^D") r2
82 normlines = takeWhile (/=".") (drop 1 r3)
83 input = unlines inplines
84 norm = unlines normlines
85 shcmd = cmd -- trimr $ takeDirectory pandocpath </> cmd
86 in runTest ("#" ++ show num) pandocpath shcmd input norm
88extractCommandTest :: FilePath -> FilePath -> TestTree
89extractCommandTest pandocpath fp = unsafePerformIO $ do
90 contents <- UTF8.toText <$> BS.readFile ("command" </> fp)
91 Pandoc _ blocks <- runIOorExplode (readMarkdown
92 def{ readerExtensions = pandocExtensions } contents)
93 let codeblocks = map extractCode $ filter isCodeBlock blocks
94 let cases = map (runCommandTest pandocpath) $ zip [1..] codeblocks
95 return $ testGroup fp cases