From 0438f0ac7605fb6b9850acd34cc169f84a3f6088 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
Date: Wed, 13 Feb 2019 11:36:11 -0500
Subject: Clean up logic for guessing `-B` and `--lib` (#1026)

Haddock built with the `in-ghc-tree` flag tries harder to find the GHC
lib folder and its own resources. This should make it possible to use
`in-ghc-tree`-built Haddock without having to specify the `-B` and
`--lib` options (just how you can use in-tree GHC without always
specifying the `-B` option).

The logic to do this relies on `getExecutablePath`, so we only get
this auto-detection on platforms where this function works.
---
 haddock-test/src/Test/Haddock/Config.hs | 24 ++++++++++++++++++------
 1 file changed, 18 insertions(+), 6 deletions(-)

(limited to 'haddock-test/src/Test/Haddock')

diff --git a/haddock-test/src/Test/Haddock/Config.hs b/haddock-test/src/Test/Haddock/Config.hs
index 51394eff..94ca7759 100644
--- a/haddock-test/src/Test/Haddock/Config.hs
+++ b/haddock-test/src/Test/Haddock/Config.hs
@@ -170,6 +170,7 @@ loadConfig :: CheckConfig c -> DirConfig -> [Flag] -> [String] -> IO (Config c)
 loadConfig ccfg dcfg flags files = do
     cfgEnv <- (:) ("haddock_datadir", dcfgResDir dcfg) <$> getEnvironment
 
+    -- Find Haddock executable
     systemHaddockPath <- List.lookup "HADDOCK_PATH" <$> getEnvironment
     haddockOnPath <- findExecutable "haddock"
 
@@ -181,14 +182,25 @@ loadConfig ccfg dcfg flags files = do
     cfgHaddockPath <- case haddock_path of
         Just path -> pure path
         Nothing   -> do
-          hPutStrLn stderr "Haddock executable not found"
+          hPutStrLn stderr "Haddock executable not found; consider using the `--haddock-path` flag."
           exitFailure
 
-    ghcPath <- case flagsGhcPath flags of
-                 Just fp -> return fp
-                 Nothing -> init <$> rawSystemStdout normal
-                                                     cfgHaddockPath
-                                                     ["--print-ghc-path"]
+    -- Perhaps Haddock knows where you can find GHC?
+    queriedGhcPath <- do
+      p <- init <$> rawSystemStdout normal cfgHaddockPath ["--print-ghc-path"]
+      exists <- doesFileExist p
+      pure $ if exists then Just p else Nothing
+
+
+    let ghc_path = msum [ flagsGhcPath flags
+                        , queriedGhcPath
+                        ]
+
+    ghcPath <- case ghc_path of
+        Just path -> pure path
+        Nothing   -> do
+          hPutStrLn stderr "GHC executable not found; consider using the `--ghc-path` flag."
+          exitFailure
 
     printVersions cfgEnv cfgHaddockPath
 
-- 
cgit v1.2.3