9ffdfce3147f1deea43359e4e7b79993ae1b48b7
[ghc.git] / src / Utilities.hs
1 module Utilities (
2 build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith,
3 builderEnvironment, needLibrary, applyPatch, installDirectory, installData,
4 installScript, installProgram, linkSymbolic, contextDependencies,
5 stage1Dependencies, libraryTargets, topsortPackages
6 ) where
7
8 import qualified System.Directory.Extra as IO
9
10 import qualified Hadrian.Builder as H
11 import Hadrian.Haskell.Cabal
12 import Hadrian.Oracles.Path
13 import Hadrian.Utilities
14
15 import Context
16 import Expression hiding (stage)
17 import Oracles.Setting
18 import Oracles.PackageData
19 import Settings
20 import Target
21 import UserSettings
22
23 build :: Target -> Action ()
24 build target = H.build target getArgs
25
26 buildWithResources :: [(Resource, Int)] -> Target -> Action ()
27 buildWithResources rs target = H.buildWithResources rs target getArgs
28
29 buildWithCmdOptions :: [CmdOption] -> Target -> Action ()
30 buildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs
31
32 -- | Apply a patch by executing the 'Patch' builder in a given directory.
33 applyPatch :: FilePath -> FilePath -> Action ()
34 applyPatch dir patch = do
35 let file = dir -/- patch
36 needBuilder Patch
37 path <- builderPath Patch
38 putBuild $ "| Apply patch " ++ file
39 quietly $ cmd Shell [Cwd dir] [path, "-p0 <", patch]
40
41 -- | Install a directory.
42 installDirectory :: FilePath -> Action ()
43 installDirectory dir = do
44 path <- fixAbsolutePathOnWindows =<< setting InstallDir
45 putBuild $ "| Install directory " ++ dir
46 quietly $ cmd path dir
47
48 -- | Install data files to a directory and track them.
49 installData :: [FilePath] -> FilePath -> Action ()
50 installData fs dir = do
51 path <- fixAbsolutePathOnWindows =<< setting InstallData
52 need fs
53 forM_ fs $ \f -> putBuild $ "| Install data " ++ f ++ " to " ++ dir
54 quietly $ cmd path fs dir
55
56 -- | Install an executable file to a directory and track it.
57 installProgram :: FilePath -> FilePath -> Action ()
58 installProgram f dir = do
59 path <- fixAbsolutePathOnWindows =<< setting InstallProgram
60 need [f]
61 putBuild $ "| Install program " ++ f ++ " to " ++ dir
62 quietly $ cmd path f dir
63
64 -- | Install an executable script to a directory and track it.
65 installScript :: FilePath -> FilePath -> Action ()
66 installScript f dir = do
67 path <- fixAbsolutePathOnWindows =<< setting InstallScript
68 need [f]
69 putBuild $ "| Install script " ++ f ++ " to " ++ dir
70 quietly $ cmd path f dir
71
72 -- | Create a symbolic link from source file to target file (when symbolic links
73 -- are supported) and track the source file.
74 linkSymbolic :: FilePath -> FilePath -> Action ()
75 linkSymbolic source target = do
76 lns <- setting LnS
77 unless (null lns) $ do
78 need [source] -- Guarantee source is built before printing progress info.
79 let dir = takeDirectory target
80 liftIO $ IO.createDirectoryIfMissing True dir
81 putProgressInfo =<< renderAction "Create symbolic link" source target
82 quietly $ cmd lns source target
83
84 -- | Write a Builder's path into a given environment variable.
85 builderEnvironment :: String -> Builder -> Action CmdOption
86 builderEnvironment variable builder = do
87 needBuilder builder
88 path <- builderPath builder
89 return $ AddEnv variable path
90
91 -- | Given a 'Context' this 'Action' looks up its package dependencies and wraps
92 -- the results in appropriate contexts. The only subtlety here is that we never
93 -- depend on packages built in 'Stage2' or later, therefore the stage of the
94 -- resulting dependencies is bounded from above at 'Stage1'. To compute package
95 -- dependencies we scan package @.cabal@ files, see 'pkgDependencies' defined
96 -- in "Hadrian.Haskell.Cabal".
97 contextDependencies :: Context -> Action [Context]
98 contextDependencies Context {..} = case pkgCabalFile package of
99 Nothing -> return [] -- Non-Cabal packages have no dependencies.
100 Just cabalFile -> do
101 let depStage = min stage Stage1
102 depContext = \pkg -> Context depStage pkg way
103 deps <- pkgDependencies cabalFile
104 pkgs <- sort <$> stagePackages depStage
105 return . map depContext $ intersectOrd (compare . pkgName) pkgs deps
106
107 -- | Lookup dependencies of a 'Package' in the vanilla Stage1 context.
108 stage1Dependencies :: Package -> Action [Package]
109 stage1Dependencies =
110 fmap (map Context.package) . contextDependencies . vanillaContext Stage1
111
112 -- | Given a library 'Package' this action computes all of its targets. See
113 -- 'packageTargets' for the explanation of the @includeGhciLib@ parameter.
114 libraryTargets :: Bool -> Context -> Action [FilePath]
115 libraryTargets includeGhciLib context = do
116 confFile <- pkgConfFile context
117 libFile <- pkgLibraryFile context
118 lib0File <- pkgLibraryFile0 context
119 lib0 <- buildDll0 context
120 ghciLib <- pkgGhciLibraryFile context
121 ghciFlag <- if includeGhciLib
122 then interpretInContext context $ getPkgData BuildGhciLib
123 else return "NO"
124 let ghci = ghciFlag == "YES" && (stage context == Stage1 || stage1Only)
125 return $ [ confFile, libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ]
126
127 -- | Coarse-grain 'need': make sure all given libraries are fully built.
128 needLibrary :: [Context] -> Action ()
129 needLibrary cs = need =<< concatMapM (libraryTargets True) cs
130
131 -- HACK (izgzhen), see https://github.com/snowleopard/hadrian/issues/344.
132 -- | Topological sort of packages according to their dependencies.
133 topsortPackages :: [Package] -> Action [Package]
134 topsortPackages pkgs = do
135 elems <- mapM (\p -> (p,) <$> stage1Dependencies p) pkgs
136 return $ map fst $ topSort elems
137 where
138 annotateInDeg es e =
139 (foldr (\e' s -> if fst e' `elem` snd e then s + 1 else s) (0 :: Int) es, e)
140 topSort [] = []
141 topSort es =
142 let annotated = map (annotateInDeg es) es
143 inDegZero = map snd $ filter ((== 0). fst) annotated
144 in inDegZero ++ topSort (es \\ inDegZero)