[commit: ghc] wip/nfs-locking: Add DependencyList oracle. (a644c32)

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

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

commit a644c3216b42e6a371f61b2e142df74cf457f51c
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sat Jan 17 23:13:04 2015 +0000

    Add DependencyList oracle.


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

a644c3216b42e6a371f61b2e142df74cf457f51c
 src/Oracles.hs                | 47 +++++++++++++++++++++++++++++++------------
 src/Oracles/DependencyList.hs | 20 ++++++++++++++++++
 2 files changed, 54 insertions(+), 13 deletions(-)

diff --git a/src/Oracles.hs b/src/Oracles.hs
index 9ac6191..4c6d9e9 100644
--- a/src/Oracles.hs
+++ b/src/Oracles.hs
@@ -4,11 +4,14 @@ module Oracles (
     module Oracles.Option,
     module Oracles.Builder,
     module Oracles.PackageData,
+    module Oracles.DependencyList,
     oracleRules
     ) where
 
 import Development.Shake.Config
+import Development.Shake.Util
 import qualified Data.HashMap.Strict as M
+import Data.Bifunctor
 import Base
 import Util
 import Config
@@ -17,49 +20,67 @@ import Oracles.Flag
 import Oracles.Option
 import Oracles.Builder
 import Oracles.PackageData
+import Oracles.DependencyList
 
 defaultConfig, userConfig :: FilePath
 defaultConfig = cfgPath </> "default.config"
 userConfig    = cfgPath </> "user.config"
 
--- Oracle for configuration files.
+-- Oracle for configuration files
 configOracle :: Rules ()
 configOracle = do
     cfg <- newCache $ \() -> do
-        unless (doesFileExist $ defaultConfig <.> "in") $ do
-            error $ "\nDefault configuration file '"
-                ++ (defaultConfig <.> "in")
-                ++ "' is missing; unwilling to proceed."
-            return ()
+        unless (doesFileExist $ defaultConfig <.> "in") $
+            redError_ $ "\nDefault configuration file '"
+                      ++ (defaultConfig <.> "in")
+                      ++ "' is missing; unwilling to proceed."
         need [defaultConfig]
-        putNormal $ "Parsing " ++ toStandard defaultConfig ++ "..."
+        putOracle $ "Parsing " ++ toStandard defaultConfig ++ "..."
         cfgDefault <- liftIO $ readConfigFile defaultConfig
         existsUser <- doesFileExist userConfig
         cfgUser    <- if existsUser
                       then do
-                          putNormal $ "Parsing "
+                          putOracle $ "Parsing "
                                     ++ toStandard userConfig ++ "..."
                           liftIO $ readConfigFile userConfig
                       else do
-                          putColoured Dull Red $
+                          putColoured Red $
                               "\nUser defined configuration file '"
                               ++ userConfig ++ "' is missing; "
                               ++ "proceeding with default configuration.\n"
                           return M.empty
-        putColoured Vivid Green $ "Finished processing configuration files."
+        putColoured Green $ "Finished processing configuration files."
         return $ cfgUser `M.union` cfgDefault
     addOracle $ \(ConfigKey key) -> M.lookup key <$> cfg ()
     return ()
 
--- Oracle for 'package-data.mk' files.
+-- Oracle for 'package-data.mk' files
 packageDataOracle :: Rules ()
 packageDataOracle = do
     pkgData <- newCache $ \file -> do
         need [file]
-        putNormal $ "Parsing " ++ toStandard file ++ "..."
+        putOracle $ "Parsing " ++ toStandard file ++ "..."
         liftIO $ readConfigFile file
     addOracle $ \(PackageDataKey (file, key)) -> M.lookup key <$> pkgData file
     return ()
 
+-- Oracle for 'path/dist/*.deps' files
+dependencyOracle :: Rules ()
+dependencyOracle = do
+    deps <- newCache $ \depFile -> do
+        need [depFile]
+        putOracle $ "Parsing " ++ toStandard depFile ++ "..."
+        contents <- parseMakefile <$> (liftIO $ readFile depFile)
+        return $ M.fromList
+               $ map (bimap head concat . unzip)
+               $ groupBy ((==) `on` fst)
+               $ sortBy (compare `on` fst) contents
+    addOracle $ \(DependencyListKey (file, obj)) -> M.lookup obj <$> deps file
+    return ()
+
 oracleRules :: Rules ()
-oracleRules = configOracle <> packageDataOracle
+oracleRules = configOracle <> packageDataOracle <> dependencyOracle
+
+-- Make oracle's output more distinguishable
+putOracle :: String -> Action ()
+putOracle = putColoured Blue
diff --git a/src/Oracles/DependencyList.hs b/src/Oracles/DependencyList.hs
new file mode 100644
index 0000000..8f4eda1
--- /dev/null
+++ b/src/Oracles/DependencyList.hs
@@ -0,0 +1,20 @@
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+
+module Oracles.DependencyList (
+    DependencyList (..),
+    DependencyListKey (..)
+    ) where
+
+import Development.Shake.Classes
+import Base
+import Data.Maybe
+
+data DependencyList = DependencyList FilePath FilePath
+
+newtype DependencyListKey = DependencyListKey (FilePath, FilePath)
+                        deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
+instance ShowArgs DependencyList where
+    showArgs (DependencyList file obj) = do
+        res <- askOracle $ DependencyListKey (file, obj)
+        return $ fromMaybe [] res