Commit acf66a3c authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Simplify oracles

parent d3ef19d2
......@@ -35,16 +35,16 @@ trackArgsHash :: (ShakeValue c, ShakeValue b) => Target c b -> Action ()
trackArgsHash t = do
let hashedInputs = [ show $ hash (inputs t) ]
hashedTarget = target (context t) (builder t) hashedInputs (outputs t)
void (askOracle $ ArgsHashKey hashedTarget :: Action Int)
void (askOracle $ ArgsHash hashedTarget :: Action Int)
newtype ArgsHashKey c b = ArgsHashKey (Target c b)
newtype ArgsHash c b = ArgsHash (Target c b)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-- | This oracle stores per-target argument list hashes in the Shake database,
-- allowing the user to track them between builds using 'trackArgsHash' queries.
argsHashOracle :: (ShakeValue c, ShakeValue b) => TrackArgument c b -> Args c b -> Rules ()
argsHashOracle trackArgument args = void $
addOracle $ \(ArgsHashKey target) -> do
addOracle $ \(ArgsHash target) -> do
argList <- interpret target args
let trackedArgList = filter (trackArgument target) argList
return $ hash trackedArgList
......@@ -10,7 +10,7 @@ import Development.Shake.Config
import Hadrian.Utilities
newtype ConfigKey = ConfigKey String
newtype Config = Config String
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-- | Lookup a configuration setting raising an error if the key is not found.
......@@ -21,7 +21,7 @@ unsafeAskConfig key = (fromMaybe $ error msg) <$> askConfig key
-- | Lookup a configuration setting.
askConfig :: String -> Action (Maybe String)
askConfig = askOracle . ConfigKey
askConfig = askOracle . Config
-- | This oracle reads and parses a configuration file consisting of key-value
-- pairs @key = value@ and answers 'askConfig' queries tracking the results.
......@@ -31,4 +31,4 @@ configOracle configFile = void $ do
need [configFile]
putLoud $ "Reading " ++ configFile ++ "..."
liftIO $ readConfigFile configFile
addOracle $ \(ConfigKey key) -> Map.lookup key <$> cfg ()
addOracle $ \(Config key) -> Map.lookup key <$> cfg ()
......@@ -15,7 +15,7 @@ import Settings
import Settings.Builders.GhcCabal
import Settings.Path
newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
newtype Dependency = Dependency (FilePath, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
......@@ -26,15 +26,12 @@ newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
fileDependencies :: Context -> FilePath -> Action (FilePath, [FilePath])
fileDependencies context obj = do
let path = buildPath context -/- ".dependencies"
deps <- askOracle $ ObjDepsKey (path, obj)
deps <- askOracle $ Dependency (path, obj)
case deps of
Nothing -> error $ "No dependencies found for file " ++ obj
Just [] -> error $ "No source file found for file " ++ obj
Just (source : files) -> return (source, files)
newtype PkgDepsKey = PkgDepsKey String
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-- | Given a 'Context' this 'Action' looks up its package dependencies in
-- 'Settings.Paths.packageDependencies' using 'packageDependenciesOracle', and
-- wraps found dependencies in appropriate contexts. The only subtlety here is
......@@ -45,7 +42,7 @@ 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 (PkgDepsKey $ pkgNameString package)
deps <- unpack <$> askOracle (Dependency (packageDependencies, pkgNameString package))
pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
return . map pkgContext $ intersectOrd (compare . pkgNameString) pkgs deps
......@@ -74,16 +71,11 @@ needLibrary cs = need =<< concatMapM libraryTargets cs
-- | Oracles for the package dependencies and 'path/dist/.dependencies' files.
dependenciesOracles :: Rules ()
dependenciesOracles = do
deps <- newCache readDependencies
void $ addOracle $ \(ObjDepsKey (file, obj)) -> Map.lookup obj <$> deps file
pkgDeps <- newCache $ \_ -> readDependencies packageDependencies
void $ addOracle $ \(PkgDepsKey pkg) -> Map.lookup pkg <$> pkgDeps ()
where
readDependencies file = 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
......
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