Tue Nov 28 11:37:10 UTC 2017

Repository : ssh://git@git.haskell.org/haddock

On branches: 2.17.3.1-spanfix,alexbiehl-patch-1,ghc-8.0,ghc-8.0-facebook,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,issue-303,issue-475,master,pr-filter-maps,pr/cabal-desc,travis,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11080-open-data-kinds,wip/T11430,wip/T12105,wip/T12105-2,wip/T12942,wip/T13163,wip/T14529,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/da76b1b4ea86ad8b27f722ad803be40b512c9e00

>---------------------------------------------------------------

commit da76b1b4ea86ad8b27f722ad803be40b512c9e00
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Tue Aug 4 14:09:20 2015 +0200

    Extend test runner configuration with Haddock arguments.


>---------------------------------------------------------------

da76b1b4ea86ad8b27f722ad803be40b512c9e00
 html-test/run.hs | 48 +++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 45 insertions(+), 3 deletions(-)

diff --git a/html-test/run.hs b/html-test/run.hs
index 829b570..3a421be 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

