Commit 49574e62 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Drop DepKeys, add DepId, clean up code.

parent 4238fb77
...@@ -8,7 +8,6 @@ module Oracles.PackageData ( ...@@ -8,7 +8,6 @@ module Oracles.PackageData (
import Base import Base
import Util import Util
import Data.List import Data.List
import Data.Maybe
import Control.Applicative import Control.Applicative
import qualified Data.HashMap.Strict as Map import qualified Data.HashMap.Strict as Map
...@@ -22,6 +21,7 @@ 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", ...] -- pkgListData Modules therefore returns ["Data.Array", "Data.Array.Base", ...]
data PackageData = Version FilePath data PackageData = Version FilePath
| PackageKey FilePath | PackageKey FilePath
| LibName FilePath
| Synopsis FilePath | Synopsis FilePath
| BuildGhciLib FilePath | BuildGhciLib FilePath
...@@ -30,7 +30,7 @@ data PackageDataList = Modules FilePath ...@@ -30,7 +30,7 @@ data PackageDataList = Modules FilePath
| SrcDirs FilePath | SrcDirs FilePath
| IncludeDirs FilePath | IncludeDirs FilePath
| Deps FilePath | Deps FilePath
| DepKeys FilePath | DepIds FilePath
| DepNames FilePath | DepNames FilePath
| CppArgs FilePath | CppArgs FilePath
| HsArgs FilePath | HsArgs FilePath
...@@ -41,59 +41,47 @@ data PackageDataList = Modules FilePath ...@@ -41,59 +41,47 @@ data PackageDataList = Modules FilePath
newtype PackageDataKey = PackageDataKey (FilePath, String) newtype PackageDataKey = PackageDataKey (FilePath, String)
deriving (Show, Typeable, Eq, Hashable, Binary, NFData) deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-- TODO: is this needed?
askPackageData :: FilePath -> String -> Action String askPackageData :: FilePath -> String -> Action String
askPackageData path key = do askPackageData path key = do
let fullKey = replaceSeparators '_' $ path ++ "_" ++ key let fullKey = replaceSeparators '_' $ path ++ "_" ++ key
pkgData = path -/- "package-data.mk" file = path -/- "package-data.mk"
value <- askOracle $ PackageDataKey (pkgData, fullKey) maybeValue <- askOracle $ PackageDataKey (file, fullKey)
return $ fromMaybe case maybeValue of
(error $ "No key '" ++ key ++ "' in " ++ pkgData ++ ".") value Nothing -> putError $ "No key '" ++ key ++ "' in " ++ file ++ "."
Just value -> return value
pkgData :: PackageData -> Action String pkgData :: PackageData -> Action String
pkgData packageData = do pkgData packageData = case packageData of
let (key, path) = case packageData of Version path -> askPackageData path "VERSION"
Version path -> ("VERSION" , path) PackageKey path -> askPackageData path "PACKAGE_KEY"
PackageKey path -> ("PACKAGE_KEY" , path) LibName path -> askPackageData path "LIB_NAME"
Synopsis path -> ("SYNOPSIS" , path) Synopsis path -> askPackageData path "SYNOPSIS"
BuildGhciLib path -> ("BUILD_GHCI_LIB", path) BuildGhciLib path -> askPackageData path "BUILD_GHCI_LIB"
fullKey = replaceSeparators '_' $ path ++ "_" ++ key
pkgData = path -/- "package-data.mk"
res <- askOracle $ PackageDataKey (pkgData, fullKey)
return $ fromMaybe
(error $ "No key '" ++ key ++ "' in " ++ pkgData ++ ".") res
pkgDataList :: PackageDataList -> Action [String] pkgDataList :: PackageDataList -> Action [String]
pkgDataList packageData = do pkgDataList packageData = fmap (map unquote . words) $ case packageData of
let (key, path, defaultValue) = case packageData of Modules path -> askPackageData path "MODULES"
Modules path -> ("MODULES" , path, "" ) HiddenModules path -> askPackageData path "HIDDEN_MODULES"
HiddenModules path -> ("HIDDEN_MODULES" , path, "" ) SrcDirs path -> askPackageData path "HS_SRC_DIRS"
SrcDirs path -> ("HS_SRC_DIRS" , path, ".") IncludeDirs path -> askPackageData path "INCLUDE_DIRS"
IncludeDirs path -> ("INCLUDE_DIRS" , path, ".") Deps path -> askPackageData path "DEPS"
Deps path -> ("DEPS" , path, "" ) DepIds path -> askPackageData path "DEP_IPIDS"
DepKeys path -> ("DEP_KEYS" , path, "" ) DepNames path -> askPackageData path "DEP_NAMES"
DepNames path -> ("DEP_NAMES" , path, "" ) CppArgs path -> askPackageData path "CPP_OPTS"
CppArgs path -> ("CPP_OPTS" , path, "" ) HsArgs path -> askPackageData path "HC_OPTS"
HsArgs path -> ("HC_OPTS" , path, "" ) CcArgs path -> askPackageData path "CC_OPTS"
CcArgs path -> ("CC_OPTS" , path, "" ) CSrcs path -> askPackageData path "C_SRCS"
CSrcs path -> ("C_SRCS" , path, "" ) DepIncludeDirs path -> askPackageData path "DEP_INCLUDE_DIRS_SINGLE_QUOTED"
DepIncludeDirs path -> ("DEP_INCLUDE_DIRS_SINGLE_QUOTED", path, "" ) where
fullKey = replaceSeparators '_' $ path ++ "_" ++ key unquote = dropWhile (== '\'') . dropWhileEnd (== '\'')
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
-- Oracle for 'package-data.mk' files -- Oracle for 'package-data.mk' files
packageDataOracle :: Rules () packageDataOracle :: Rules ()
packageDataOracle = do packageDataOracle = do
pkgData <- newCache $ \file -> do pkgDataContents <- newCache $ \file -> do
need [file] need [file]
putOracle $ "Reading " ++ file ++ "..." putOracle $ "Reading " ++ file ++ "..."
liftIO $ readConfigFile file liftIO $ readConfigFile file
addOracle $ \(PackageDataKey (file, key)) -> _ <- addOracle $ \(PackageDataKey (file, key)) ->
Map.lookup key <$> pkgData (unifyPath file) Map.lookup key <$> pkgDataContents file
return () return ()
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment