Commit 1a0a80ba authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Extend KeyValue oracle to handle lists of values

parent 709ffb71
{-# 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
{-# 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@. 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@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]
......
......@@ -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]
......
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