Expression: Don't re-export Base
[hadrian.git] / src / Rules / Cabal.hs
1 module Rules.Cabal (cabalRules) where
2
3 import Base
4 import Data.Version
5 import Distribution.Package as DP
6 import Distribution.PackageDescription
7 import Distribution.PackageDescription.Parse
8 import Distribution.Verbosity
9 import Expression
10 import GHC
11 import Rules.Actions
12 import Settings
13
14 cabalRules :: Rules ()
15 cabalRules = do
16 -- Cache boot package constraints (to be used in cabalArgs)
17 bootPackageConstraints %> \out -> do
18 bootPkgs <- interpretWithStage Stage0 getPackages
19 let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
20 constraints <- forM (sort pkgs) $ \pkg -> do
21 need [pkgCabalFile pkg]
22 pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
23 let identifier = package . packageDescription $ pd
24 version = showVersion . pkgVersion $ identifier
25 DP.PackageName name = DP.pkgName identifier
26 return $ name ++ " == " ++ version
27 writeFileChanged out . unlines $ constraints
28
29 -- Cache package dependencies
30 packageDependencies %> \out -> do
31 pkgs <- interpretWithStage Stage1 getPackages
32 pkgDeps <- forM (sort pkgs) $ \pkg -> do
33 need [pkgCabalFile pkg]
34 pd <- liftIO . readPackageDescription silent $ pkgCabalFile pkg
35 let depsLib = collectDeps $ condLibrary pd
36 depsExes = map (collectDeps . Just . snd) $ condExecutables pd
37 deps = concat $ depsLib : depsExes
38 depNames = [ name | Dependency (DP.PackageName name) _ <- deps ]
39 return . unwords $ pkgNameString pkg : sort depNames
40 writeFileChanged out . unlines $ pkgDeps
41
42 -- When the file exists, the bootstrappingConf has been initialised
43 -- TODO: get rid of an extra file?
44 bootstrappingConfInitialised %> \out -> do
45 removeDirectoryIfExists bootstrappingConf
46 -- TODO: can we get rid of this fake target?
47 let target = PartialTarget Stage0 cabal
48 build $ fullTarget target (GhcPkg Stage0) [] [bootstrappingConf]
49 let message = "Successfully initialised " ++ bootstrappingConf
50 writeFileChanged out message
51 putSuccess message
52
53
54 collectDeps :: Maybe (CondTree v [Dependency] a) -> [Dependency]
55 collectDeps Nothing = []
56 collectDeps (Just (CondNode _ deps ifs)) = deps ++ concatMap f ifs
57 where
58 f (_, t, mt) = collectDeps (Just t) ++ collectDeps mt