Skip to content
Snippets Groups Projects
Commit 6bee4d8a authored by Cheng Shao's avatar Cheng Shao :beach:
Browse files

hadrian: handle findExecutable "" gracefully

hadrian may invoke findExecutable "" at run-time due to a certain
program is not found by configure script. Which is fine and
findExecutable is supposed to return Nothing in this case. However, on
Windows there's a directory bug that throws an exception (see
https://github.com/haskell/directory/issues/180), so we might as well
use a wrapper for findExecutable and handle exceptions gracefully.

(cherry picked from commit 1e5752f6)
(cherry picked from commit 78150bfc)
parent 223df0a0
No related branches found
No related tags found
No related merge requests found
...@@ -19,6 +19,7 @@ module Hadrian.Utilities ( ...@@ -19,6 +19,7 @@ module Hadrian.Utilities (
copyFile, copyFileUntracked, createFileLink, fixFile, copyFile, copyFileUntracked, createFileLink, fixFile,
makeExecutable, moveFile, removeFile, createDirectory, copyDirectory, makeExecutable, moveFile, removeFile, createDirectory, copyDirectory,
moveDirectory, removeDirectory, removeFile_, writeFileChangedBS, moveDirectory, removeDirectory, removeFile_, writeFileChangedBS,
findExecutable,
-- * Diagnostic info -- * Diagnostic info
Colour (..), ANSIColour (..), putColoured, shouldUseColor, Colour (..), ANSIColour (..), putColoured, shouldUseColor,
...@@ -668,3 +669,7 @@ renderUnicorn ls = ...@@ -668,3 +669,7 @@ renderUnicorn ls =
ponyPadding = " " ponyPadding = " "
boxLines :: [String] boxLines :: [String]
boxLines = ["", "", ""] ++ (lines . renderBox $ ls) boxLines = ["", "", ""] ++ (lines . renderBox $ ls)
-- Workaround for https://github.com/haskell/directory/issues/180
findExecutable :: String -> IO (Maybe FilePath)
findExecutable exe = IO.catch (IO.findExecutable exe) $ \(_ :: IO.IOException) -> pure Nothing
...@@ -2,8 +2,6 @@ module Rules.Docspec ...@@ -2,8 +2,6 @@ module Rules.Docspec
( docspecRules ( docspecRules
) where ) where
import System.Directory (findExecutable)
import Base import Base
import Context.Path import Context.Path
import Settings.Builders.Common import Settings.Builders.Common
......
...@@ -4,7 +4,6 @@ module Rules.Lint ...@@ -4,7 +4,6 @@ module Rules.Lint
import Base import Base
import Settings.Builders.Common import Settings.Builders.Common
import System.Directory (findExecutable)
import System.Exit (exitFailure) import System.Exit (exitFailure)
lintRules :: Rules () lintRules :: Rules ()
......
...@@ -16,7 +16,6 @@ import Settings.Builders.Common ...@@ -16,7 +16,6 @@ import Settings.Builders.Common
import qualified Data.Set as Set import qualified Data.Set as Set
import Flavour import Flavour
import qualified Context.Type as C import qualified Context.Type as C
import System.Directory (findExecutable)
import Settings.Program import Settings.Program
import qualified Context.Type import qualified Context.Type
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment