Merge pull request #34 from bgamari/master
[hadrian.git] / src / Oracles / ModuleFiles.hs
1 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
2 module Oracles.ModuleFiles (moduleFiles, haskellModuleFiles, moduleFilesOracle) where
3
4 import Base
5 import Oracles.PackageData
6 import Package
7 import Stage
8 import Settings.TargetDirectory
9
10 newtype ModuleFilesKey = ModuleFilesKey ([String], [FilePath])
11 deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
12
13 moduleFiles :: Stage -> Package -> Action [FilePath]
14 moduleFiles stage pkg = do
15 let path = targetPath stage pkg
16 srcDirs <- fmap sort . pkgDataList $ SrcDirs path
17 modules <- fmap sort . pkgDataList $ Modules path
18 let dirs = [ pkgPath pkg -/- dir | dir <- srcDirs ]
19 found :: [(String, FilePath)] <- askOracle $ ModuleFilesKey (modules, dirs)
20 return $ map snd found
21
22 haskellModuleFiles :: Stage -> Package -> Action ([FilePath], [String])
23 haskellModuleFiles stage pkg = do
24 let path = targetPath stage pkg
25 autogen = path -/- "build/autogen"
26 srcDirs <- fmap sort . pkgDataList $ SrcDirs path
27 modules <- fmap sort . pkgDataList $ Modules path
28 let dirs = [ pkgPath pkg -/- dir | dir <- srcDirs ]
29 foundSrcDirs <- askOracle $ ModuleFilesKey (modules, dirs )
30 foundAutogen <- askOracle $ ModuleFilesKey (modules, [autogen])
31
32 let found = foundSrcDirs ++ foundAutogen
33 missingMods = modules `minusOrd` (sort $ map fst found)
34 otherMods = map (replaceEq '/' '.' . dropExtension) otherFiles
35 (haskellFiles, otherFiles) = partition ("//*hs" ?==) (map snd found)
36 return (haskellFiles, missingMods ++ otherMods)
37
38 moduleFilesOracle :: Rules ()
39 moduleFilesOracle = do
40 answer <- newCache $ \(modules, dirs) -> do
41 let decodedPairs = map decodeModule modules
42 modDirFiles = map (bimap head sort . unzip)
43 . groupBy ((==) `on` fst) $ decodedPairs
44
45 result <- fmap concat . forM dirs $ \dir -> do
46 todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
47 forM todo $ \(mDir, mFiles) -> do
48 let fullDir = dir -/- mDir
49 files <- getDirectoryFiles fullDir ["*"]
50 let noBoot = filter (not . (isSuffixOf "-boot")) files
51 cmp fe f = compare (dropExtension fe) f
52 found = intersectOrd cmp noBoot mFiles
53 return (map (fullDir -/-) found, mDir)
54
55 return $ sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]
56
57 _ <- addOracle $ \(ModuleFilesKey query) -> answer query
58 return ()