[commit: ghc] wip/nfs-locking: Adds Oracle (aff54c8)

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

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

commit aff54c850f52d875105564d9ef2ec5662cc6c5b2
Author: Moritz Angermann <moritz.angermann at gmail.com>
Date:   Thu Jan 7 18:47:46 2016 +0800

    Adds Oracle


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

aff54c850f52d875105564d9ef2ec5662cc6c5b2
 shaking-up-ghc.cabal           |  2 +-
 src/Oracles.hs                 |  2 ++
 src/Oracles/AbsoluteCommand.hs | 40 ++++++++++++++++++++++++++++++++++++++++
 src/Oracles/WindowsRoot.hs     | 13 +------------
 src/Rules/Oracles.hs           | 15 ++++++++-------
 5 files changed, 52 insertions(+), 20 deletions(-)

diff --git a/shaking-up-ghc.cabal b/shaking-up-ghc.cabal
index f9990e9..96efe57 100644
--- a/shaking-up-ghc.cabal
+++ b/shaking-up-ghc.cabal
@@ -22,6 +22,7 @@ executable ghc-shake
                        , Expression
                        , GHC
                        , Oracles
+                       , Oracles.AbsoluteCommand
                        , Oracles.ArgsHash
                        , Oracles.Config
                        , Oracles.Config.Flag
@@ -114,7 +115,6 @@ executable ghc-shake
                        , extra >= 1.4
                        , mtl >= 2.2
                        , shake >= 0.15
-                       , split >= 0.2
                        , transformers >= 0.4
                        , unordered-containers >= 0.2
     default-language:    Haskell2010
diff --git a/src/Oracles.hs b/src/Oracles.hs
index b77a786..07e92f2 100644
--- a/src/Oracles.hs
+++ b/src/Oracles.hs
@@ -1,4 +1,5 @@
 module Oracles (
+    module Oracles.AbsoluteCommand,
     module Oracles.Config,
     module Oracles.Config.Flag,
     module Oracles.Config.Setting,
@@ -8,6 +9,7 @@ module Oracles (
     module Oracles.WindowsRoot
     ) where
 
+import Oracles.AbsoluteCommand
 import Oracles.Config
 import Oracles.Config.Flag
 import Oracles.Config.Setting
diff --git a/src/Oracles/AbsoluteCommand.hs b/src/Oracles/AbsoluteCommand.hs
new file mode 100644
index 0000000..23de6ff
--- /dev/null
+++ b/src/Oracles/AbsoluteCommand.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+module Oracles.AbsoluteCommand (
+    lookupInPath, absoluteCommandOracle
+    ) where
+
+import Base
+
+newtype AbsoluteCommand = AbsoluteCommand String
+    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
+absoluteCommand :: String -> Action String
+absoluteCommand = askOracle . AbsoluteCommand
+
+-- | Lookup a @command@ in @PATH@ environment.
+lookupInPath :: FilePath -> Action FilePath
+lookupInPath c
+    | c /= takeFileName c = return c
+    | otherwise           = absoluteCommand c
+
+-- | Split function. Splits a string @s@ into chunks
+-- when the predicate @p@ holds. See: http://stackoverflow.com/a/4981265
+wordsWhen :: (Char -> Bool) -> String -> [String]
+wordsWhen p s =
+    case dropWhile p s of
+        "" -> []
+        s' -> w : wordsWhen p s''
+            where (w, s'') = break p s'
+
+
+absoluteCommandOracle :: Rules ()
+absoluteCommandOracle = do
+    o <- newCache $ \c -> do
+        envPaths <- wordsWhen (== ':') <$> getEnvWithDefault "" "PATH"
+        let candidates = map (-/- c) envPaths
+        -- this will crash if we do not find any valid candidate.
+        fullCommand <- head <$> filterM doesFileExist candidates
+        putOracle $ "Found '" ++ c ++ "' at " ++ "'" ++ fullCommand ++ "'"
+        return fullCommand
+    _ <- addOracle $ \(AbsoluteCommand c) -> o c
+    return ()
diff --git a/src/Oracles/WindowsRoot.hs b/src/Oracles/WindowsRoot.hs
index 4186700..413f289 100644
--- a/src/Oracles/WindowsRoot.hs
+++ b/src/Oracles/WindowsRoot.hs
@@ -1,10 +1,9 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 module Oracles.WindowsRoot (
-    windowsRoot, fixAbsolutePathOnWindows, lookupInPath, topDirectory, windowsRootOracle
+    windowsRoot, fixAbsolutePathOnWindows, topDirectory, windowsRootOracle
     ) where
 
 import Data.Char (isSpace)
-import Data.List.Split (splitOn)
 import Base
 import Oracles.Config.Setting
 
@@ -39,16 +38,6 @@ fixAbsolutePathOnWindows path = do
     else
         return path
 
--- | Lookup a @command@ in @PATH@ environment.
-lookupInPath :: FilePath -> Action FilePath
-lookupInPath c
-    | c /= takeFileName c = return c
-    | otherwise = do
-        envPaths <- splitOn ":" <$> getEnvWithDefault "" "PATH"
-        let candidates = map (-/- c) envPaths
-        -- this will crash if we do not find any valid candidate.
-        head <$> filterM doesFileExist candidates
-
 -- Oracle for windowsRoot. This operation requires caching as looking up
 -- the root is slow (at least the current implementation).
 windowsRootOracle :: Rules ()
diff --git a/src/Rules/Oracles.hs b/src/Rules/Oracles.hs
index 92e8a40..a4d6c70 100644
--- a/src/Rules/Oracles.hs
+++ b/src/Rules/Oracles.hs
@@ -7,10 +7,11 @@ import Oracles.ModuleFiles
 
 oracleRules :: Rules ()
 oracleRules = do
-    argsHashOracle     -- see Oracles.ArgsHash
-    configOracle       -- see Oracles.Config
-    dependenciesOracle -- see Oracles.Dependencies
-    moduleFilesOracle  -- see Oracles.ModuleFiles
-    packageDataOracle  -- see Oracles.PackageData
-    packageDepsOracle  -- see Oracles.PackageDeps
-    windowsRootOracle  -- see Oracles.WindowsRoot
+    absoluteCommandOracle -- see Oracles.WindowsRoot
+    argsHashOracle        -- see Oracles.ArgsHash
+    configOracle          -- see Oracles.Config
+    dependenciesOracle    -- see Oracles.Dependencies
+    moduleFilesOracle     -- see Oracles.ModuleFiles
+    packageDataOracle     -- see Oracles.PackageData
+    packageDepsOracle     -- see Oracles.PackageDeps
+    windowsRootOracle     -- see Oracles.WindowsRoot