hadrian: eliminate most of the remaining big rule enumerations
[ghc.git] / hadrian / src / Rules / Dependencies.hs
1 module Rules.Dependencies (buildPackageDependencies) where
2
3 import Data.Bifunctor
4 import Data.Function
5
6 import Base
7 import Context
8 import Expression
9 import Hadrian.BuildPath
10 import Oracles.ModuleFiles
11 import Rules.Generate
12 import Settings.Default
13 import Target
14 import Utilities
15
16 import qualified Text.Parsec as Parsec
17
18 buildPackageDependencies :: [(Resource, Int)] -> Rules ()
19 buildPackageDependencies rs = do
20 root <- buildRootRules
21 root -/- "**/.dependencies.mk" %> \mk -> do
22 depfile <- getDepMkFile root mk
23 context <- depMkFileContext depfile
24 srcs <- hsSources context
25 need srcs
26 orderOnly =<< interpretInContext context generatedDependencies
27 if null srcs
28 then writeFileChanged mk ""
29 else buildWithResources rs $
30 target context
31 (Ghc FindHsDependencies $ Context.stage context)
32 srcs [mk]
33 removeFile $ mk <.> "bak"
34
35 root -/- "**/.dependencies" %> \deps -> do
36 mkDeps <- readFile' (deps <.> "mk")
37 writeFileChanged deps . unlines
38 . map (\(src, deps) -> unwords $ src : deps)
39 . map (bimap unifyPath (map unifyPath))
40 . map (bimap head concat . unzip)
41 . groupBy ((==) `on` fst)
42 . sortBy (compare `on` fst)
43 $ parseMakefile mkDeps
44
45
46 data DepMkFile = DepMkFile Stage FilePath
47 deriving (Eq, Show)
48
49 parseDepMkFile :: FilePath -> Parsec.Parsec String () DepMkFile
50 parseDepMkFile root = do
51 _ <- Parsec.string root *> Parsec.optional (Parsec.char '/')
52 stage <- parseStage
53 _ <- Parsec.char '/'
54 pkgPath <- Parsec.manyTill Parsec.anyChar
55 (Parsec.try $ Parsec.string "/.dependencies.mk")
56 return (DepMkFile stage pkgPath)
57
58 getDepMkFile :: FilePath -> FilePath -> Action DepMkFile
59 getDepMkFile root = parsePath (parseDepMkFile root) "<dependencies file>"
60
61 depMkFileContext :: DepMkFile -> Action Context
62 depMkFileContext (DepMkFile stage pkgpath) = do
63 pkg <- getPackageByPath pkgpath
64 return (Context stage pkg vanilla)