[commit: ghc] wip/nfs-locking: Simplify oracles (acf66a3)

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

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

commit acf66a3c7bb4834f2a9b631eb5492dfc92149026
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Tue Aug 8 22:53:25 2017 +0100

    Simplify oracles


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

acf66a3c7bb4834f2a9b631eb5492dfc92149026
 src/Hadrian/Oracles/ArgsHash.hs |  6 +++---
 src/Hadrian/Oracles/Config.hs   |  6 +++---
 src/Oracles/Dependencies.hs     | 18 +++++-------------
 3 files changed, 11 insertions(+), 19 deletions(-)

diff --git a/src/Hadrian/Oracles/ArgsHash.hs b/src/Hadrian/Oracles/ArgsHash.hs
index e07fc3f..8ac2c38 100644
--- a/src/Hadrian/Oracles/ArgsHash.hs
+++ b/src/Hadrian/Oracles/ArgsHash.hs
@@ -35,16 +35,16 @@ trackArgsHash :: (ShakeValue c, ShakeValue b) => Target c b -> Action ()
 trackArgsHash t = do
     let hashedInputs  = [ show $ hash (inputs t) ]
         hashedTarget = target (context t) (builder t) hashedInputs (outputs t)
-    void (askOracle $ ArgsHashKey hashedTarget :: Action Int)
+    void (askOracle $ ArgsHash hashedTarget :: Action Int)
 
-newtype ArgsHashKey c b = ArgsHashKey (Target c b)
+newtype ArgsHash c b = ArgsHash (Target c b)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 -- | This oracle stores per-target argument list hashes in the Shake database,
 -- allowing the user to track them between builds using 'trackArgsHash' queries.
 argsHashOracle :: (ShakeValue c, ShakeValue b) => TrackArgument c b -> Args c b -> Rules ()
 argsHashOracle trackArgument args = void $
-    addOracle $ \(ArgsHashKey target) -> do
+    addOracle $ \(ArgsHash target) -> do
         argList <- interpret target args
         let trackedArgList = filter (trackArgument target) argList
         return $ hash trackedArgList
diff --git a/src/Hadrian/Oracles/Config.hs b/src/Hadrian/Oracles/Config.hs
index 0b12616..1263f1a 100644
--- a/src/Hadrian/Oracles/Config.hs
+++ b/src/Hadrian/Oracles/Config.hs
@@ -10,7 +10,7 @@ import Development.Shake.Config
 
 import Hadrian.Utilities
 
-newtype ConfigKey = ConfigKey String
+newtype Config = Config String
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 -- | Lookup a configuration setting raising an error if the key is not found.
@@ -21,7 +21,7 @@ unsafeAskConfig key = (fromMaybe $ error msg) <$> askConfig key
 
 -- | Lookup a configuration setting.
 askConfig :: String -> Action (Maybe String)
-askConfig = askOracle . ConfigKey
+askConfig = askOracle . Config
 
 -- | This oracle reads and parses a configuration file consisting of key-value
 -- pairs @key = value@ and answers 'askConfig' queries tracking the results.
@@ -31,4 +31,4 @@ configOracle configFile = void $ do
         need [configFile]
         putLoud $ "Reading " ++ configFile ++ "..."
         liftIO $ readConfigFile configFile
-    addOracle $ \(ConfigKey key) -> Map.lookup key <$> cfg ()
+    addOracle $ \(Config key) -> Map.lookup key <$> cfg ()
diff --git a/src/Oracles/Dependencies.hs b/src/Oracles/Dependencies.hs
index 04ebbfd..6ae0b0d 100644
--- a/src/Oracles/Dependencies.hs
+++ b/src/Oracles/Dependencies.hs
@@ -15,7 +15,7 @@ import Settings
 import Settings.Builders.GhcCabal
 import Settings.Path
 
-newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
+newtype Dependency = Dependency (FilePath, FilePath)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 -- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
@@ -26,15 +26,12 @@ newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
 fileDependencies :: Context -> FilePath -> Action (FilePath, [FilePath])
 fileDependencies context obj = do
     let path = buildPath context -/- ".dependencies"
-    deps <- askOracle $ ObjDepsKey (path, obj)
+    deps <- askOracle $ Dependency (path, obj)
     case deps of
         Nothing -> error $ "No dependencies found for file " ++ obj
         Just [] -> error $ "No source file found for file " ++ obj
         Just (source : files) -> return (source, files)
 
-newtype PkgDepsKey = PkgDepsKey String
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-
 -- | Given a 'Context' this 'Action' looks up its package dependencies in
 -- 'Settings.Paths.packageDependencies' using 'packageDependenciesOracle', and
 -- wraps found dependencies in appropriate contexts. The only subtlety here is
@@ -45,7 +42,7 @@ contextDependencies :: Context -> Action [Context]
 contextDependencies context at Context {..} = do
     let pkgContext = \pkg -> Context (min stage Stage1) pkg way
         unpack     = fromMaybe . error $ "No dependencies for " ++ show context
-    deps <- unpack <$> askOracle (PkgDepsKey $ pkgNameString package)
+    deps <- unpack <$> askOracle (Dependency (packageDependencies, pkgNameString package))
     pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
     return . map pkgContext $ intersectOrd (compare . pkgNameString) pkgs deps
 
@@ -74,16 +71,11 @@ needLibrary cs = need =<< concatMapM libraryTargets cs
 -- | Oracles for the package dependencies and 'path/dist/.dependencies' files.
 dependenciesOracles :: Rules ()
 dependenciesOracles = do
-    deps <- newCache readDependencies
-    void $ addOracle $ \(ObjDepsKey (file, obj)) -> Map.lookup obj <$> deps file
-
-    pkgDeps <- newCache $ \_ -> readDependencies packageDependencies
-    void $ addOracle $ \(PkgDepsKey pkg) -> Map.lookup pkg <$> pkgDeps ()
-  where
-    readDependencies file = do
+    deps <- newCache $ \file -> do
         putLoud $ "Reading dependencies from " ++ file ++ "..."
         contents <- map words <$> readFileLines file
         return $ Map.fromList [ (key, values) | (key:values) <- contents ]
+    void $ addOracle $ \(Dependency (file, key)) -> Map.lookup key <$> deps file
 
 -- | Topological sort of packages according to their dependencies.
 -- HACK (izgzhen): See https://github.com/snowleopard/hadrian/issues/344 for details