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