[commit: ghc] wip/nfs-locking: Drop DepKeys, add DepId, clean up code. (49574e6)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:36:03 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/49574e62cd65023a3d4c6c145bbac86c16c73d69/ghc

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

commit 49574e62cd65023a3d4c6c145bbac86c16c73d69
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Fri Aug 21 16:29:01 2015 +0100

    Drop DepKeys, add DepId, clean up code.


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

49574e62cd65023a3d4c6c145bbac86c16c73d69
 src/Oracles/PackageData.hs | 74 +++++++++++++++++++---------------------------
 1 file changed, 31 insertions(+), 43 deletions(-)

diff --git a/src/Oracles/PackageData.hs b/src/Oracles/PackageData.hs
index 4097ac1..c873601 100644
--- a/src/Oracles/PackageData.hs
+++ b/src/Oracles/PackageData.hs
@@ -8,7 +8,6 @@ module Oracles.PackageData (
 import Base
 import Util
 import Data.List
-import Data.Maybe
 import Control.Applicative
 import qualified Data.HashMap.Strict as Map
 
@@ -22,6 +21,7 @@ import qualified Data.HashMap.Strict as Map
 -- pkgListData Modules therefore returns ["Data.Array", "Data.Array.Base", ...]
 data PackageData = Version      FilePath
                  | PackageKey   FilePath
+                 | LibName      FilePath
                  | Synopsis     FilePath
                  | BuildGhciLib FilePath
 
@@ -30,7 +30,7 @@ data PackageDataList = Modules        FilePath
                      | SrcDirs        FilePath
                      | IncludeDirs    FilePath
                      | Deps           FilePath
-                     | DepKeys        FilePath
+                     | DepIds         FilePath
                      | DepNames       FilePath
                      | CppArgs        FilePath
                      | HsArgs         FilePath
@@ -41,59 +41,47 @@ data PackageDataList = Modules        FilePath
 newtype PackageDataKey = PackageDataKey (FilePath, String)
     deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
 
--- TODO: is this needed?
 askPackageData :: FilePath -> String -> Action String
 askPackageData path key = do
     let fullKey = replaceSeparators '_' $ path ++ "_" ++ key
-        pkgData = path -/- "package-data.mk"
-    value <- askOracle $ PackageDataKey (pkgData, fullKey)
-    return $ fromMaybe
-        (error $ "No key '" ++ key ++ "' in " ++ pkgData ++ ".") value
+        file    = path -/- "package-data.mk"
+    maybeValue <- askOracle $ PackageDataKey (file, fullKey)
+    case maybeValue of
+        Nothing    -> putError $ "No key '" ++ key ++ "' in " ++ file ++ "."
+        Just value -> return value
 
 pkgData :: PackageData -> Action String
-pkgData packageData = do
-    let (key, path) = case packageData of
-           Version      path -> ("VERSION"       , path)
-           PackageKey   path -> ("PACKAGE_KEY"   , path)
-           Synopsis     path -> ("SYNOPSIS"      , path)
-           BuildGhciLib path -> ("BUILD_GHCI_LIB", path)
-        fullKey = replaceSeparators '_' $ path ++ "_" ++ key
-        pkgData = path -/- "package-data.mk"
-    res <- askOracle $ PackageDataKey (pkgData, fullKey)
-    return $ fromMaybe
-        (error $ "No key '" ++ key ++ "' in " ++ pkgData ++ ".") res
+pkgData packageData = case packageData of
+    Version      path -> askPackageData path "VERSION"
+    PackageKey   path -> askPackageData path "PACKAGE_KEY"
+    LibName      path -> askPackageData path "LIB_NAME"
+    Synopsis     path -> askPackageData path "SYNOPSIS"
+    BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB"
 
 pkgDataList :: PackageDataList -> Action [String]
-pkgDataList packageData = do
-    let (key, path, defaultValue) = case packageData of
-           Modules        path -> ("MODULES"                       , path, "" )
-           HiddenModules  path -> ("HIDDEN_MODULES"                , path, "" )
-           SrcDirs        path -> ("HS_SRC_DIRS"                   , path, ".")
-           IncludeDirs    path -> ("INCLUDE_DIRS"                  , path, ".")
-           Deps           path -> ("DEPS"                          , path, "" )
-           DepKeys        path -> ("DEP_KEYS"                      , path, "" )
-           DepNames       path -> ("DEP_NAMES"                     , path, "" )
-           CppArgs        path -> ("CPP_OPTS"                      , path, "" )
-           HsArgs         path -> ("HC_OPTS"                       , path, "" )
-           CcArgs         path -> ("CC_OPTS"                       , path, "" )
-           CSrcs          path -> ("C_SRCS"                        , path, "" )
-           DepIncludeDirs path -> ("DEP_INCLUDE_DIRS_SINGLE_QUOTED", path, "" )
-        fullKey = replaceSeparators '_' $ path ++ "_" ++ key
-        pkgData = path -/- "package-data.mk"
-        unquote = dropWhile (== '\'') . dropWhileEnd (== '\'')
-    res <- askOracle $ PackageDataKey (pkgData, fullKey)
-    return $ map unquote $ words $ case res of
-        Nothing    -> error $ "No key '" ++ key ++ "' in " ++ pkgData ++ "."
-        Just ""    -> defaultValue
-        Just value -> value
+pkgDataList packageData = fmap (map unquote . words) $ case packageData of
+    Modules        path -> askPackageData path "MODULES"
+    HiddenModules  path -> askPackageData path "HIDDEN_MODULES"
+    SrcDirs        path -> askPackageData path "HS_SRC_DIRS"
+    IncludeDirs    path -> askPackageData path "INCLUDE_DIRS"
+    Deps           path -> askPackageData path "DEPS"
+    DepIds         path -> askPackageData path "DEP_IPIDS"
+    DepNames       path -> askPackageData path "DEP_NAMES"
+    CppArgs        path -> askPackageData path "CPP_OPTS"
+    HsArgs         path -> askPackageData path "HC_OPTS"
+    CcArgs         path -> askPackageData path "CC_OPTS"
+    CSrcs          path -> askPackageData path "C_SRCS"
+    DepIncludeDirs path -> askPackageData path "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
+  where
+    unquote = dropWhile (== '\'') . dropWhileEnd (== '\'')
 
 -- Oracle for 'package-data.mk' files
 packageDataOracle :: Rules ()
 packageDataOracle = do
-    pkgData <- newCache $ \file -> do
+    pkgDataContents <- newCache $ \file -> do
         need [file]
         putOracle $ "Reading " ++ file ++ "..."
         liftIO $ readConfigFile file
-    addOracle $ \(PackageDataKey (file, key)) ->
-        Map.lookup key <$> pkgData (unifyPath file)
+    _ <- addOracle $ \(PackageDataKey (file, key)) ->
+        Map.lookup key <$> pkgDataContents file
     return ()



More information about the ghc-commits mailing list