Mon Nov 20 20:52:50 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/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
Link       : http://git.haskell.org/haddock.git/commitdiff/076e04cd4c049ddfad6feed242e2c1024d5db101

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

commit 076e04cd4c049ddfad6feed242e2c1024d5db101
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Tue Aug 4 14:41:06 2015 +0200

    Make test runner actually run Haddock executable.


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

076e04cd4c049ddfad6feed242e2c1024d5db101
 html-test/run.hs | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

diff --git a/html-test/run.hs b/html-test/run.hs
index a9fe8bb..62e8bc2 100755
--- a/html-test/run.hs
+++ b/html-test/run.hs
@@ -43,13 +43,13 @@ data Config = Config
     , cfgGhcPath :: FilePath
     , cfgFiles :: [FilePath]
     , cfgHaddockArgs :: [String]
-    } deriving Show
+    , cfgEnv :: Environment
+    }
 
 
 main :: IO ()
 main = do
     cfg <- uncurry loadConfig =<< checkOpt =<< getArgs
-    putStrLn $ show cfg
     runHaddock cfg
     checkOutput cfg
 
@@ -59,7 +59,12 @@ checkOutput _ = return () -- TODO.
 
 
 runHaddock :: Config -> IO ()
-runHaddock _ = return () -- TODO.
+runHaddock (Config { .. }) = do
+    handle <- runProcess' cfgHaddockPath $ processConfig
+        { pcArgs = cfgHaddockArgs
+        , pcEnv = Just $ cfgEnv
+        }
+    waitForSuccess "Failed to run Haddock on specified test files" handle
 
 
 checkOpt :: [String] -> IO ([Flag], [String])
@@ -79,12 +84,12 @@ checkOpt args = do
 
 loadConfig :: [Flag] -> [String] -> IO Config
 loadConfig flags files = do
-    env <- Just . (:) ("haddock_datadir", resDir) <$> getEnvironment
+    cfgEnv <- (:) ("haddock_datadir", resDir) <$> getEnvironment
 
     cfgHaddockPath <- pure $ flip fromMaybe (flagsHaddockPath flags) $
         rootDir </> "dist" </> "build" </> "haddock" </> "haddock"
 
-    printVersions env cfgHaddockPath
+    printVersions cfgEnv cfgHaddockPath
 
     cfgGhcPath <- flip fromMaybe (flagsGhcPath flags) <$>
          init <$> rawSystemStdout normal cfgHaddockPath ["--print-ghc-path"]
@@ -95,7 +100,7 @@ loadConfig flags files = do
         [ pure ["--no-warnings"]
         , pure ["--odir=" ++ outDir]
         , pure ["--pretty-html"]
-        , pure ["--optghc=--w"]
+        , pure ["--optghc=-w"]
         , pure $ flagsHaddockOptions flags
         , baseDependencies cfgGhcPath
         ]
@@ -103,16 +108,16 @@ loadConfig flags files = do
     return $ Config { .. }
 
 
-printVersions :: Maybe [(String, String)] -> FilePath -> IO ()
+printVersions :: Environment -> FilePath -> IO ()
 printVersions env haddockPath = do
     handle <- runProcess' haddockPath $ processConfig
-        { pcEnv = env
+        { pcEnv = Just env
         , pcArgs = ["--version"]
         }
     waitForSuccess "Failed to run `haddock --version`" handle
 
     handle <- runProcess' haddockPath $ processConfig
-        { pcEnv = env
+        { pcEnv = Just env
         , pcArgs = ["--ghc-version"]
         }
     waitForSuccess "Failed to run `haddock --ghc-version`" handle
@@ -185,10 +190,12 @@ flagsHaddockOptions flags = concat
     [ words opts | FlagHaddockOptions opts <- flags ]
 
 
+type Environment = [(String, String)]
+
 data ProcessConfig = ProcessConfig
     { pcArgs :: [String]
     , pcWorkDir :: Maybe FilePath
-    , pcEnv :: Maybe [(String, String)]
+    , pcEnv :: Maybe Environment
     , pcStdIn :: Maybe Handle
     , pcStdOut :: Maybe Handle
     , pcStdErr :: Maybe Handle

