aboutsummaryrefslogtreecommitdiff
path: root/html-test/run.hs
diff options
context:
space:
mode:
authorŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-01 18:57:05 +0200
committerŁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-22 23:40:26 +0200
commit1377659f2fc98db024e436ffc4c59b5e8be31c7a (patch)
tree0046c20c371f2452b3d8c1b3641d73038bdec188 /html-test/run.hs
parentd5d2030ee343ed5a27db338dea48f801e040db9f (diff)
Add support for executing Haddock process in test runner.
Diffstat (limited to 'html-test/run.hs')
-rwxr-xr-xhtml-test/run.hs53
1 files changed, 53 insertions, 0 deletions
diff --git a/html-test/run.hs b/html-test/run.hs
index a3887df6..91e692a1 100755
--- a/html-test/run.hs
+++ b/html-test/run.hs
@@ -13,6 +13,7 @@ import System.Environment
import System.Exit
import System.FilePath
import System.IO
+import System.Process
baseDir, rootDir :: FilePath
@@ -24,6 +25,9 @@ srcDir = baseDir </> "src"
refDir = baseDir </> "ref"
outDir = baseDir </> "out"
+resDir :: FilePath
+resDir = rootDir </> "resources"
+
data Config = Config
{ cfgHaddockPath :: FilePath
@@ -34,6 +38,21 @@ data Config = Config
main :: IO ()
main = do
Config { .. } <- parseArgs =<< getArgs
+
+ env <- Just . (:) ("haddock_datadir", resDir) <$> getEnvironment
+
+ handle <- runProcess' cfgHaddockPath $ processConfig
+ { pcEnv = env
+ , pcArgs = ["--version"]
+ }
+ waitForSuccess "Failed to run `haddock --version`" handle
+
+ handle <- runProcess' cfgHaddockPath $ processConfig
+ { pcEnv = env
+ , pcArgs = ["--ghc-version"]
+ }
+ waitForSuccess "Failed to run `haddock --ghc-version`" handle
+
putStrLn $ "Files to test: " ++ show cfgFiles
@@ -92,3 +111,37 @@ haddockPath flags = case mlast [ path | FlagHaddockPath path <- flags ] of
mlast :: [a] -> Maybe a
mlast = listToMaybe . reverse
+
+
+data ProcessConfig = ProcessConfig
+ { pcArgs :: [String]
+ , pcWorkDir :: Maybe FilePath
+ , pcEnv :: Maybe [(String, String)]
+ , pcStdIn :: Maybe Handle
+ , pcStdOut :: Maybe Handle
+ , pcStdErr :: Maybe Handle
+ }
+
+
+processConfig :: ProcessConfig
+processConfig = ProcessConfig
+ { pcArgs = []
+ , pcWorkDir = Nothing
+ , pcEnv = Nothing
+ , pcStdIn = Nothing
+ , pcStdOut = Nothing
+ , pcStdErr = Nothing
+ }
+
+
+runProcess' :: FilePath -> ProcessConfig -> IO ProcessHandle
+runProcess' path (ProcessConfig { .. }) = runProcess
+ path pcArgs pcWorkDir pcEnv pcStdIn pcStdOut pcStdErr
+
+
+waitForSuccess :: String -> ProcessHandle -> IO ()
+waitForSuccess msg handle = do
+ result <- waitForProcess handle
+ unless (result == ExitSuccess) $ do
+ hPutStrLn stderr $ msg
+ exitFailure