Drop Oracles.Dependencies moving code to the library and Utilities (former Util)
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 13 Aug 2017 22:20:18 +0000 (23:20 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sun, 13 Aug 2017 22:20:18 +0000 (23:20 +0100)
25 files changed:
hadrian.cabal
src/Hadrian/Oracles/KeyValue.hs
src/Oracles/Dependencies.hs [deleted file]
src/Rules.hs
src/Rules/Clean.hs
src/Rules/Compile.hs
src/Rules/Configure.hs
src/Rules/Data.hs
src/Rules/Dependencies.hs
src/Rules/Documentation.hs
src/Rules/Generate.hs
src/Rules/Gmp.hs
src/Rules/Install.hs
src/Rules/Libffi.hs
src/Rules/Library.hs
src/Rules/Perl.hs
src/Rules/Program.hs
src/Rules/Register.hs
src/Rules/SourceDist.hs
src/Rules/Test.hs
src/Rules/Wrappers.hs
src/Settings.hs
src/Settings/Builders/GhcCabal.hs
src/Settings/Packages/GhcCabal.hs
src/Utilities.hs [moved from src/Util.hs with 85% similarity]

index c964f3b..9aa6899 100644 (file)
@@ -5,7 +5,7 @@ license:             BSD3
 license-file:        LICENSE
 author:              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
 build-type:          Simple
 cabal-version:       >=1.10
@@ -35,7 +35,6 @@ executable hadrian
                        , Hadrian.Utilities
                        , Oracles.Flag
                        , Oracles.Setting
-                       , Oracles.Dependencies
                        , Oracles.ModuleFiles
                        , Oracles.PackageData
                        , Package
@@ -99,10 +98,11 @@ executable hadrian
                        , Stage
                        , Target
                        , UserSettings
-                       , Util
+                       , Utilities
                        , Way
     default-language:    Haskell2010
     default-extensions:  RecordWildCards
+                       , TupleSections
     other-extensions:    DeriveFunctor
                        , DeriveGeneric
                        , FlexibleInstances
index 5155e3e..6b19ddd 100644 (file)
@@ -1,7 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Hadrian.Oracles.KeyValue (
-    lookupValue, lookupValueOrEmpty, lookupValueOrError,
-    lookupValues, lookupValuesOrEmpty, lookupValuesOrError, keyValueOracle
+    lookupValue, lookupValueOrEmpty, lookupValueOrError, lookupValues,
+    lookupValuesOrEmpty, lookupValuesOrError, lookupDependencies, keyValueOracle
     ) where
 
 import Control.Monad
@@ -49,6 +49,18 @@ lookupValuesOrError file key = (fromMaybe $ error msg) <$> lookupValues file key
   where
     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
 -- 'lookupValues' queries, as well as their derivatives, tracking the results.
 keyValueOracle :: Rules ()
diff --git a/src/Oracles/Dependencies.hs b/src/Oracles/Dependencies.hs
deleted file mode 100644 (file)
index 6ed5633..0000000
+++ /dev/null
@@ -1,79 +0,0 @@
-{-# 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)
index 2c09e94..64915a0 100644 (file)
@@ -12,7 +12,6 @@ import Context
 import Expression
 import Flavour
 import GHC
-import qualified Oracles.Dependencies
 import qualified Oracles.ModuleFiles
 import qualified Rules.Compile
 import qualified Rules.Data
@@ -30,6 +29,7 @@ import qualified Rules.Register
 import Settings
 import Settings.Path
 import Target
+import Utilities
 
 allStages :: [Stage]
 allStages = [minBound ..]
@@ -61,7 +61,7 @@ packageTargets stage pkg = do
             ways <- interpretInContext context getLibraryWays
             libs <- mapM (pkgLibraryFile . Context stage pkg) ways
             docs <- interpretInContext context $ buildHaddock flavour
-            more <- Oracles.Dependencies.libraryTargets context
+            more <- libraryTargets context
             return $ [ pkgSetupConfigFile context | nonCabalContext context ]
                   ++ [ pkgHaddockFile     context | docs && stage == Stage1 ]
                   ++ libs ++ more
index 5752850..42e6052 100644 (file)
@@ -3,7 +3,7 @@ module Rules.Clean (clean, cleanSourceTree, cleanRules) where
 import Base
 import Settings.Path
 import UserSettings
-import Util
+import Utilities
 
 clean :: Action ()
 clean = do
index 2d76d2e..746f723 100644 (file)
@@ -1,13 +1,14 @@
 module Rules.Compile (compilePackage) where
 
+import Hadrian.Oracles.KeyValue
+
 import Base
 import Context
 import Expression
-import Oracles.Dependencies
 import Rules.Generate
 import Settings.Path
 import Target
-import Util
+import Utilities
 
 compilePackage :: [(Resource, Int)] -> Context -> Rules ()
 compilePackage rs context@Context {..} = do
@@ -19,7 +20,7 @@ compilePackage rs context@Context {..} = do
             needDependencies context src $ obj <.> "d"
             build $ target context (compiler stage) [src] [obj]
         compileHs = \[obj, _hi] -> do
-            (src, deps) <- fileDependencies context obj
+            (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
             need $ src : deps
             when (isLibrary package) $ need =<< return <$> pkgConfFile context
             needLibrary =<< contextDependencies context
index 0c76dff..af79967 100644 (file)
@@ -8,7 +8,7 @@ import Context
 import GHC
 import Target
 import UserSettings
-import Util
+import Utilities
 
 configureRules :: Rules ()
 configureRules = do
index d914ba0..ff18a12 100644 (file)
@@ -4,13 +4,12 @@ import Base
 import Context
 import Expression
 import GHC
-import Oracles.Dependencies
 import Oracles.Setting
 import Rules.Generate
 import Settings.Path
 import Target
 import UserSettings
-import Util
+import Utilities
 
 -- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
 buildPackageData :: Context -> Rules ()
index 0ff79b2..6931194 100644 (file)
@@ -10,7 +10,7 @@ import Oracles.ModuleFiles
 import Rules.Generate
 import Settings.Path
 import Target
-import Util
+import Utilities
 
 buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
 buildPackageDependencies rs context@Context {..} =
index be9013b..b59b09f 100644 (file)
@@ -10,7 +10,7 @@ import Oracles.PackageData
 import Settings
 import Settings.Path
 import Target
-import Util
+import Utilities
 
 haddockHtmlLib :: FilePath
 haddockHtmlLib = "inplace/lib/html/haddock-util.js"
index 43d9272..7b7d27e 100644 (file)
@@ -16,7 +16,7 @@ import Settings
 import Settings.Path
 import Target
 import UserSettings
-import Util
+import Utilities
 
 -- | Track this file to rebuild generated files whenever it changes.
 trackGenerateHs :: Expr ()
index b8ce5c2..c6d18b4 100644 (file)
@@ -7,7 +7,7 @@ import Settings.Packages.IntegerGmp
 import Settings.Path
 import Target
 import UserSettings
-import Util
+import Utilities
 
 gmpBase :: FilePath
 gmpBase = pkgPath integerGmp -/- "gmp"
index ac92533..23c4cba 100644 (file)
@@ -8,7 +8,6 @@ import Base
 import Context
 import Expression hiding (builder)
 import GHC
-import Oracles.Dependencies
 import Oracles.Setting
 import Rules
 import Rules.Generate
@@ -18,7 +17,7 @@ import Settings
 import Settings.Packages.Rts
 import Settings.Path
 import Target
-import Util
+import Utilities
 
 {- | Install the built binaries etc. to the @destDir ++ prefix@.
 
index 7b9e071..1506c0a 100644 (file)
@@ -5,7 +5,7 @@ import Hadrian.Utilities
 import Settings.Builders.Common
 import Settings.Packages.Rts
 import Target
-import Util
+import Utilities
 
 libffiDependencies :: [FilePath]
 libffiDependencies = (rtsBuildPath -/-) <$> [ "ffi.h", "ffitarget.h" ]
index 1b36279..971bbb6 100644 (file)
@@ -10,7 +10,6 @@ import Context
 import Expression hiding (way, package)
 import Flavour
 import GHC
-import Oracles.Dependencies
 import Oracles.ModuleFiles
 import Oracles.PackageData
 import Oracles.Setting
@@ -18,7 +17,7 @@ import Settings
 import Settings.Path
 import Target
 import UserSettings
-import Util
+import Utilities
 
 libraryObjects :: Context -> Action [FilePath]
 libraryObjects context@Context{..} = do
index 50e9cdb..a05c6a6 100644 (file)
@@ -1,7 +1,7 @@
 module Rules.Perl (perlScriptRules) where
 
 import Base
-import Util
+import Utilities
 
 -- | Build Perl scripts, such as @ghc-split@, from their literate Perl sources.
 perlScriptRules :: Rules ()
index 2bb2de9..16c415f 100644 (file)
@@ -6,7 +6,6 @@ import Base
 import Context
 import Expression hiding (stage, way)
 import GHC
-import Oracles.Dependencies
 import Oracles.ModuleFiles
 import Oracles.PackageData
 import Oracles.Setting
@@ -15,7 +14,7 @@ import Settings
 import Settings.Path
 import Target
 import UserSettings
-import Util
+import Utilities
 
 buildProgram :: [(Resource, Int)] -> Context -> Rules ()
 buildProgram rs context@Context {..} = when (isProgram package) $ do
index 7ba9c9e..71a29da 100644 (file)
@@ -6,7 +6,7 @@ import GHC
 import Settings.Path
 import Target
 import UserSettings
-import Util
+import Utilities
 
 -- | Build rules for registering packages and initialising package databases
 -- by running the @ghc-pkg@ utility.
index bf70b79..4db67db 100644 (file)
@@ -6,7 +6,7 @@ import Base
 import Oracles.Setting
 import Rules.Clean
 import UserSettings
-import Util
+import Utilities
 
 sourceDistRules :: Rules ()
 sourceDistRules = do
index fc210e7..13895a5 100644 (file)
@@ -9,7 +9,7 @@ import Oracles.Setting
 import Settings
 import Settings.Path
 import Target
-import Util
+import Utilities
 
 -- TODO: clean up after testing
 testRules :: Rules ()
index 6cfa964..cd1eb77 100644 (file)
@@ -9,7 +9,7 @@ import Oracles.Setting
 import Settings
 import Settings.Install
 import Settings.Path
-import Util
+import Utilities
 
 -- | Wrapper is an expression depending on the 'FilePath' to the
 -- | library path and name of the wrapped binary.
index f9694a9..7576e7a 100644 (file)
@@ -3,7 +3,7 @@ module Settings (
     findKnownPackage, getPkgData, getPkgDataList, isLibrary,
     getBuildPath, stagePackages, builderPath,
     getBuilderPath, isSpecified, latestBuildStage, programPath, programContext,
-    integerLibraryName, destDir, pkgConfInstallPath, stage1Only
+    integerLibraryName, destDir, pkgConfInstallPath, stage1Only, buildDll0
     ) where
 
 import Hadrian.Oracles.KeyValue
@@ -16,6 +16,7 @@ import Expression
 import Flavour
 import GHC
 import Oracles.PackageData
+import Oracles.Setting
 import {-# SOURCE #-} Settings.Default
 import Settings.Flavours.Development
 import Settings.Flavours.Performance
@@ -159,3 +160,8 @@ stage1Only = defaultStage1Only
 -- | Install's DESTDIR setting.
 destDir :: FilePath
 destDir = defaultDestDir
+
+buildDll0 :: Context -> Action Bool
+buildDll0 Context {..} = do
+    windows <- windowsHost
+    return $ windows && stage == Stage1 && package == compiler
index a63cb08..17ee22c 100644 (file)
@@ -1,11 +1,11 @@
 module Settings.Builders.GhcCabal (
-    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs, buildDll0
+    ghcCabalBuilderArgs, ghcCabalHsColourBuilderArgs
     ) where
 
 import Context
 import Flavour
 import Settings.Builders.Common hiding (package)
-import Util
+import Utilities
 
 ghcCabalBuilderArgs :: Args
 ghcCabalBuilderArgs = builder GhcCabal ? do
@@ -116,11 +116,6 @@ with b = isSpecified b ? do
 withStaged :: (Stage -> Builder) -> Args
 withStaged sb = with . sb =<< getStage
 
-buildDll0 :: Context -> Action Bool
-buildDll0 Context {..} = do
-    windows <- windowsHost
-    return $ windows && stage == Stage1 && package == compiler
-
 -- This is a positional argument, hence:
 -- * if it is empty, we need to emit one empty string argument;
 -- * otherwise, we must collapse it into one space-separated string.
index eb7a567..c7b82ca 100644 (file)
@@ -10,7 +10,7 @@ import Distribution.Verbosity (silent)
 import Base
 import Expression
 import GHC
-import Oracles.Dependencies (pkgDependencies)
+import Utilities
 
 ghcCabalPackageArgs :: Args
 ghcCabalPackageArgs = stage0 ? package ghcCabal ? builder Ghc ? do
similarity index 85%
rename from src/Util.hs
rename to src/Utilities.hs
index 79d7f32..5356c11 100644 (file)
@@ -1,10 +1,11 @@
-module Util (
+module Utilities (
     build, buildWithCmdOptions, buildWithResources, copyFile, fixFile, moveFile,
     removeFile, copyDirectory, copyDirectoryContents, createDirectory,
     moveDirectory, removeDirectory, applyPatch, runBuilder, runBuilderWith,
     makeExecutable, renderProgram, renderLibrary, builderEnvironment,
     needBuilder, copyFileUntracked, installDirectory, installData, installScript,
-    installProgram, linkSymbolic, bashPath
+    installProgram, linkSymbolic, bashPath, contextDependencies, pkgDependencies,
+    libraryTargets, needLibrary, topsortPackages
     ) where
 
 import qualified System.Directory.Extra as IO
@@ -13,6 +14,7 @@ import qualified Control.Exception.Base as IO
 
 import Hadrian.Oracles.ArgsHash
 import Hadrian.Oracles.DirectoryContents
+import Hadrian.Oracles.KeyValue
 import Hadrian.Oracles.Path
 
 import Base
@@ -21,7 +23,9 @@ import Context
 import Expression hiding (builder, inputs, outputs, way, stage, package)
 import GHC
 import Oracles.Setting
+import Oracles.PackageData
 import Settings
+import Settings.Path
 import Settings.Builders.Ar
 import Target
 import UserSettings
@@ -260,6 +264,54 @@ makeExecutable file = do
 bashPath :: Action FilePath
 bashPath = lookupInPath "bash"
 
+-- | Given a 'Context' this 'Action' looks up its package dependencies in
+-- 'Settings.Paths.packageDependencies' and wraps the results 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 {..} = 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
+
+-- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
+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
+
+-- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344.
+-- | Topological sort of packages according to their dependencies.
+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)
+
 -- | Print out information about the command being executed.
 putInfo :: Target -> Action ()
 putInfo t = putProgressInfo $ renderAction