From 2ee67f47a4980d2e9074c50c52e02dd1f24ed803 Mon Sep 17 00:00:00 2001
From: Cheng Shao <terrorjack@type.dance>
Date: Wed, 29 May 2024 18:13:02 +0200
Subject: [PATCH] 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 1e5752f64a522c4025365856d92f78073a7b3bba)
(cherry picked from commit 78150bfc750a1e798a283c3985aac2a64f88168e)
(cherry picked from commit 10a74dcd23a29ebd993501ab5ad7fbccebf9b821)
---
hadrian/src/Hadrian/Utilities.hs | 5 +++++
hadrian/src/Rules/Docspec.hs | 2 --
hadrian/src/Rules/Lint.hs | 1 -
hadrian/src/Settings/Builders/RunTest.hs | 1 -
4 files changed, 5 insertions(+), 4 deletions(-)
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 40b7835e559..c454fde3b4f 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -19,6 +19,7 @@ module Hadrian.Utilities (
copyFile, copyFileUntracked, createFileLink, fixFile,
makeExecutable, moveFile, removeFile, createDirectory, copyDirectory,
moveDirectory, removeDirectory, removeFile_, writeFileChangedBS,
+ findExecutable,
-- * Diagnostic info
Colour (..), ANSIColour (..), putColoured, shouldUseColor,
@@ -654,3 +655,7 @@ renderUnicorn ls =
ponyPadding = " "
boxLines :: [String]
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
diff --git a/hadrian/src/Rules/Docspec.hs b/hadrian/src/Rules/Docspec.hs
index 30f6a039eb7..8b07ffe80ca 100644
--- a/hadrian/src/Rules/Docspec.hs
+++ b/hadrian/src/Rules/Docspec.hs
@@ -2,8 +2,6 @@ module Rules.Docspec
( docspecRules
) where
-import System.Directory (findExecutable)
-
import Base
import Context.Path
import Settings.Builders.Common
diff --git a/hadrian/src/Rules/Lint.hs b/hadrian/src/Rules/Lint.hs
index fa279fa836f..d9d70f90153 100644
--- a/hadrian/src/Rules/Lint.hs
+++ b/hadrian/src/Rules/Lint.hs
@@ -4,7 +4,6 @@ module Rules.Lint
import Base
import Settings.Builders.Common
-import System.Directory (findExecutable)
import System.Exit (exitFailure)
lintRules :: Rules ()
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 95b7ea86b65..a0de7bcb668 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -16,7 +16,6 @@ import Settings.Builders.Common
import qualified Data.Set as Set
import Flavour
import qualified Context.Type as C
-import System.Directory (findExecutable)
import Settings.Program
import qualified Context.Type
--
GitLab