Drop redundant newCache.
[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.Paths
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 dropPkgPath = drop $ length (pkgPath pkg) + 1
27 srcDirs <- fmap sort . pkgDataList $ SrcDirs path
28 modules <- fmap sort . pkgDataList $ Modules path
29 let dirs = [ pkgPath pkg -/- dir | dir <- srcDirs ]
30 foundSrcDirs <- askOracle $ ModuleFilesKey (modules, dirs )
31 foundAutogen <- askOracle $ ModuleFilesKey (modules, [autogen])
32
33 let found = foundSrcDirs ++ foundAutogen
34 missingMods = modules `minusOrd` (sort $ map fst found)
35 otherFileToMod = replaceEq '/' '.' . dropExtension . dropPkgPath
36 (haskellFiles, otherFiles) = partition ("//*hs" ?==) (map snd found)
37
38 return (haskellFiles, missingMods ++ map otherFileToMod otherFiles)
39
40 moduleFilesOracle :: Rules ()
41 moduleFilesOracle = void $
42 addOracle $ \(ModuleFilesKey (modules, dirs)) -> do
43 let decodedPairs = map decodeModule modules
44 modDirFiles = map (bimap head sort . unzip)
45 . groupBy ((==) `on` fst) $ decodedPairs
46
47 result <- fmap concat . forM dirs $ \dir -> do
48 todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
49 forM todo $ \(mDir, mFiles) -> do
50 let fullDir = dir -/- mDir
51 files <- getDirectoryFiles fullDir ["*"]
52 let noBoot = filter (not . (isSuffixOf "-boot")) files
53 cmp fe f = compare (dropExtension fe) f
54 found = intersectOrd cmp noBoot mFiles
55 return (map (fullDir -/-) found, mDir)
56
57 return $ sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]