Lookup main-is C sources in hs-source-dirs

In the 2decb0e refactor we stopped
looking for non-Haskell `main-is` files in the hs-source-dirs and other
appropriate directories. This commit fixes that oversight.

Even if it is not intuitive that main-is-C-sources are searched in the
hs-source-dirs, we don't wish to break users relying on this behaviour
as there does not exist that strong of a motivation to do so.

Fixes haskell#10168

Co-authored-by: sheaf <[email protected]>

Author: 2 people

Cabal/src/Distribution/Simple/GHC/Build.hs

@@ -12,11 +12,14 @@ import Distribution.Simple.Flag (Flag)
 import Distribution.Simple.GHC.Build.ExtraSources
 import Distribution.Simple.GHC.Build.Link
 import Distribution.Simple.GHC.Build.Modules
+import Distribution.Simple.GHC.Build.Utils (isHaskell)
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Program.Builtin (ghcProgram)
 import Distribution.Simple.Program.Db (requireProgram)
 import Distribution.Simple.Utils
+
 import Distribution.Types.ComponentLocalBuildInfo
+import Distribution.Types.PackageName.Magic (fakePackageId)
 import Distribution.Types.ParStrat
 import Distribution.Utils.NubList (fromNubListR)
 import Distribution.Utils.Path
