Add support for non-library packages.
[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 isLibrary :: Package -> Bool
36 isLibrary pkg = programPath Stage0 pkg == Nothing
37
38 -- Find all Haskell source files for the current target. TODO: simplify.
39 getPackageSources :: Expr [FilePath]
40 getPackageSources = do
41 path <- getTargetPath
42 packagePath <- getPackagePath
43 srcDirs <- getPkgDataList SrcDirs
44
45 let buildPath = path -/- "build"
46 autogen = buildPath -/- "autogen"
47 dirs = autogen : map (packagePath -/-) srcDirs
48
49 (foundSources, missingSources) <- findModuleFiles dirs "*hs"
50
51 -- Generated source files live in buildPath and have extension "hs"...
52 let generatedSources = [ buildPath -/- s <.> "hs" | s <- missingSources ]
53 -- ...except that GHC/Prim.hs lives in autogen. TODO: fix?
54 fixGhcPrim = replaceEq (buildPath -/- "GHC/Prim.hs") (autogen -/- "GHC/Prim.hs")
55
56 return $ foundSources ++ fixGhcPrim generatedSources
57
58 -- findModuleFiles scans a list of given directories and finds files matching a
59 -- given extension pattern (e.g., "*hs") that correspond to modules of the
60 -- currently built package. Missing module files are returned in a separate
61 -- list. The returned pair contains the following:
62 -- * a list of found module files, with paths being relative to one of given
63 -- directories, e.g. "codeGen/CodeGen/Platform.hs" for the compiler package.
64 -- * a list of module files that have not been found, with paths being relative
65 -- to the module directory, e.g. "CodeGen/Platform", and with no extension.
66 findModuleFiles :: [FilePath] -> FilePattern -> Expr ([FilePath], [FilePath])
67 findModuleFiles dirs extension = do
68 modules <- getPkgDataList Modules
69 let decodedMods = sort . map decodeModule $ modules
70 modDirFiles = map (bimap head sort . unzip)
71 . groupBy ((==) `on` fst) $ decodedMods
72 matchExtension = (?==) ("*" <.> extension)
73
74 result <- lift . fmap concat . forM dirs $ \dir -> do
75 todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
76 forM todo $ \(mDir, mFiles) -> do
77 let fullDir = dir -/- mDir
78 files <- fmap (filter matchExtension) $ getDirectoryContents fullDir
79 let cmp fe f = compare (dropExtension fe) f
80 found = intersectOrd cmp files mFiles
81 return (map (fullDir -/-) found, (mDir, map dropExtension found))
82
83 let foundFiles = concatMap fst result
84 foundMods = [ (d, f) | (d, fs) <- map snd result, f <- fs ]
85 missingMods = decodedMods `minusOrd` sort foundMods
86 missingFiles = map (uncurry (-/-)) missingMods
87
88 return (foundFiles, missingFiles)