Commit f3192439 authored by Tao He's avatar Tao He Committed by Andrey Mokhov

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.
parent 831e1ce0
......@@ -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
......
......@@ -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@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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment