[commit: ghc] wip/nfs-locking: Simplify and refactor moduleFiles oracle. (3d9c2fd)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/3d9c2fdaf006a7aada8454295469cc5d8aa23938/ghc

>---------------------------------------------------------------

commit 3d9c2fdaf006a7aada8454295469cc5d8aa23938
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu Feb 25 23:15:18 2016 +0000

    Simplify and refactor moduleFiles oracle.
    
    See #210.


>---------------------------------------------------------------

3d9c2fdaf006a7aada8454295469cc5d8aa23938
 src/Oracles/ModuleFiles.hs | 31 ++++++++++++++++++-------------
 src/Rules/Dependencies.hs  |  3 ++-
 src/Rules/Documentation.hs |  3 ++-
 src/Settings.hs            | 16 +---------------
 4 files changed, 23 insertions(+), 30 deletions(-)

diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs
index cf33e20..4c74265 100644
--- a/src/Oracles/ModuleFiles.hs
+++ b/src/Oracles/ModuleFiles.hs
@@ -1,12 +1,12 @@
 {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, ScopedTypeVariables #-}
 module Oracles.ModuleFiles (
-    moduleFiles, haskellModuleFiles, moduleFilesOracle, findModuleFiles
+    moduleFiles, haskellSources, moduleFilesOracle, findModuleFiles
     ) where
 
 import Base
 import Context
+import Expression
 import Oracles.PackageData
-import Package
 import Settings.Paths
 
 newtype ModuleFilesKey = ModuleFilesKey ([FilePath], [String])
@@ -14,11 +14,12 @@ newtype ModuleFilesKey = ModuleFilesKey ([FilePath], [String])
 
 moduleFiles :: Context -> Action [FilePath]
 moduleFiles context @ Context {..} = do
-    let path = contextPath context
+    let path    = contextPath context
+        autogen = path -/- "build/autogen"
     srcDirs <- fmap sort . pkgDataList $ SrcDirs path
     modules <- fmap sort . pkgDataList $ Modules path
     let dirs = [ pkgPath package -/- dir | dir <- srcDirs ]
-    fmap catMaybes $ findModuleFiles dirs modules
+    catMaybes <$> findModuleFiles (autogen : dirs) modules
 
 haskellModuleFiles :: Context -> Action ([FilePath], [String])
 haskellModuleFiles context @ Context {..} = do
@@ -28,19 +29,23 @@ haskellModuleFiles context @ Context {..} = do
     srcDirs <- fmap sort . pkgDataList $ SrcDirs path
     modules <- fmap sort . pkgDataList $ Modules path
     let dirs = [ pkgPath package -/- dir | dir <- srcDirs ]
-    foundSrcDirs <- findModuleFiles dirs      modules
-    foundAutogen <- findModuleFiles [autogen] modules
-    found <- sequence $ zipWith3 addSources modules foundSrcDirs foundAutogen
-
+    found <- findModuleFiles (autogen : dirs) modules
     let missingMods    = map fst . filter (isNothing . snd) $ zip modules found
         otherFileToMod = replaceEq '/' '.' . dropExtension . dropPkgPath
         (haskellFiles, otherFiles) = partition ("//*hs" ?==) $ catMaybes found
-
     return (haskellFiles, missingMods ++ map otherFileToMod otherFiles)
-  where
-    addSources _ Nothing   r         = return r
-    addSources _ l         Nothing   = return l
-    addSources m (Just f1) (Just f2) = errorMultipleSources m f1 f2
+
+-- | Find all Haskell source files for the current context
+haskellSources :: Context -> Action [FilePath]
+haskellSources context = do
+    let buildPath = contextPath context -/- "build"
+        autogen   = buildPath -/- "autogen"
+    (found, missingMods) <- haskellModuleFiles context
+    -- Generated source files live in buildPath and have extension "hs"...
+    let generated = [ buildPath -/- (replaceEq '.' '/' m) <.> "hs" | m <- missingMods ]
+    -- ...except that GHC/Prim.hs lives in autogen. TODO: fix the inconsistency?
+        fixGhcPrim = replaceEq (buildPath -/- "GHC/Prim.hs") (autogen -/- "GHC/Prim.hs")
+    return $ found ++ fixGhcPrim generated
 
 -- | This is an important oracle whose role is to find and cache module source
 -- files. More specifically, it takes a list of directories @dirs@ and a sorted
diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs
index 16d2c0e..04cffc2 100644
--- a/src/Rules/Dependencies.hs
+++ b/src/Rules/Dependencies.hs
@@ -5,6 +5,7 @@ import Development.Shake.Util (parseMakefile)
 import Base
 import Context
 import Expression
+import Oracles.ModuleFiles
 import Oracles.PackageData
 import Rules.Actions
 import Settings
@@ -27,7 +28,7 @@ buildPackageDependencies rs context @ Context {..} =
                 build $ Target context (GccM stage) [srcFile] [out]
 
         hDepFile %> \out -> do
-            srcs <- interpretInContext context getPackageSources
+            srcs <- haskellSources context
             need srcs
             if srcs == []
             then writeFileChanged out ""
diff --git a/src/Rules/Documentation.hs b/src/Rules/Documentation.hs
index 4e96571..b9407bc 100644
--- a/src/Rules/Documentation.hs
+++ b/src/Rules/Documentation.hs
@@ -4,6 +4,7 @@ import Base
 import Context
 import Expression
 import GHC
+import Oracles.ModuleFiles
 import Oracles.PackageData
 import Rules.Actions
 import Settings
@@ -21,7 +22,7 @@ buildPackageDocumentation context @ Context {..} =
         haddockFile = pkgHaddockFile context
     in when (stage == Stage1) $ do
         haddockFile %> \file -> do
-            srcs <- interpretInContext context getPackageSources
+            srcs <- haskellSources context
             deps <- map PackageName <$> interpretInContext context (getPkgDataList DepNames)
             let haddocks = [ pkgHaddockFile $ vanillaContext Stage1 depPkg
                            | Just depPkg <- map findKnownPackage deps
diff --git a/src/Settings.hs b/src/Settings.hs
index e134fbc..9f52026 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -4,12 +4,11 @@ module Settings (
     module Settings.User,
     module Settings.Ways,
     getPkgData, getPkgDataList, getTopDirectory, isLibrary,
-    getPackagePath, getContextDirectory, getContextPath, getPackageSources
+    getPackagePath, getContextDirectory, getContextPath
     ) where
 
 import Base
 import Expression
-import Oracles.ModuleFiles
 import Oracles.PackageData
 import Oracles.WindowsPath
 import Settings.Packages
@@ -34,16 +33,3 @@ getPkgDataList key = lift . pkgDataList . key =<< getContextPath
 
 getTopDirectory :: Expr FilePath
 getTopDirectory = lift topDirectory
-
--- | Find all Haskell source files for the current target
-getPackageSources :: Expr [FilePath]
-getPackageSources = do
-    context <- getContext
-    let buildPath = contextPath context -/- "build"
-        autogen   = buildPath -/- "autogen"
-    (found, missingMods) <- lift $ haskellModuleFiles context
-    -- Generated source files live in buildPath and have extension "hs"...
-    let generated = [ buildPath -/- (replaceEq '.' '/' m) <.> "hs" | m <- missingMods ]
-    -- ...except that GHC/Prim.hs lives in autogen. TODO: fix the inconsistency?
-        fixGhcPrim = replaceEq (buildPath -/- "GHC/Prim.hs") (autogen -/- "GHC/Prim.hs")
-    return $ found ++ fixGhcPrim generated