diff options
| -rwxr-xr-x | html-test/run.hs | 48 |
1 files changed, 45 insertions, 3 deletions
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 |