Clean up.
[hadrian.git] / src / Settings.hs
1 module Settings (
2 module Settings.Packages,
3 module Settings.TargetDirectory,
4 module Settings.User,
5 module Settings.Ways,
6 getPkgData, getPkgDataList, programPath, isLibrary,
7 getPackagePath, getTargetDirectory, getTargetPath, getPackageSources,
8 ) where
9
10 import Expression
11 import Oracles
12 import Settings.Packages
13 import Settings.TargetDirectory
14 import Settings.User
15 import Settings.Ways
16
17 getPackagePath :: Expr FilePath
18 getPackagePath = liftM pkgPath getPackage
19
20 getTargetDirectory :: Expr FilePath
21 getTargetDirectory = liftM2 targetDirectory getStage getPackage
22
23 getTargetPath :: Expr FilePath
24 getTargetPath = liftM2 targetPath getStage getPackage
25
26 getPkgData :: (FilePath -> PackageData) -> Expr String
27 getPkgData key = lift . pkgData . key =<< getTargetPath
28
29 getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
30 getPkgDataList key = lift . pkgDataList . key =<< getTargetPath
31
32 programPath :: Stage -> Package -> Maybe FilePath
33 programPath = userProgramPath
34
35 -- Find all Haskell source files for the current target. TODO: simplify.
36 getPackageSources :: Expr [FilePath]
37 getPackageSources = do
38 path <- getTargetPath
39 packagePath <- getPackagePath
40 srcDirs <- getPkgDataList SrcDirs
41
42 let buildPath = path -/- "build"
43 autogen = buildPath -/- "autogen"
44 dirs = autogen : map (packagePath -/-) srcDirs
45
46 (foundSources, missingSources) <- findModuleFiles dirs "*hs"
47
48 -- Generated source files live in buildPath and have extension "hs"...
49 let generatedSources = [ buildPath -/- s <.> "hs" | s <- missingSources ]
50 -- ...except that GHC/Prim.hs lives in autogen. TODO: fix?
51 fixGhcPrim = replaceEq (buildPath -/- "GHC/Prim.hs") (autogen -/- "GHC/Prim.hs")
52
53 return $ foundSources ++ fixGhcPrim generatedSources
54
55 -- findModuleFiles scans a list of given directories and finds files matching a
56 -- given pattern (e.g., "*hs") that correspond to modules of the currently built
57 -- package. Missing module files are returned in a separate list. The returned
58 -- pair contains the following:
59 -- * a list of found module files, with paths being relative to one of given
60 -- directories, e.g. "codeGen/CodeGen/Platform.hs" for the compiler package.
61 -- * a list of module files that have not been found, with paths being relative
62 -- to the module directory, e.g. "CodeGen/Platform", and with no extension.
63 findModuleFiles :: [FilePath] -> FilePattern -> Expr ([FilePath], [FilePath])
64 findModuleFiles dirs pattern = do
65 modules <- getPkgDataList Modules
66 let decodedMods = sort . map decodeModule $ modules
67 modDirFiles = map (bimap head sort . unzip)
68 . groupBy ((==) `on` fst) $ decodedMods
69
70 result <- lift . fmap concat . forM dirs $ \dir -> do
71 todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
72 forM todo $ \(mDir, mFiles) -> do
73 let fullDir = dir -/- mDir
74 files <- getDirectoryFiles fullDir [pattern]
75 let cmp fe f = compare (dropExtension fe) f
76 found = intersectOrd cmp files mFiles
77 return (map (fullDir -/-) found, (mDir, map dropExtension found))
78
79 let foundFiles = concatMap fst result
80 foundMods = [ (d, f) | (d, fs) <- map snd result, f <- fs ]
81 missingMods = decodedMods `minusOrd` sort foundMods
82 missingFiles = map (uncurry (-/-)) missingMods
83
84 return (foundFiles, missingFiles)