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