[commit: ghc] wip/nfs-locking: Fix executable lookup. (68cf604)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/68cf6048ac5a08b158282d9284868002ecc28a8e/ghc

>---------------------------------------------------------------

commit 68cf6048ac5a08b158282d9284868002ecc28a8e
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Tue Feb 9 15:59:04 2016 +0000

    Fix executable lookup.


>---------------------------------------------------------------

68cf6048ac5a08b158282d9284868002ecc28a8e
 src/Builder.hs              | 10 +++++-----
 src/Oracles/LookupInPath.hs | 24 ++++++++++--------------
 2 files changed, 15 insertions(+), 19 deletions(-)

diff --git a/src/Builder.hs b/src/Builder.hs
index d1a2cc3..1826875 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -112,11 +112,11 @@ builderPath builder = case builderProvenance builder of
         path <- askConfigWithDefault builderKey . putError $
             "\nCannot find path to '" ++ builderKey
             ++ "' in configuration files. Have you forgot to run configure?"
-        windows <- windowsHost
-        case (path, windows) of
-            ("", _    ) -> return path
-            (p , True ) -> fixAbsolutePathOnWindows (p -<.> exe)
-            (p , False) -> lookupInPath p
+        if path == "" -- TODO: get rid of "" paths
+        then return ""
+        else do
+            path' <- lookupInPath path
+            fixAbsolutePathOnWindows $ path' -<.> exe
 
 getBuilderPath :: Builder -> ReaderT a Action FilePath
 getBuilderPath = lift . builderPath
diff --git a/src/Oracles/LookupInPath.hs b/src/Oracles/LookupInPath.hs
index a9dc995..6bf2bba 100644
--- a/src/Oracles/LookupInPath.hs
+++ b/src/Oracles/LookupInPath.hs
@@ -1,29 +1,25 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 module Oracles.LookupInPath (lookupInPath, lookupInPathOracle) where
 
+import System.Directory
+
 import Base
 
 newtype LookupInPath = LookupInPath String
     deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
 
--- | Fetches the absolute FilePath to a given FilePath using the oracle.
-commandPath :: FilePath -> Action FilePath
-commandPath = askOracle . LookupInPath
-
--- | Lookup a @command@ in @PATH@ environment.
+-- | Lookup an executable in @PATH at .
 lookupInPath :: FilePath -> Action FilePath
-lookupInPath c
-    | c /= takeFileName c = return c
-    | otherwise           = commandPath c
+lookupInPath name
+    | name == takeFileName name = askOracle $ LookupInPath name
+    | otherwise                 = return name
 
 lookupInPathOracle :: Rules ()
 lookupInPathOracle = do
     answer <- newCache $ \query -> do
-        envPaths <- wordsBy (== ':') <$> getEnvWithDefault "" "PATH"
-        let candidates = map (-/- query) envPaths
-        -- this will crash if we do not find any valid candidate.
-        fullCommand <- head <$> filterM doesFileExist candidates
-        putOracle $ "Found '" ++ query ++ "' at " ++ "'" ++ fullCommand ++ "'"
-        return fullCommand
+        maybePath <- liftIO $ findExecutable query
+        let path = fromMaybe query maybePath
+        putOracle $ "Lookup executable '" ++ query ++ "': " ++ path
+        return path
     _ <- addOracle $ \(LookupInPath query) -> answer query
     return ()