[commit: ghc] wip/nfs-locking: Add support for parsing package-data.mk files. (a253255)
git at git.haskell.org
git at git.haskell.org
Thu Oct 26 23:45:32 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/a253255970c94138f8c67ed298117d6adac0eef2/ghc
>---------------------------------------------------------------
commit a253255970c94138f8c67ed298117d6adac0eef2
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Tue Dec 30 03:56:28 2014 +0000
Add support for parsing package-data.mk files.
>---------------------------------------------------------------
a253255970c94138f8c67ed298117d6adac0eef2
src/Oracles.hs | 39 +++++++++++++++++++++++++++++++++++++--
1 file changed, 37 insertions(+), 2 deletions(-)
diff --git a/src/Oracles.hs b/src/Oracles.hs
index 9ceb121..6a03a6d 100644
--- a/src/Oracles.hs
+++ b/src/Oracles.hs
@@ -9,6 +9,7 @@ module Oracles (
path, with, run, argPath,
option, argOption,
Condition, test, when, unless, not, (&&), (||),
+ packagaDataOption, PackageDataKey (..),
oracleRules
) where
@@ -240,9 +241,10 @@ instance ToCondition a => AndOr Flag a where
newtype ConfigKey = ConfigKey String deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
askConfigWithDefault :: String -> Action String -> Action String
askConfigWithDefault key defaultAction = do
- maybeValue <- askOracle $ ConfigKey $ key
+ maybeValue <- askOracle $ ConfigKey key
case maybeValue of
Just value -> return value
Nothing -> do
@@ -254,6 +256,32 @@ askConfig key = askConfigWithDefault key $ error $ "\nCannot find key '"
++ key
++ "' in configuration files."
+newtype PackageDataPair = PackageDataPair (FilePath, String)
+ deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
+packagaDataOptionWithDefault :: FilePath -> String -> Action String -> Action String
+packagaDataOptionWithDefault file key defaultAction = do
+ maybeValue <- askOracle $ PackageDataPair (file, key)
+ case maybeValue of
+ Just value -> return value
+ Nothing -> do
+ result <- defaultAction
+ return result
+
+data PackageDataKey = Modules | SrcDirs
+
+packagaDataOption :: FilePath -> PackageDataKey -> Action String
+packagaDataOption file key = do
+ let keyName = replaceChar '/' '_' $ takeDirectory file ++ case key of
+ Modules -> "_MODULES"
+ SrcDirs -> "_HS_SRC_DIRS"
+ packagaDataOptionWithDefault file keyName $ error $ "\nCannot find key '"
+ ++ keyName
+ ++ "' in "
+ ++ file
+ ++ "."
+
+
oracleRules :: Rules ()
oracleRules = do
cfg <- newCache $ \() -> do
@@ -273,5 +301,12 @@ oracleRules = do
++ "' is missing; proceeding with default configuration.\n"
return M.empty
return $ cfgUser `M.union` cfgDefault
- addOracle $ \(ConfigKey x) -> M.lookup x <$> cfg ()
+
+ addOracle $ \(ConfigKey key) -> M.lookup key <$> cfg ()
+
+ pkgData <- newCache $ \file -> do
+ need [file]
+ liftIO $ readConfigFile file
+
+ addOracle $ \(PackageDataPair (file, key)) -> M.lookup key <$> pkgData file
return ()
More information about the ghc-commits
mailing list