From 110599220155087d3c02a8a9a2f2d4834c666e47 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Tue, 4 Aug 2015 17:07:58 +0200
Subject: Make Haddock standard output redirection be more configurable.

---
 html-test/run.hs | 14 ++++++++++++--
 1 file changed, 12 insertions(+), 2 deletions(-)

(limited to 'html-test/run.hs')

diff --git a/html-test/run.hs b/html-test/run.hs
index da414171..ace3c6a0 100755
--- a/html-test/run.hs
+++ b/html-test/run.hs
@@ -43,6 +43,7 @@ data Config = Config
     , cfgGhcPath :: FilePath
     , cfgFiles :: [FilePath]
     , cfgHaddockArgs :: [String]
+    , cfgHaddockStdOut :: FilePath
     , cfgEnv :: Environment
     }
 
@@ -79,11 +80,11 @@ runHaddock :: Config -> IO ()
 runHaddock (Config { .. }) = do
     putStrLn "Running Haddock process..."
 
-    devNull <- openFile "/dev/null" WriteMode
+    haddockStdOut <- openFile cfgHaddockStdOut WriteMode
     handle <- runProcess' cfgHaddockPath $ processConfig
         { pcArgs = cfgHaddockArgs ++ cfgFiles
         , pcEnv = Just $ cfgEnv
-        , pcStdOut = Just $ devNull
+        , pcStdOut = Just $ haddockStdOut
         }
     waitForSuccess "Failed to run Haddock on specified test files" handle
 
@@ -127,6 +128,8 @@ loadConfig flags files = do
         , baseDependencies cfgGhcPath
         ]
 
+    let cfgHaddockStdOut = fromMaybe "/dev/null" (flagsHaddockStdOut flags)
+
     return $ Config { .. }
 
 
@@ -205,6 +208,7 @@ data Flag
     = FlagHaddockPath FilePath
     | FlagGhcPath FilePath
     | FlagHaddockOptions String
+    | FlagHaddockStdOut FilePath
     | FlagHelp
     deriving Eq
 
@@ -217,6 +221,8 @@ options =
         "path to GHC executable"
     , Option [] ["haddock-options"] (ReqArg FlagHaddockOptions "OPTS")
         "additional options to run Haddock with"
+    , Option [] ["haddock-stdout"] (ReqArg FlagHaddockStdOut "FILE")
+        "where to redirect Haddock output"
     , Option ['h'] ["help"] (NoArg FlagHelp)
         "display this help end exit"
     ]
@@ -235,6 +241,10 @@ flagsHaddockOptions flags = concat
     [ words opts | FlagHaddockOptions opts <- flags ]
 
 
+flagsHaddockStdOut :: [Flag] -> Maybe FilePath
+flagsHaddockStdOut flags = mlast [ path | FlagHaddockStdOut path <- flags ]
+
+
 type Environment = [(String, String)]
 
 data ProcessConfig = ProcessConfig
-- 
cgit v1.2.3