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

Drop Oracles.Dependencies moving code to the library and Utilities (former Util)

parent 1a0a80ba
...@@ -5,7 +5,7 @@ license: BSD3 ...@@ -5,7 +5,7 @@ license: BSD3
license-file: LICENSE license-file: LICENSE
author: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard author: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard
maintainer: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard maintainer: Andrey Mokhov <andrey.mokhov@gmail.com>, github: @snowleopard
copyright: Andrey Mokhov 2014-2016 copyright: Andrey Mokhov 2014-2017
category: Development category: Development
build-type: Simple build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
...@@ -35,7 +35,6 @@ executable hadrian ...@@ -35,7 +35,6 @@ executable hadrian
, Hadrian.Utilities , Hadrian.Utilities
, Oracles.Flag , Oracles.Flag
, Oracles.Setting , Oracles.Setting
, Oracles.Dependencies
, Oracles.ModuleFiles , Oracles.ModuleFiles
, Oracles.PackageData , Oracles.PackageData
, Package , Package
...@@ -99,10 +98,11 @@ executable hadrian ...@@ -99,10 +98,11 @@ executable hadrian
, Stage , Stage
, Target , Target
, UserSettings , UserSettings
, Util , Utilities
, Way , Way
default-language: Haskell2010 default-language: Haskell2010
default-extensions: RecordWildCards default-extensions: RecordWildCards
, TupleSections
other-extensions: DeriveFunctor other-extensions: DeriveFunctor
, DeriveGeneric , DeriveGeneric
, FlexibleInstances , FlexibleInstances
......
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hadrian.Oracles.KeyValue ( module Hadrian.Oracles.KeyValue (
lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues,
lookupValues, lookupValuesOrEmpty, lookupValuesOrError, keyValueOracle lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, keyValueOracle
) where ) where
import Control.Monad import Control.Monad
...@@ -49,6 +49,18 @@ lookupValuesOrError file key = (fromMaybe $ error msg) <$> lookupValues file key ...@@ -49,6 +49,18 @@ lookupValuesOrError file key = (fromMaybe $ error msg) <$> lookupValues file key
where where
msg = "Key " ++ quote key ++ " not found in file " ++ quote file msg = "Key " ++ quote key ++ " not found in file " ++ quote file
-- | The 'Action' @lookupDependencies depFile file@ looks up dependencies of a
-- @file@ in a (typically generated) dependency file @depFile@. The action
-- returns a pair @(source, files)@, such that the @file@ can be produced by
-- compiling @source@, which in turn also depends on a number of other @files@.
lookupDependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
lookupDependencies depFile file = do
deps <- lookupValues depFile file
case deps of
Nothing -> error $ "No dependencies found for file " ++ quote file
Just [] -> error $ "No source file found for file " ++ quote file
Just (source : files) -> return (source, files)
-- | This oracle reads and parses text files to answer 'lookupValue' and -- | This oracle reads and parses text files to answer 'lookupValue' and
-- 'lookupValues' queries, as well as their derivatives, tracking the results. -- 'lookupValues' queries, as well as their derivatives, tracking the results.
keyValueOracle :: Rules () keyValueOracle :: Rules ()
......
{-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-}
module Oracles.Dependencies (
fileDependencies, contextDependencies, libraryTargets, needLibrary,
pkgDependencies, topsortPackages
) where
import Hadrian.Oracles.KeyValue
import Base
import Context
import Expression hiding (stage)
import Oracles.PackageData
import Settings
import Settings.Builders.GhcCabal
import Settings.Path
-- | '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)@,
-- such that the @file@ can be produced by compiling @source@, which in turn
-- also depends on a number of other @files@.
fileDependencies :: Context -> FilePath -> Action (FilePath, [FilePath])
fileDependencies context obj = do
let path = buildPath context -/- ".dependencies"
deps <- lookupValues 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)
-- | 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
-- that we never depend on packages built in 'Stage2' or later, therefore the
-- stage of the resulting dependencies is bounded from above at 'Stage1'. To
-- compute package dependencies we scan package cabal files, see "Rules.Cabal".
contextDependencies :: Context -> Action [Context]
contextDependencies context@Context {..} = do
let pkgContext = \pkg -> Context (min stage Stage1) pkg way
deps <- lookupValuesOrError packageDependencies (pkgNameString package)
pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
return . map pkgContext $ intersectOrd (compare . pkgNameString) pkgs deps
-- | Given a `Package`, this `Action` looks up its package dependencies
-- 'Settings.Paths.packageDependencies' using 'packageDependenciesOracle'
-- The context will be the vanilla context with stage equal to 1
pkgDependencies :: Package -> Action [Package]
pkgDependencies = fmap (map Context.package) . contextDependencies . vanillaContext Stage1
-- | Given a library 'Package' this action computes all of its targets.
libraryTargets :: Context -> Action [FilePath]
libraryTargets context = do
confFile <- pkgConfFile context
libFile <- pkgLibraryFile context
lib0File <- pkgLibraryFile0 context
lib0 <- buildDll0 context
ghciLib <- pkgGhciLibraryFile context
ghciFlag <- interpretInContext context $ getPkgData BuildGhciLib
let ghci = ghciFlag == "YES" && (stage context == Stage1 || stage1Only)
return $ [ confFile, libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ]
-- | Coarse-grain 'need': make sure all given libraries are fully built.
needLibrary :: [Context] -> Action ()
needLibrary cs = need =<< concatMapM libraryTargets cs
-- | Topological sort of packages according to their dependencies.
-- HACK (izgzhen): See https://github.com/snowleopard/hadrian/issues/344 for details
topsortPackages :: [Package] -> Action [Package]
topsortPackages pkgs = do
elems <- mapM (\p -> (p,) <$> pkgDependencies p) pkgs
return $ map fst $ topSort elems
where
annotateInDeg es e =
(foldr (\e' s -> if fst e' `elem` snd e then s + 1 else s) (0 :: Int) es, e)
topSort [] = []
topSort es =
let annotated = map (annotateInDeg es) es
inDegZero = map snd $ filter ((== 0). fst) annotated
in inDegZero ++ topSort (es \\ inDegZero)
...@@ -12,7 +12,6 @@ import Context ...@@ -12,7 +12,6 @@ import Context
import Expression import Expression
import Flavour import Flavour
import GHC import GHC
import qualified Oracles.Dependencies
import qualified Oracles.ModuleFiles import qualified Oracles.ModuleFiles
import qualified Rules.Compile import qualified Rules.Compile
import qualified Rules.Data import qualified Rules.Data
...@@ -30,6 +29,7 @@ import qualified Rules.Register ...@@ -30,6 +29,7 @@ import qualified Rules.Register
import Settings import Settings
import Settings.Path import Settings.Path
import Target import Target
import Utilities
allStages :: [Stage] allStages :: [Stage]
allStages = [minBound ..] allStages = [minBound ..]
...@@ -61,7 +61,7 @@ packageTargets stage pkg = do ...@@ -61,7 +61,7 @@ packageTargets stage pkg = do
ways <- interpretInContext context getLibraryWays ways <- interpretInContext context getLibraryWays
libs <- mapM (pkgLibraryFile . Context stage pkg) ways libs <- mapM (pkgLibraryFile . Context stage pkg) ways
docs <- interpretInContext context $ buildHaddock flavour docs <- interpretInContext context $ buildHaddock flavour
more <- Oracles.Dependencies.libraryTargets context more <- libraryTargets context
return $ [ pkgSetupConfigFile context | nonCabalContext context ] return $ [ pkgSetupConfigFile context | nonCabalContext context ]
++ [ pkgHaddockFile context | docs && stage == Stage1 ] ++ [ pkgHaddockFile context | docs && stage == Stage1 ]
++ libs ++ more ++ libs ++ more
......
...@@ -3,7 +3,7 @@ module Rules.Clean (clean, cleanSourceTree, cleanRules) where ...@@ -3,7 +3,7 @@ module Rules.Clean (clean, cleanSourceTree, cleanRules) where
import Base import Base
import Settings.Path import Settings.Path
import UserSettings import UserSettings
import Util import Utilities
clean :: Action () clean :: Action ()
clean = do clean = do
......
module Rules.Compile (compilePackage) where module Rules.Compile (compilePackage) where
import Hadrian.Oracles.KeyValue
import Base import Base
import Context import Context
import Expression import Expression
import Oracles.Dependencies
import Rules.Generate import Rules.Generate
import Settings.Path import Settings.Path
import Target import Target
import Util import Utilities
compilePackage :: [(Resource, Int)] -> Context -> Rules () compilePackage :: [(Resource, Int)] -> Context -> Rules ()
compilePackage rs context@Context {..} = do compilePackage rs context@Context {..} = do
...@@ -19,7 +20,7 @@ compilePackage rs context@Context {..} = do ...@@ -19,7 +20,7 @@ compilePackage rs context@Context {..} = do
needDependencies context src $ obj <.> "d" needDependencies context src $ obj <.> "d"
build $ target context (compiler stage) [src] [obj] build $ target context (compiler stage) [src] [obj]
compileHs = \[obj, _hi] -> do compileHs = \[obj, _hi] -> do
(src, deps) <- fileDependencies context obj (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
need $ src : deps need $ src : deps
when (isLibrary package) $ need =<< return <$> pkgConfFile context when (isLibrary package) $ need =<< return <$> pkgConfFile context
needLibrary =<< contextDependencies context needLibrary =<< contextDependencies context
......
...@@ -8,7 +8,7 @@ import Context ...@@ -8,7 +8,7 @@ import Context
import GHC import GHC
import Target import Target
import UserSettings import UserSettings
import Util import Utilities
configureRules :: Rules () configureRules :: Rules ()
configureRules = do configureRules = do
......
...@@ -4,13 +4,12 @@ import Base ...@@ -4,13 +4,12 @@ import Base
import Context import Context
import Expression import Expression
import GHC import GHC
import Oracles.Dependencies
import Oracles.Setting import Oracles.Setting
import Rules.Generate import Rules.Generate
import Settings.Path import Settings.Path
import Target import Target
import UserSettings import UserSettings
import Util import Utilities
-- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files. -- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
buildPackageData :: Context -> Rules () buildPackageData :: Context -> Rules ()
......
...@@ -10,7 +10,7 @@ import Oracles.ModuleFiles ...@@ -10,7 +10,7 @@ import Oracles.ModuleFiles
import Rules.Generate import Rules.Generate
import Settings.Path import Settings.Path
import Target import Target
import Util import Utilities
buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules () buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
buildPackageDependencies rs context@Context {..} = buildPackageDependencies rs context@Context {..} =
......
...@@ -10,7 +10,7 @@ import Oracles.PackageData ...@@ -10,7 +10,7 @@ import Oracles.PackageData
import Settings import Settings
import Settings.Path import Settings.Path
import Target import Target
import Util import Utilities
haddockHtmlLib :: FilePath haddockHtmlLib :: FilePath
haddockHtmlLib = "inplace/lib/html/haddock-util.js" haddockHtmlLib = "inplace/lib/html/haddock-util.js"
......
...@@ -16,7 +16,7 @@ import Settings ...@@ -16,7 +16,7 @@ import Settings
import Settings.Path import Settings.Path
import Target import Target
import UserSettings import UserSettings
import Util import Utilities
-- | Track this file to rebuild generated files whenever it changes. -- | Track this file to rebuild generated files whenever it changes.
trackGenerateHs :: Expr () trackGenerateHs :: Expr ()
......
...@@ -7,7 +7,7 @@ import Settings.Packages.IntegerGmp ...@@ -7,7 +7,7 @@ import Settings.Packages.IntegerGmp
import Settings.Path import Settings.Path
import Target import Target
import UserSettings import UserSettings
import Util import Utilities
gmpBase :: FilePath gmpBase :: FilePath
gmpBase = pkgPath integerGmp -/- "gmp" gmpBase = pkgPath integerGmp -/- "gmp"
......
...@@ -8,7 +8,6 @@ import Base ...@@ -8,7 +8,6 @@ import Base
import Context import Context
import Expression hiding (builder) import Expression hiding (builder)
import GHC import GHC
import Oracles.Dependencies
import Oracles.Setting import Oracles.Setting
import Rules import Rules
import Rules.Generate import Rules.Generate
...@@ -18,7 +17,7 @@ import Settings ...@@ -18,7 +17,7 @@ import Settings
import Settings.Packages.Rts import Settings.Packages.Rts
import Settings.Path import Settings.Path
import Target import Target
import Util import Utilities
{- | Install the built binaries etc. to the @destDir ++ prefix@. {- | Install the built binaries etc. to the @destDir ++ prefix@.
......
...@@ -5,7 +5,7 @@ import Hadrian.Utilities ...@@ -5,7 +5,7 @@ import Hadrian.Utilities
import Settings.Builders.Common import Settings.Builders.Common
import Settings.Packages.Rts import Settings.Packages.Rts
import Target import Target
import Util import Utilities
libffiDependencies :: [FilePath] libffiDependencies :: [FilePath]
libffiDependencies = (rtsBuildPath -/-) <$> [ "ffi.h", "ffitarget.h" ] libffiDependencies = (rtsBuildPath -/-) <$> [ "ffi.h", "ffitarget.h" ]
......
...@@ -10,7 +10,6 @@ import Context ...@@ -10,7 +10,6 @@ import Context
import Expression hiding (way, package) import Expression hiding (way, package)
import Flavour import Flavour
import GHC import GHC
import Oracles.Dependencies
import Oracles.ModuleFiles import Oracles.ModuleFiles
import Oracles.PackageData import Oracles.PackageData
import Oracles.Setting import Oracles.Setting
...@@ -18,7 +17,7 @@ import Settings ...@@ -18,7 +17,7 @@ import Settings
import Settings.Path import Settings.Path
import Target import Target
import UserSettings import UserSettings
import Util import Utilities
libraryObjects :: Context -> Action [FilePath] libraryObjects :: Context -> Action [FilePath]
libraryObjects context@Context{..} = do libraryObjects context@Context{..} = do
......
module Rules.Perl (perlScriptRules) where module Rules.Perl (perlScriptRules) where
import Base import Base
import Util import Utilities
-- | Build Perl scripts, such as @ghc-split@, from their literate Perl sources. -- | Build Perl scripts, such as @ghc-split@, from their literate Perl sources.
perlScriptRules :: Rules () perlScriptRules :: Rules ()
......
...@@ -6,7 +6,6 @@ import Base ...@@ -6,7 +6,6 @@ import Base
import Context import Context
import Expression hiding (stage, way) import Expression hiding (stage, way)
import GHC import GHC
import Oracles.Dependencies
import Oracles.ModuleFiles import Oracles.ModuleFiles
import Oracles.PackageData import Oracles.PackageData
import Oracles.Setting import Oracles.Setting
...@@ -15,7 +14,7 @@ import Settings ...@@ -15,7 +14,7 @@ import Settings
import Settings.Path import Settings.Path
import Target import Target
import UserSettings import UserSettings
import Util import Utilities
buildProgram :: [(Resource, Int)] -> Context -> Rules () buildProgram :: [(Resource, Int)] -> Context -> Rules ()
buildProgram rs context@Context {..} = when (isProgram package) $ do buildProgram rs context@Context {..} = when (isProgram package) $ do
......
...@@ -6,7 +6,7 @@ import GHC ...@@ -6,7 +6,7 @@ import GHC
import Settings.Path import Settings.Path
import Target import Target
import UserSettings import UserSettings
import Util import Utilities
-- | Build rules for registering packages and initialising package databases -- | Build rules for registering packages and initialising package databases
-- by running the @ghc-pkg@ utility. -- by running the @ghc-pkg@ utility.
......
...@@ -6,7 +6,7 @@ import Base ...@@ -6,7 +6,7 @@ import Base
import Oracles.Setting import Oracles.Setting
import Rules.Clean import Rules.Clean
import UserSettings import UserSettings
import Util import Utilities
sourceDistRules :: Rules () sourceDistRules :: Rules ()
sourceDistRules = do sourceDistRules = do
......
...@@ -9,7 +9,7 @@ import Oracles.Setting ...@@ -9,7 +9,7 @@ import Oracles.Setting
import Settings import Settings
import Settings.Path import Settings.Path
import Target import Target
import Util import Utilities
-- TODO: clean up after testing -- TODO: clean up after testing
testRules :: Rules () testRules :: Rules ()
......
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