diff options
author | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-03 20:34:12 +0200 |
---|---|---|
committer | Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-08-22 23:40:26 +0200 |
commit | a380904e39ea57e3907c0297b41eb546680b0d3a (patch) | |
tree | 33d2f11707c4e21ccd8852da507c06899e4c342c /html-test | |
parent | 1377659f2fc98db024e436ffc4c59b5e8be31c7a (diff) |
Add GHC path to test runner configuration.
Diffstat (limited to 'html-test')
-rwxr-xr-x | html-test/run.hs | 68 |
1 files changed, 40 insertions, 28 deletions
diff --git a/html-test/run.hs b/html-test/run.hs index 91e692a1..61e00781 100755 --- a/html-test/run.hs +++ b/html-test/run.hs @@ -7,6 +7,9 @@ import Control.Monad import Data.Maybe +import Distribution.Simple.Utils +import Distribution.Verbosity + import System.Console.GetOpt import System.Directory import System.Environment @@ -31,33 +34,19 @@ resDir = rootDir </> "resources" data Config = Config { cfgHaddockPath :: FilePath + , cfgGhcPath :: FilePath , cfgFiles :: [FilePath] } main :: IO () main = do - Config { .. } <- parseArgs =<< getArgs + Config { .. } <- loadConfig =<< getArgs + return () - 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 - - -parseArgs :: [String] -> IO Config -parseArgs args = do +loadConfig :: [String] -> IO Config +loadConfig args = do let (flags, files, errors) = getOpt Permute options args when (not $ null errors) $ do @@ -68,11 +57,35 @@ parseArgs args = do hPutStrLn stderr $ usageInfo "" options exitSuccess + env <- Just . (:) ("haddock_datadir", resDir) <$> getEnvironment + + let cfgHaddockPath = flagsHaddockPath flags + + printVersions env cfgHaddockPath + cfgFiles <- processFileArgs files - let cfgHaddockPath = haddockPath flags + cfgGhcPath <- init <$> rawSystemStdout normal cfgHaddockPath + ["--print-ghc-path"] + putStrLn $ "Files to test: " ++ show cfgFiles return $ Config { .. } + +printVersions :: Maybe [(String, String)] -> FilePath -> IO () +printVersions env haddockPath = do + handle <- runProcess' haddockPath $ processConfig + { pcEnv = env + , pcArgs = ["--version"] + } + waitForSuccess "Failed to run `haddock --version`" handle + + handle <- runProcess' haddockPath $ processConfig + { pcEnv = env + , pcArgs = ["--ghc-version"] + } + waitForSuccess "Failed to run `haddock --ghc-version`" handle + + processFileArgs :: [String] -> IO [FilePath] processFileArgs [] = filter isSourceFile <$> getDirectoryContents srcDir processFileArgs args = pure $ map processFileArg args @@ -103,14 +116,13 @@ options = ] -haddockPath :: [Flag] -> FilePath -haddockPath flags = case mlast [ path | FlagHaddockPath path <- flags ] of - Just path -> path - Nothing -> rootDir </> "dist" </> "build" </> "haddock" </> "haddock" - - -mlast :: [a] -> Maybe a -mlast = listToMaybe . reverse +flagsHaddockPath :: [Flag] -> FilePath +flagsHaddockPath flags = + case mlast [ path | FlagHaddockPath path <- flags ] of + Just path -> path + Nothing -> rootDir </> "dist" </> "build" </> "haddock" </> "haddock" + where + mlast = listToMaybe . reverse data ProcessConfig = ProcessConfig |