From da76b1b4ea86ad8b27f722ad803be40b512c9e00 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 4 Aug 2015 14:09:20 +0200
Subject: Extend test runner configuration with Haddock arguments.
---
html-test/run.hs | 48 +++++++++++++++++++++++++++++++++++++++++++++---
1 file changed, 45 insertions(+), 3 deletions(-)
(limited to 'html-test')
diff --git a/html-test/run.hs b/html-test/run.hs
index 829b5704..3a421be7 100755
--- a/html-test/run.hs
+++ b/html-test/run.hs
@@ -7,6 +7,12 @@ import Control.Monad
import Data.Maybe
+import Distribution.InstalledPackageInfo
+import Distribution.Package
+import Distribution.Simple.Compiler hiding (Flag)
+import Distribution.Simple.GHC
+import Distribution.Simple.PackageIndex
+import Distribution.Simple.Program
import Distribution.Simple.Utils
import Distribution.Verbosity
@@ -36,13 +42,14 @@ data Config = Config
{ cfgHaddockPath :: FilePath
, cfgGhcPath :: FilePath
, cfgFiles :: [FilePath]
- }
+ , cfgHaddockArgs :: [String]
+ } deriving Show
main :: IO ()
main = do
- Config { .. } <- loadConfig =<< getArgs
- return ()
+ cfg <- loadConfig =<< getArgs
+ putStrLn $ show cfg
loadConfig :: [String] -> IO Config
@@ -69,6 +76,15 @@ loadConfig args = do
cfgFiles <- processFileArgs files
+ cfgHaddockArgs <- liftM concat . sequence $
+ [ pure ["--no-warnings"]
+ , pure ["--odir=" ++ outDir]
+ , pure ["--pretty-html"]
+ , pure ["--optghc=--w"]
+ , pure $ flagsHaddockOptions flags
+ , baseDependencies cfgGhcPath
+ ]
+
return $ Config { .. }
@@ -87,6 +103,24 @@ printVersions env haddockPath = do
waitForSuccess "Failed to run `haddock --ghc-version`" handle
+baseDependencies :: FilePath -> IO [String]
+baseDependencies ghcPath = do
+ (_, _, cfg) <- configure normal (Just ghcPath) Nothing
+ defaultProgramConfiguration
+ pkgIndex <- getInstalledPackages normal [GlobalPackageDB] cfg
+ mapM (getDependency pkgIndex) ["base", "process", "ghc-prim"]
+ where
+ getDependency pkgIndex name = case ifaces pkgIndex name of
+ [] -> do
+ hPutStrLn stderr $ "Couldn't find base test dependency: " ++ name
+ exitFailure
+ (ifArg:_) -> pure ifArg
+ ifaces pkgIndex name = do
+ pkg <- join $ snd <$> lookupPackageName pkgIndex (PackageName name)
+ iface <$> haddockInterfaces pkg <*> haddockHTMLs pkg
+ iface file html = "--read-interface=" ++ html ++ "," ++ file
+
+
processFileArgs :: [String] -> IO [FilePath]
processFileArgs [] = filter isSourceFile <$> getDirectoryContents srcDir
processFileArgs args = pure $ map processFileArg args
@@ -105,6 +139,7 @@ isSourceFile path = takeExtension path `elem` [".hs", ".lhs"]
data Flag
= FlagHaddockPath FilePath
| FlagGhcPath FilePath
+ | FlagHaddockOptions String
| FlagHelp
deriving Eq
@@ -115,6 +150,8 @@ options =
"path to Haddock executable to exectue tests with"
, Option [] ["ghc-path"] (ReqArg FlagGhcPath "FILE")
"path to GHC executable"
+ , Option [] ["haddock-options"] (ReqArg FlagHaddockOptions "OPTS")
+ "additional options to run Haddock with"
, Option ['h'] ["help"] (NoArg FlagHelp)
"display this help end exit"
]
@@ -128,6 +165,11 @@ flagsGhcPath :: [Flag] -> Maybe FilePath
flagsGhcPath flags = mlast [ path | FlagGhcPath path <- flags ]
+flagsHaddockOptions :: [Flag] -> [String]
+flagsHaddockOptions flags = concat
+ [ words opts | FlagHaddockOptions opts <- flags ]
+
+
data ProcessConfig = ProcessConfig
{ pcArgs :: [String]
, pcWorkDir :: Maybe FilePath
--
cgit v1.2.3