[commit: ghc] wip/nfs-locking: Merge LookupInPath and Path oracles (b42f4fd)

[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/b42f4fdd21227f799c0f3ed52b2f7bfe0225f4d9/ghc

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

commit b42f4fdd21227f799c0f3ed52b2f7bfe0225f4d9
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sun Oct 30 01:11:22 2016 +0000

    Merge LookupInPath and Path oracles


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

b42f4fdd21227f799c0f3ed52b2f7bfe0225f4d9
 hadrian.cabal               |  1 -
 src/Oracles/LookupInPath.hs | 23 -----------------------
 src/Oracles/Path.hs         | 35 +++++++++++++++++++++++++----------
 src/Rules/Oracles.hs        |  4 +---
 4 files changed, 26 insertions(+), 37 deletions(-)

diff --git a/hadrian.cabal b/hadrian.cabal
index 954b1d6..378aff7 100644
--- a/hadrian.cabal
+++ b/hadrian.cabal
@@ -32,7 +32,6 @@ executable hadrian
                        , Oracles.Config.Setting
                        , Oracles.Dependencies
                        , Oracles.DirectoryContent
-                       , Oracles.LookupInPath
                        , Oracles.ModuleFiles
                        , Oracles.PackageData
                        , Oracles.Path
diff --git a/src/Oracles/LookupInPath.hs b/src/Oracles/LookupInPath.hs
deleted file mode 100644
index 87e8adf..0000000
--- a/src/Oracles/LookupInPath.hs
+++ /dev/null
@@ -1,23 +0,0 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Oracles.LookupInPath (lookupInPath, lookupInPathOracle) where
-
-import System.Directory
-
-import Base
-
-newtype LookupInPath = LookupInPath String
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-
--- | Lookup an executable in @PATH at .
-lookupInPath :: FilePath -> Action FilePath
-lookupInPath name
-    | name == takeFileName name = askOracle $ LookupInPath name
-    | otherwise                 = return name
-
-lookupInPathOracle :: Rules ()
-lookupInPathOracle = void $
-    addOracle $ \(LookupInPath name) -> do
-        let unpack = fromMaybe . error $ "Cannot find executable " ++ quote name
-        path <- unifyPath <$> unpack <$> liftIO (findExecutable name)
-        putLoud $ "Executable found: " ++ name ++ " => " ++ path
-        return path
diff --git a/src/Oracles/Path.hs b/src/Oracles/Path.hs
index 7db1400..1a74915 100644
--- a/src/Oracles/Path.hs
+++ b/src/Oracles/Path.hs
@@ -1,22 +1,18 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Oracles.Path (
-    fixAbsolutePathOnWindows, topDirectory, getTopDirectory, windowsPathOracle,
-    systemBuilderPath
+    topDirectory, getTopDirectory, systemBuilderPath, pathOracle
     ) where
 
 import Control.Monad.Trans.Reader
 import Data.Char
+import System.Directory
 
 import Base
 import Builder
 import Oracles.Config
 import Oracles.Config.Setting
-import Oracles.LookupInPath
 import Stage
 
-newtype WindowsPath = WindowsPath FilePath
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-
 -- | Path to the GHC source tree.
 topDirectory :: Action FilePath
 topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
@@ -59,6 +55,12 @@ systemBuilderPath builder = case builder of
             return "" -- TODO: Use a safe interface.
         else fixAbsolutePathOnWindows =<< lookupInPath path
 
+-- | Lookup an executable in @PATH at .
+lookupInPath :: FilePath -> Action FilePath
+lookupInPath name
+    | name == takeFileName name = askOracle $ LookupInPath name
+    | otherwise                 = return name
+
 -- | Fix an absolute path on Windows:
 -- * "/c/" => "C:/"
 -- * "/usr/bin/tar.exe" => "C:/msys/usr/bin/tar.exe"
@@ -73,11 +75,24 @@ fixAbsolutePathOnWindows path = do
     else
         return path
 
--- | Compute path mapping on Windows. This is slow and requires caching.
-windowsPathOracle :: Rules ()
-windowsPathOracle = void $
-    addOracle $ \(WindowsPath path) -> do
+newtype LookupInPath = LookupInPath String
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+
+newtype WindowsPath = WindowsPath FilePath
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+
+-- | Oracles for looking up paths. These are slow and require caching.
+pathOracle :: Rules ()
+pathOracle = do
+    void $ addOracle $ \(WindowsPath path) -> do
         Stdout out <- quietly $ cmd ["cygpath", "-m", path]
         let windowsPath = unifyPath $ dropWhileEnd isSpace out
         putLoud $ "Windows path mapping: " ++ path ++ " => " ++ windowsPath
         return windowsPath
+
+    void $ addOracle $ \(LookupInPath name) -> do
+        let unpack = fromMaybe . error $ "Cannot find executable " ++ quote name
+        path <- unifyPath <$> unpack <$> liftIO (findExecutable name)
+        putLoud $ "Executable found: " ++ name ++ " => " ++ path
+        return path
+
diff --git a/src/Rules/Oracles.hs b/src/Rules/Oracles.hs
index 39fbd00..6c5ace4 100644
--- a/src/Rules/Oracles.hs
+++ b/src/Rules/Oracles.hs
@@ -5,7 +5,6 @@ import qualified Oracles.ArgsHash
 import qualified Oracles.Config
 import qualified Oracles.Dependencies
 import qualified Oracles.DirectoryContent
-import qualified Oracles.LookupInPath
 import qualified Oracles.ModuleFiles
 import qualified Oracles.PackageData
 import qualified Oracles.Path
@@ -16,7 +15,6 @@ oracleRules = do
     Oracles.Config.configOracle
     Oracles.Dependencies.dependenciesOracles
     Oracles.DirectoryContent.directoryContentOracle
-    Oracles.LookupInPath.lookupInPathOracle
     Oracles.ModuleFiles.moduleFilesOracle
     Oracles.PackageData.packageDataOracle
-    Oracles.Path.windowsPathOracle
+    Oracles.Path.pathOracle