Dependencies.hs 3.68 KB
Newer Older
1
{-# LANGUAGE GeneralizedNewtypeDeriving, TupleSections #-}
Andrey Mokhov's avatar
Andrey Mokhov committed
2
module Oracles.Dependencies (
3
    fileDependencies, contextDependencies, libraryTargets, needLibrary,
4
    pkgDependencies, topsortPackages
Andrey Mokhov's avatar
Andrey Mokhov committed
5
    ) where
6

7
import Hadrian.Oracles.KeyValue
8

Andrey Mokhov's avatar
Andrey Mokhov committed
9
import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
10
import Context
11
import Expression hiding (stage)
Andrey Mokhov's avatar
Andrey Mokhov committed
12
13
14
import Oracles.PackageData
import Settings
import Settings.Builders.GhcCabal
15
import Settings.Path
Andrey Mokhov's avatar
Andrey Mokhov committed
16

Andrey Mokhov's avatar
Andrey Mokhov committed
17
-- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
18
-- in a generated dependency file @path/.dependencies@, where @path@ is the build
Andrey Mokhov's avatar
Andrey Mokhov committed
19
20
21
22
23
24
-- 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"
25
    deps <- lookupValues path obj
Andrey Mokhov's avatar
Andrey Mokhov committed
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    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
40
    deps <- lookupValuesOrError packageDependencies (pkgNameString package)
Andrey Mokhov's avatar
Andrey Mokhov committed
41
42
    pkgs <- sort <$> interpretInContext (pkgContext package) getPackages
    return . map pkgContext $ intersectOrd (compare . pkgNameString) pkgs deps
Andrey Mokhov's avatar
Andrey Mokhov committed
43

44
45
46
47
48
49
-- | 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

50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
-- | 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
Andrey Mokhov's avatar
Andrey Mokhov committed
65

66
-- | Topological sort of packages according to their dependencies.
67
-- HACK (izgzhen): See https://github.com/snowleopard/hadrian/issues/344 for details
68
69
topsortPackages :: [Package] -> Action [Package]
topsortPackages pkgs = do
70
71
72
73
    elems <- mapM (\p -> (p,) <$> pkgDependencies p) pkgs
    return $ map fst $ topSort elems
  where
    annotateInDeg es e =
Andrey Mokhov's avatar
Andrey Mokhov committed
74
     (foldr (\e' s -> if fst e' `elem` snd e then s + 1 else s) (0 :: Int) es, e)
75
76
77
78
79
    topSort [] = []
    topSort es =
      let annotated = map (annotateInDeg es) es
          inDegZero = map snd $ filter ((== 0). fst) annotated
      in  inDegZero ++ topSort (es \\ inDegZero)