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.

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

src/Hadrian/Haskell/Cabal/Parse.hs

@@ -54,21 +54,23 @@ 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
                        -- "-main-is" ghc-arguments! See Cabal's
                        -- 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

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