[commit: ghc] wip/nfs-locking: Extend KeyValue oracle to handle lists of values (1a0a80b)

[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/1a0a80ba27c1ab1a8fcf388c6e286705d860f6ab/ghc

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

commit 1a0a80ba27c1ab1a8fcf388c6e286705d860f6ab
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sun Aug 13 18:26:45 2017 +0100

    Extend KeyValue oracle to handle lists of values


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

1a0a80ba27c1ab1a8fcf388c6e286705d860f6ab
 src/Hadrian/Oracles/KeyValue.hs | 46 +++++++++++++++++++++++++++++++----------
 src/Oracles/Dependencies.hs     | 21 ++++---------------
 src/Rules.hs                    |  1 -
 3 files changed, 39 insertions(+), 29 deletions(-)

diff --git a/src/Hadrian/Oracles/KeyValue.hs b/src/Hadrian/Oracles/KeyValue.hs
index b58cfda..5155e3e 100644
--- a/src/Hadrian/Oracles/KeyValue.hs
+++ b/src/Hadrian/Oracles/KeyValue.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Hadrian.Oracles.KeyValue (
-    lookupValue, lookupValueOrEmpty, lookupValueOrError, keyValueOracle
+    lookupValue, lookupValueOrEmpty, lookupValueOrError,
+    lookupValues, lookupValuesOrEmpty, lookupValuesOrError, keyValueOracle
     ) where
 
 import Control.Monad
@@ -15,28 +16,51 @@ import Hadrian.Utilities
 newtype KeyValue = KeyValue (FilePath, String)
     deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
--- | Lookup a value in a key-value text file, tracking the result.
+newtype KeyValues = KeyValues (FilePath, String)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+
+-- | Lookup a value in a text file, tracking the result. Each line of the file
+-- is expected to have @key = value@ format.
 lookupValue :: FilePath -> String -> Action (Maybe String)
 lookupValue file key = askOracle $ KeyValue (file, key)
 
--- | Lookup a value in a key-value text file, tracking the result. Return the
--- empty string if the key is not found.
+-- | Like 'lookupValue' but returns the empty string if the key is not found.
 lookupValueOrEmpty :: FilePath -> String -> Action String
-lookupValueOrEmpty file key = fromMaybe "" <$> askOracle (KeyValue (file, key))
+lookupValueOrEmpty file key = fromMaybe "" <$> lookupValue file key
 
--- | Lookup a value in a key-value text file, tracking the result. Raise an
--- error if the key is not found.
+-- | Like 'lookupValue' but raises an error if the key is not found.
 lookupValueOrError :: FilePath -> String -> Action String
 lookupValueOrError file key = (fromMaybe $ error msg) <$> lookupValue file key
   where
     msg = "Key " ++ quote key ++ " not found in file " ++ quote file
 
--- | This oracle reads and parses text files consisting of key-value pairs
--- @key = value@ and answers 'lookupValue' queries tracking the results.
+-- | Lookup a list of values in a text file, tracking the result. Each line of
+-- the file is expected to have @key value1 value2 ...@ format.
+lookupValues :: FilePath -> String -> Action (Maybe [String])
+lookupValues file key = askOracle $ KeyValues (file, key)
+
+-- | Like 'lookupValues' but returns the empty list if the key is not found.
+lookupValuesOrEmpty :: FilePath -> String -> Action [String]
+lookupValuesOrEmpty file key = fromMaybe [] <$> lookupValues file key
+
+-- | Like 'lookupValues' but raises an error if the key is not found.
+lookupValuesOrError :: FilePath -> String -> Action [String]
+lookupValuesOrError file key = (fromMaybe $ error msg) <$> lookupValues file key
+  where
+    msg = "Key " ++ quote key ++ " not found in file " ++ quote file
+
+-- | This oracle reads and parses text files to answer 'lookupValue' and
+-- 'lookupValues' queries, as well as their derivatives, tracking the results.
 keyValueOracle :: Rules ()
 keyValueOracle = void $ do
-    cache <- newCache $ \file -> do
+    kv <- newCache $ \file -> do
         need [file]
         putLoud $ "Reading " ++ file ++ "..."
         liftIO $ readConfigFile file
-    addOracle $ \(KeyValue (file, key)) -> Map.lookup key <$> cache file
+    kvs <- newCache $ \file -> do
+        need [file]
+        putLoud $ "Reading " ++ file ++ "..."
+        contents <- map words <$> readFileLines file
+        return $ Map.fromList [ (key, values) | (key:values) <- contents ]
+    void $ addOracle $ \(KeyValue  (file, key)) -> Map.lookup key <$> kv  file
+    void $ addOracle $ \(KeyValues (file, key)) -> Map.lookup key <$> kvs file
diff --git a/src/Oracles/Dependencies.hs b/src/Oracles/Dependencies.hs
index 748a5a2..6ed5633 100644
--- a/src/Oracles/Dependencies.hs
+++ b/src/Oracles/Dependencies.hs
@@ -1,10 +1,10 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-}
 module Oracles.Dependencies (
     fileDependencies, contextDependencies, libraryTargets, needLibrary,
-    dependenciesOracles, pkgDependencies, topsortPackages
+    pkgDependencies, topsortPackages
     ) where
 
-import qualified Data.HashMap.Strict as Map
+import Hadrian.Oracles.KeyValue
 
 import Base
 import Context
@@ -14,9 +14,6 @@ import Settings
 import Settings.Builders.GhcCabal
 import Settings.Path
 
-newtype Dependency = Dependency (FilePath, FilePath)
-    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-
 -- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
 -- in a generated dependency file @path/.dependencies@, where @path@ is the build
 -- path of the given @context at . The action returns a pair @(source, files)@,
@@ -25,7 +22,7 @@ newtype Dependency = Dependency (FilePath, FilePath)
 fileDependencies :: Context -> FilePath -> Action (FilePath, [FilePath])
 fileDependencies context obj = do
     let path = buildPath context -/- ".dependencies"
-    deps <- askOracle $ Dependency (path, obj)
+    deps <- lookupValues path obj
     case deps of
         Nothing -> error $ "No dependencies found for file " ++ obj
         Just [] -> error $ "No source file found for file " ++ obj
@@ -40,8 +37,7 @@ fileDependencies context obj = do
 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 (Dependency (packageDependencies, pkgNameString package))
+    deps <- lookupValuesOrError packageDependencies (pkgNameString package)
     pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
     return . map pkgContext $ intersectOrd (compare . pkgNameString) pkgs deps
 
@@ -67,15 +63,6 @@ libraryTargets context = do
 needLibrary :: [Context] -> Action ()
 needLibrary cs = need =<< concatMapM libraryTargets cs
 
--- | Oracles for the package dependencies and 'path/dist/.dependencies' files.
-dependenciesOracles :: Rules ()
-dependenciesOracles = 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
 topsortPackages :: [Package] -> Action [Package]
diff --git a/src/Rules.hs b/src/Rules.hs
index 335c4c3..2c09e94 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -117,7 +117,6 @@ oracleRules = do
     Hadrian.Oracles.DirectoryContents.directoryContentsOracle
     Hadrian.Oracles.KeyValue.keyValueOracle
     Hadrian.Oracles.Path.pathOracle
-    Oracles.Dependencies.dependenciesOracles
     Oracles.ModuleFiles.moduleFilesOracle
 
 programsStage1Only :: [Package]