@@ -114,8 +117,18 @@ build numJobs pkg_descr pbci = do
   -- We need a separate build and link phase, and C sources must be compiled
   -- after Haskell modules, because C sources may depend on stub headers
   -- generated from compiling Haskell modules (#842, #3294).
-  buildOpts <- buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir (wantedLibWays isIndef) pbci
-  extraSources <- buildAllExtraSources ghcProg buildTargetDir wantedWays pbci
+  (mbMainFile, inputModules) <- componentInputs buildTargetDir pkg_descr pbci
+  let (hsMainFile, nonHsMainFile) =
+        case mbMainFile of
+          Just mainFile
+            | PD.package pkg_descr == fakePackageId
+                || isHaskell (getSymbolicPath mainFile) ->
+                (Just mainFile, Nothing)
+            | otherwise ->
+                (Nothing, Just mainFile)
+          Nothing -> (Nothing, Nothing)
+  buildOpts <- buildHaskellModules numJobs ghcProg hsMainFile inputModules buildTargetDir (wantedLibWays isIndef) pbci
+  extraSources <- buildAllExtraSources nonHsMainFile ghcProg buildTargetDir wantedWays pbci
   linkOrLoadComponent
     ghcProg
     pkg_descr

Cabal/src/Distribution/Simple/GHC/Build/ExtraSources.hs

@@ -25,14 +25,15 @@ import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Program.Types
 import Distribution.System (Arch (JavaScript), Platform (..))
 import Distribution.Types.ComponentLocalBuildInfo
-import Distribution.Types.Executable
 import Distribution.Utils.Path
 import Distribution.Verbosity (Verbosity)
 
 -- | An action that builds all the extra build sources of a component, i.e. C,
 -- C++, Js, Asm, C-- sources.
 buildAllExtraSources
-  :: ConfiguredProgram
+  :: Maybe (SymbolicPath Pkg File)
+  -- ^ An optional non-Haskell Main file
+  -> ConfiguredProgram
   -- ^ The GHC configured program
   -> SymbolicPath Pkg (Dir Artifacts)
   -- ^ The build directory for this target
@@ -56,7 +57,9 @@ buildCSources
   , buildJsSources
   , buildAsmSources
   , buildCmmSources
-    :: ConfiguredProgram
+    :: Maybe (SymbolicPath Pkg File)
+    -- ^ An optional non-Haskell Main file
+    -> ConfiguredProgram
     -- ^ The GHC configured program
     -> SymbolicPath Pkg (Dir Artifacts)
     -- ^ The build directory for this target
@@ -66,37 +69,33 @@ buildCSources
     -- ^ The context and component being built in it.
     -> IO (NubListR (SymbolicPath Pkg File))
     -- ^ Returns the list of extra sources that were built
-buildCSources =
+buildCSources mbMainFile =
   buildExtraSources
     "C Sources"
     Internal.componentCcGhcOptions
     ( \c -> do
         let cFiles = cSources (componentBuildInfo c)
         case c of
-          CExe exe
-            | let mainPath = getSymbolicPath $ modulePath exe
-            , isC mainPath ->
-                cFiles ++ [makeSymbolicPath mainPath]
-          -- NB: Main.hs is relative to hs-source-dirs, but Main.c
-          -- is relative to the package.
+          CExe{}
+            | Just main <- mbMainFile
+            , isC $ getSymbolicPath main ->
+                cFiles ++ [main]
           _otherwise -> cFiles
     )
-buildCxxSources =
+buildCxxSources mbMainFile =
   buildExtraSources
     "C++ Sources"
     Internal.componentCxxGhcOptions
     ( \c -> do
         let cxxFiles = cxxSources (componentBuildInfo c)
         case c of
-          CExe exe
-            | let mainPath = getSymbolicPath $ modulePath exe
-            , isCxx mainPath ->
-                do cxxFiles ++ [makeSymbolicPath mainPath]
-          -- NB: Main.hs is relative to hs-source-dirs, but Main.c++
-          -- is relative to the package.
+          CExe{}
+            | Just main <- mbMainFile
+            , isCxx $ getSymbolicPath main ->
+                cxxFiles ++ [main]
           _otherwise -> cxxFiles
     )
-buildJsSources ghcProg buildTargetDir neededWays = do
+buildJsSources _mbMainFile ghcProg buildTargetDir neededWays = do
   Platform hostArch _ <- hostPlatform <$> localBuildInfo
   let hasJsSupport = hostArch == JavaScript
   buildExtraSources
@@ -114,12 +113,12 @@ buildJsSources ghcProg buildTargetDir neededWays = do
     ghcProg
     buildTargetDir
     neededWays
-buildAsmSources =
+buildAsmSources _mbMainFile =
   buildExtraSources
     "Assembler Sources"
     Internal.componentAsmGhcOptions
     (asmSources . componentBuildInfo)
-buildCmmSources =
+buildCmmSources _mbMainFile =
   buildExtraSources
     "C-- Sources"
     Internal.componentCmmGhcOptions

Cabal/src/Distribution/Simple/GHC/Build/Modules.hs

@@ -5,7 +5,12 @@
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TupleSections #-}
 
-module Distribution.Simple.GHC.Build.Modules (buildHaskellModules, BuildWay (..), buildWayPrefix) where
+module Distribution.Simple.GHC.Build.Modules
+  ( buildHaskellModules
+  , BuildWay (..)
+  , buildWayPrefix
+  , componentInputs
+  ) where
 
 import Control.Monad.IO.Class
 import Distribution.Compat.Prelude
@@ -98,8 +103,10 @@ buildHaskellModules
   -- ^ The parallelism strategy (e.g. num of jobs)
   -> ConfiguredProgram
   -- ^ The GHC configured program
-  -> PD.PackageDescription
-  -- ^ The package description
+  -> Maybe (SymbolicPath Pkg File)
+  -- ^ Optional path to a Haskell Main file to build
+  -> [ModuleName]
+  -- ^ The Haskell modules to build
   -> SymbolicPath Pkg ('Dir Artifacts)
   -- ^ The path to the build directory for this target, which
   -- has already been created.
@@ -112,7 +119,7 @@ buildHaskellModules
   -- invocation used to compile the component in that 'BuildWay'.
   -- This can be useful in, eg, a linker invocation, in which we want to use the
   -- same options and list the same inputs as those used for building.
-buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir neededLibWays pbci = do
+buildHaskellModules numJobs ghcProg mbMainFile inputModules buildTargetDir neededLibWays pbci = do
   -- See Note [Building Haskell Modules accounting for TH]
 
   let
@@ -141,13 +148,14 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir neededLibWays pbci
         | isCoverageEnabled = Flag $ Hpc.mixDir (coerceSymbolicPath $ coerceSymbolicPath buildTargetDir </> extraCompilationArtifacts) way
         | otherwise = mempty
 
-  (inputFiles, inputModules) <- componentInputs buildTargetDir pkg_descr pbci
-
   let
     mbWorkDir = mbWorkDirLBI lbi
     runGhcProg = runGHC verbosity ghcProg comp platform mbWorkDir
     platform = hostPlatform lbi
 
+    (hsMains, scriptMains) =
+      partition (isHaskell . getSymbolicPath) (maybeToList mbMainFile)
+
     -- We define the base opts which are shared across different build ways in
     -- 'buildHaskellModules'
     baseOpts way =
@@ -161,16 +169,8 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir neededLibWays pbci
             ghcOptNoLink = if isLib then NoFlag else toFlag True
           , ghcOptNumJobs = numJobs
           , ghcOptInputModules = toNubListR inputModules
-          , ghcOptInputFiles =
-              toNubListR $
-                if PD.package pkg_descr == fakePackageId
-                  then filter (isHaskell . getSymbolicPath) inputFiles
-                  else inputFiles
-          , ghcOptInputScripts =
-              toNubListR $
-                if PD.package pkg_descr == fakePackageId
-                  then filter (not . isHaskell . getSymbolicPath) inputFiles
-                  else []
+          , ghcOptInputFiles = toNubListR hsMains
+          , ghcOptInputScripts = toNubListR scriptMains
           , ghcOptExtra = buildWayExtraHcOptions way GHC bi
           , ghcOptHiSuffix = optSuffixFlag (buildWayPrefix way) "hi"
           , ghcOptObjSuffix = optSuffixFlag (buildWayPrefix way) "o"
@@ -248,7 +248,7 @@ buildHaskellModules numJobs ghcProg pkg_descr buildTargetDir neededLibWays pbci
       ProfDynWay -> profDynOpts
 
   -- If there aren't modules, or if we're loading the modules in repl, don't build.
-  unless (forRepl || (null inputFiles && null inputModules)) $ liftIO $ do
+  unless (forRepl || (isNothing mbMainFile && null inputModules)) $ liftIO $ do
     -- See Note [Building Haskell Modules accounting for TH]
     let
       neededLibWaysSet = Set.fromList neededLibWays
@@ -348,25 +348,26 @@ buildWayExtraHcOptions = \case
   DynWay -> hcSharedOptions
   ProfDynWay -> hcProfSharedOptions
 
--- | Returns a pair of the Haskell input files and Haskell modules of the
--- component being built.
+-- | Returns a pair of the main file and Haskell modules of the component being
+-- built. The main file is not necessarily a Haskell file. It could also be
+-- e.g. a C source, or, a Haskell repl script (that does not necessarily have
+-- an extension).
 --
--- The "input files" are either the path to the main Haskell module, or a repl
--- script (that does not necessarily have an extension).
+-- The main file is Nothing if the component is not executable.
 componentInputs
   :: SymbolicPath Pkg (Dir Artifacts)
   -- ^ Target build dir
   -> PD.PackageDescription
   -> PreBuildComponentInputs
   -- ^ The context and component being built in it.
-  -> IO ([SymbolicPath Pkg File], [ModuleName])
-  -- ^ The Haskell input files, and the Haskell modules
+  -> IO (Maybe (SymbolicPath Pkg File), [ModuleName])
+  -- ^ The main input file, and the Haskell modules
 componentInputs buildTargetDir pkg_descr pbci =
   case component of
     CLib lib ->
-      pure ([], allLibModules lib clbi)
+      pure (Nothing, allLibModules lib clbi)
     CFLib flib ->
-      pure ([], foreignLibModules flib)
+      pure (Nothing, foreignLibModules flib)
     CExe Executable{buildInfo = bi', modulePath} ->
       exeLikeInputs bi' modulePath
     CTest TestSuite{testBuildInfo = bi', testInterface = TestSuiteExeV10 _ mainFile} ->
@@ -405,6 +406,6 @@ componentInputs buildTargetDir pkg_descr pbci =
                 "Enabling workaround for Main module '"
                   ++ prettyShow mainModName
                   ++ "' listed in 'other-modules' illegally!"
-              return ([main], filter (/= mainModName) otherModNames)
-            else return ([main], otherModNames)
-        else return ([], otherModNames)
+              return (Just main, filter (/= mainModName) otherModNames)
+            else return (Just main, otherModNames)
+        else return (Just main, otherModNames)

Cabal/src/Distribution/Simple/GHC/Build/Utils.hs

@@ -31,7 +31,7 @@ import System.FilePath
   )
 
 -- | Find the path to the entry point of an executable (typically specified in
--- @main-is@, and found in @hs-source-dirs@).
+-- @main-is@, and found in @hs-source-dirs@ -- yes, even when @main-is@ is not a Haskell file).
 findExecutableMain
   :: Verbosity
   -> Maybe (SymbolicPath CWD (Dir Pkg))

cabal-testsuite/PackageTests/CMain/10168/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

cabal-testsuite/PackageTests/CMain/10168/app/Main.hs

@@ -0,0 +1,6 @@
+module Main ( main ) where
+
+import Lib ( myMax )
+
+main :: IO ()
+main = print $ myMax 10 100

cabal-testsuite/PackageTests/CMain/10168/c-app/main.c

@@ -0,0 +1,12 @@
+#include <stdio.h>
+#include <HsFFI.h>
+#ifdef __GLASGOW_HASKELL__
+#include "Lib_stub.h"
+#endif
+
+int main(int argc, char *argv[]) {
+  hs_init(&argc, &argv);
+  printf("%lld\n", myMax(10,100));
+  hs_exit();
+  return 0;
+}

cabal-testsuite/PackageTests/CMain/10168/haskell-c-tests.cabal

@@ -0,0 +1,27 @@
+cabal-version: 2.0
+
+name:           haskell-c-tests
+version:        0.1.0.0
+build-type:     Simple
+
+library
+  exposed-modules: Lib
+  hs-source-dirs: src
+  ghc-options: -stubdir autogen-stubs
+  build-depends: base
+  default-language: Haskell2010
+
+executable c-exe
+  main-is: main.c
+  hs-source-dirs: c-app
+  ghc-options: -no-hs-main
+  include-dirs: autogen-stubs
+  build-depends: base, haskell-c-tests
+  default-language: Haskell2010
+
+executable haskell-exe
+  main-is: Main.hs
+  hs-source-dirs: app
+  ghc-options: -threaded -rtsopts -with-rtsopts=-N
+  build-depends: base, haskell-c-tests
+  default-language: Haskell2010

cabal-testsuite/PackageTests/CMain/10168/setup.out

@@ -0,0 +1,10 @@
+# Setup configure
+Configuring haskell-c-tests-0.1.0.0...
+Warning: [unknown-directory] 'include-dirs: autogen-stubs' specifies a directory which does not exist.
+# Setup build
+Preprocessing library for haskell-c-tests-0.1.0.0...
+Building library for haskell-c-tests-0.1.0.0...
+Preprocessing executable 'c-exe' for haskell-c-tests-0.1.0.0...
+Building executable 'c-exe' for haskell-c-tests-0.1.0.0...
+Preprocessing executable 'haskell-exe' for haskell-c-tests-0.1.0.0...
+Building executable 'haskell-exe' for haskell-c-tests-0.1.0.0...

cabal-testsuite/PackageTests/CMain/10168/setup.test.hs

@@ -0,0 +1,7 @@
+import Test.Cabal.Prelude
+-- Test building an executable whose main-is is a C source found in the hs-source-dirs.
+-- It is a bit counter intuitive that we look for non-haskell sources in
+-- `hs-source-dirs`, but that is a behaviour that users rely on (see #10168)
+-- and there's no good reason to break it.
+main = setupTest $ do
+  setup_build []

cabal-testsuite/PackageTests/CMain/10168/src/Lib.hs

@@ -0,0 +1,6 @@
+module Lib ( myMax ) where
+
+myMax :: Int -> Int -> Int
+myMax x1 x2 = if x1 > x2 then x1 else x2
+
+foreign export ccall myMax :: Int -> Int -> Int