[commit: hadrian] master: Read the `main-is` field from the cabal file for executables (#627) (f319243)
git at git.haskell.org
git at git.haskell.org
Thu Jul 26 21:36:14 UTC 2018
Repository : ssh://git@git.haskell.org/hadrian
On branch : master
Link : http://git.haskell.org/hadrian.git/commitdiff/f3192439950ba3a3af58410c331d2492322dd4ab
>---------------------------------------------------------------
commit f3192439950ba3a3af58410c331d2492322dd4ab
Author: Tao He <sighingnow at gmail.com>
Date: Mon Jun 18 22:53:38 2018 +0800
Read the `main-is` field from the cabal file for executables (#627)
* For executables, we should read the `main-is` field from the cabal file.
Previously, we simply treat file name for `Main` module as `Main.hs` to
build executable. That doesn't work for the `timeout` program. This patch
fixes the problem.
* Add comments about the processing of `main-is` field from .cabal file.
>---------------------------------------------------------------
f3192439950ba3a3af58410c331d2492322dd4ab
src/Hadrian/Haskell/Cabal/PackageData.hs | 1 +
src/Hadrian/Haskell/Cabal/Parse.hs | 19 ++++++++++++-------
src/Oracles/ModuleFiles.hs | 26 ++++++++++++++++++++++++--
3 files changed, 37 insertions(+), 9 deletions(-)
diff --git a/src/Hadrian/Haskell/Cabal/PackageData.hs b/src/Hadrian/Haskell/Cabal/PackageData.hs
index d4cd41a..d54809e 100644
--- a/src/Hadrian/Haskell/Cabal/PackageData.hs
+++ b/src/Hadrian/Haskell/Cabal/PackageData.hs
@@ -10,6 +10,7 @@ data PackageData = PackageData
, name :: PackageName
, version :: String
, componentId :: String
+ , mainIs :: Maybe (String, FilePath) -- ("Main", filepath)
, modules :: [String]
, otherModules :: [String]
, synopsis :: String
diff --git a/src/Hadrian/Haskell/Cabal/Parse.hs b/src/Hadrian/Haskell/Cabal/Parse.hs
index 9e6b875..1f54035 100644
--- a/src/Hadrian/Haskell/Cabal/Parse.hs
+++ b/src/Hadrian/Haskell/Cabal/Parse.hs
@@ -54,13 +54,13 @@ import Settings
parseCabalPkgId :: FilePath -> IO String
parseCabalPkgId file = C.display . C.package . C.packageDescription <$> C.readGenericPackageDescription C.silent file
-biModules :: C.PackageDescription -> (C.BuildInfo, [C.ModuleName])
-biModules pd = go [ comp | comp@(bi,_) <-
+biModules :: C.PackageDescription -> (C.BuildInfo, [C.ModuleName], Maybe (C.ModuleName, String))
+biModules pd = go [ comp | comp@(bi,_,_) <-
(map libBiModules . maybeToList $ C.library pd) ++
(map exeBiModules $ C.executables pd)
, C.buildable bi ]
where
- libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib)
+ libBiModules lib = (C.libBuildInfo lib, C.explicitLibModules lib, Nothing)
exeBiModules exe = (C.buildInfo exe,
-- If "main-is: ..." is not a .hs or .lhs file, do not
-- inject "Main" into the modules. This does not respect
@@ -68,7 +68,9 @@ biModules pd = go [ comp | comp@(bi,_) <-
-- Distribution.Simple.GHC for the glory details.
if takeExtension (C.modulePath exe) `elem` [".hs", ".lhs"]
then C.main : C.exeModules exe
- else C.exeModules exe)
+ -- The module `Main` still need to be kept in `modules` of PD.
+ else C.exeModules exe,
+ Just (C.main, C.modulePath exe))
go [] = error "No buildable component found."
go [x] = x
go _ = error "Cannot handle more than one buildinfo yet."
@@ -243,15 +245,18 @@ parsePackageData context at Context {..} = do
-- there. So we filter out gcc-lib from the RTS's library-dirs here.
_ -> error "No (or multiple) GHC rts package is registered!"
- buildInfo = fst (biModules pd')
+ (buildInfo, modules, mainIs) = biModules pd'
in return $ PackageData
{ dependencies = deps
, name = C.unPackageName . C.pkgName . C.package $ pd'
, version = C.display . C.pkgVersion . C.package $ pd'
, componentId = C.localCompatPackageKey lbi'
- , modules = map C.display . snd . biModules $ pd'
- , otherModules = map C.display . C.otherModules $ buildInfo
+ , mainIs = case mainIs of
+ Just (mod, filepath) -> Just (C.display mod, filepath)
+ Nothing -> Nothing
+ , modules = map C.display $ modules
+ , otherModules = map C.display . C.otherModules $ buildInfo
, synopsis = C.synopsis pd'
, description = C.description pd'
, srcDirs = C.hsSourceDirs buildInfo
diff --git a/src/Oracles/ModuleFiles.hs b/src/Oracles/ModuleFiles.hs
index fc3d72e..f167de0 100644
--- a/src/Oracles/ModuleFiles.hs
+++ b/src/Oracles/ModuleFiles.hs
@@ -124,10 +124,15 @@ moduleFilesOracle = void $ do
void . addOracle $ \(ModuleFiles (stage, package)) -> do
let context = vanillaContext stage package
srcDirs <- interpretInContext context (getPackageData PD.srcDirs)
+ mainIs <- interpretInContext context (getPackageData PD.mainIs)
+ let removeMain = case mainIs of
+ Just (mod, _) -> delete mod
+ Nothing -> id
modules <- fmap sort $ interpretInContext context (getPackageData PD.modules)
autogen <- autogenPath context
let dirs = autogen : map (pkgPath package -/-) srcDirs
- modDirFiles = groupSort $ map decodeModule modules
+ -- Don't resolve the file path for module `Main` twice.
+ modDirFiles = groupSort $ map decodeModule $ removeMain modules
result <- concatForM dirs $ \dir -> do
todo <- filterM (doesDirectoryExist . (dir -/-) . fst) modDirFiles
forM todo $ \(mDir, mFiles) -> do
@@ -136,7 +141,24 @@ moduleFilesOracle = void $ do
let cmp f = compare (dropExtension f)
found = intersectOrd cmp files mFiles
return (map (fullDir -/-) found, mDir)
- let pairs = sort [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]
+
+ -- For a BuildInfo, it may be a library, which deosn't have the `Main`
+ -- module, or an executable, which must have the `Main` module and the
+ -- file path of `Main` module is indicated by the `main-is` field in it's
+ -- .cabal file.
+ --
+ -- For `Main` module, the file name may not be `Main.hs`, unlike other
+ -- exposed modules. We could get the file path by the module name for
+ -- other exposed modules, but for `Main`, we must resolve the file path
+ -- via the `main-is` field in the .cabal file.
+ mainpairs <- case mainIs of
+ Just (mod, filepath) ->
+ concatForM dirs $ \dir -> do
+ found <- doesFileExist (dir -/- filepath)
+ return [(mod, unifyPath $ dir -/- filepath) | found]
+ Nothing -> return []
+
+ let pairs = sort $ mainpairs ++ [ (encodeModule d f, f) | (fs, d) <- result, f <- fs ]
multi = [ (m, f1, f2) | (m, f1):(n, f2):_ <- tails pairs, m == n ]
unless (null multi) $ do
let (m, f1, f2) = head multi
More information about the ghc-commits
mailing list