From 0438f0ac7605fb6b9850acd34cc169f84a3f6088 Mon Sep 17 00:00:00 2001 From: Alec Theriault 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.hs | 1 + haddock-test/src/Test/Haddock/Config.hs | 24 ++++++++++++++++++------ 2 files changed, 19 insertions(+), 6 deletions(-) (limited to 'haddock-test/src') diff --git a/haddock-test/src/Test/Haddock.hs b/haddock-test/src/Test/Haddock.hs index 25c64cfe..1019e815 100644 --- a/haddock-test/src/Test/Haddock.hs +++ b/haddock-test/src/Test/Haddock.hs @@ -42,6 +42,7 @@ checkFiles :: Config c -> Bool -> IO () checkFiles cfg@(Config { .. }) somethingCrashed = do putStrLn "Testing output files..." + createDirectoryIfMissing True (cfgOutDir cfg) files <- ignore <$> getDirectoryTree (cfgOutDir cfg) failed <- liftM catMaybes . forM files $ \file -> do putStr $ "Checking \"" ++ file ++ "\"... " 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