Ignore source files that are used as main when inferring modules

src/Hpack/Config.hs

@@ -1096,6 +1096,19 @@ toExecutableMap name executables mExecutable = do
 
 type GlobalOptions = CommonOptions CSources CxxSources JsSources Empty
 
+executableSectionMainCandidates :: Section ExecutableSection -> [FilePath]
+executableSectionMainCandidates sect = case sectionAll sectionSourceDirs sect of
+  [] -> mains
+  sourceDirs -> [src </> main | main <- mains, src <- sourceDirs]
+  where
+    mains :: [FilePath]
+    mains = concatMap sectionMain sect
+
+    sectionMain :: ExecutableSection -> [FilePath]
+    sectionMain exec = case parseMain <$> executableSectionMain exec of
+      Just (file, []) -> [file]
+      _ -> []
+
 toPackage_ :: MonadIO m => FilePath -> Product GlobalOptions (PackageConfig CSources CxxSources JsSources) -> Warnings m (Package, String)
 toPackage_ dir (Product g PackageConfig{..}) = do
   executableMap <- toExecutableMap packageName_ packageConfigExecutables packageConfigExecutable
@@ -1111,15 +1124,26 @@ toPackage_ dir (Product g PackageConfig{..}) = do
     toSections :: (Monad m, Monoid a) => Maybe (Map String (WithCommonOptions CSources CxxSources JsSources a)) -> Warnings m (Map String (Section a))
     toSections = maybe (return mempty) (traverse toSect)
 
-    toLib = liftIO . toLibrary dir packageName_
-    toExecutables = toSections >=> traverse (liftIO . toExecutable dir packageName_)
+  executableSections <- toSections executableMap
+  testSections <- toSections packageConfigTests
+  benchmarkSections <- toSections packageConfigBenchmarks
+
+  let
+    exclude :: [FilePath]
+    exclude = concatMap (concatMap executableSectionMainCandidates) [executableSections, testSections, benchmarkSections]
+
+    toLib :: MonadIO m => Section LibrarySection -> Warnings m (Section Library)
+    toLib = liftIO . toLibrary dir packageName_ exclude
+
+    toExecutables :: MonadIO m => Map String (Section ExecutableSection) -> Warnings m (Map String (Section Executable))
+    toExecutables = traverse (liftIO . toExecutable dir packageName_ exclude)
 
   mLibrary <- traverse (toSect >=> toLib) packageConfigLibrary
   internalLibraries <- toSections packageConfigInternalLibraries >>= traverse toLib
 
-  executables <- toExecutables executableMap
-  tests <- toExecutables packageConfigTests
-  benchmarks <- toExecutables packageConfigBenchmarks
+  executables <- toExecutables executableSections
+  tests <- toExecutables testSections
+  benchmarks <- toExecutables benchmarkSections
 
   licenseFileExists <- liftIO $ doesFileExist (dir </> "LICENSE")
 
@@ -1292,8 +1316,8 @@ getLibraryModules Library{..} = libraryExposedModules ++ libraryOtherModules
 getExecutableModules :: Executable -> [Module]
 getExecutableModules Executable{..} = executableOtherModules
 
-listModules :: FilePath -> Section a -> IO [Module]
-listModules dir Section{..} = concat <$> mapM (getModules dir) sectionSourceDirs
+listModules :: FilePath -> [FilePath] -> Section a -> IO [Module]
+listModules dir exclude Section{..} = concat <$> mapM (getModules dir exclude) sectionSourceDirs
 
 removeConditionalsThatAreAlwaysFalse :: Section a -> Section a
 removeConditionalsThatAreAlwaysFalse sect = sect {
@@ -1305,29 +1329,30 @@ removeConditionalsThatAreAlwaysFalse sect = sect {
 inferModules ::
      FilePath
   -> String
+  -> [FilePath]
   -> (a -> [Module])
   -> (b -> [Module])
   -> ([Module] -> [Module] -> a -> b)
   -> ([Module] -> a -> b)
   -> Section a
   -> IO (Section b)
-inferModules dir packageName_ getMentionedModules getInferredModules fromData fromConditionals = fmap removeConditionalsThatAreAlwaysFalse . traverseSectionAndConditionals
+inferModules dir packageName_ exclude getMentionedModules getInferredModules fromData fromConditionals = fmap removeConditionalsThatAreAlwaysFalse . traverseSectionAndConditionals
   (fromConfigSection fromData [pathsModuleFromPackageName packageName_])
   (fromConfigSection (\ [] -> fromConditionals) [])
   []
   where
     fromConfigSection fromConfig pathsModule_ outerModules sect@Section{sectionData = conf} = do
-      modules <- listModules dir sect
+      modules <- listModules dir exclude sect
       let
         mentionedModules = concatMap getMentionedModules sect
         inferableModules = (modules \\ outerModules) \\ mentionedModules
         pathsModule = (pathsModule_ \\ outerModules) \\ mentionedModules
         r = fromConfig pathsModule inferableModules conf
       return (outerModules ++ getInferredModules r, r)
 
-toLibrary :: FilePath -> String -> Section LibrarySection -> IO (Section Library)
-toLibrary dir name =
-    inferModules dir name getMentionedLibraryModules getLibraryModules fromLibrarySectionTopLevel fromLibrarySectionInConditional
+toLibrary :: FilePath -> String -> [FilePath] -> Section LibrarySection -> IO (Section Library)
+toLibrary dir name exclude =
+    inferModules dir name exclude getMentionedLibraryModules getLibraryModules fromLibrarySectionTopLevel fromLibrarySectionInConditional
   where
     fromLibrarySectionTopLevel :: [Module] -> [Module] -> LibrarySection -> Library
     fromLibrarySectionTopLevel pathsModule inferableModules LibrarySection{..} =
@@ -1369,9 +1394,9 @@ getMentionedExecutableModules :: ExecutableSection -> [Module]
 getMentionedExecutableModules (ExecutableSection main otherModules generatedModules)=
   maybe id (:) (toModule . Path.fromFilePath <$> main) $ fromMaybeList (otherModules <> generatedModules)
 
-toExecutable :: FilePath -> String -> Section ExecutableSection -> IO (Section Executable)
-toExecutable dir packageName_ =
-    inferModules dir packageName_ getMentionedExecutableModules getExecutableModules fromExecutableSection (fromExecutableSection [])
+toExecutable :: FilePath -> String -> [FilePath] -> Section ExecutableSection -> IO (Section Executable)
+toExecutable dir packageName_ exclude =
+    inferModules dir packageName_ exclude getMentionedExecutableModules getExecutableModules fromExecutableSection (fromExecutableSection [])
   . expandMain
   where
     fromExecutableSection :: [Module] -> [Module] -> ExecutableSection -> Executable

src/Hpack/Module.hs

@@ -11,6 +11,7 @@ module Hpack.Module (
 ) where
 
 import           Data.String
+import           Data.Maybe
 import           System.FilePath
 import qualified System.Directory as Directory
 import           Control.Monad
@@ -40,8 +41,8 @@ toModule path = case reverse $ Path.components path of
   [] -> Module ""
   file : dirs -> Module . intercalate "." . reverse $ dropExtension file : dirs
 
-getModules :: FilePath -> FilePath -> IO [Module]
-getModules dir literalSrc = sortModules <$> do
+getModules :: FilePath -> [FilePath] -> FilePath -> IO [Module]
+getModules dir exclude literalSrc = sortModules <$> do
   exists <- Directory.doesDirectoryExist (dir </> literalSrc)
   if exists
     then do
@@ -59,7 +60,18 @@ getModules dir literalSrc = sortModules <$> do
           | srcIsProjectRoot = filter (/= "Setup")
           | otherwise = id
 
-      toModules <$> getModuleFilesRecursive canonicalSrc
+        stripSrc :: Path -> Maybe Path
+        stripSrc
+          | srcIsProjectRoot = Just
+          | otherwise = Path.stripPrefix (Path.fromFilePath literalSrc)
+
+        excludePaths :: [Path]
+        excludePaths = mapMaybe (stripSrc . Path.fromFilePath) exclude
+
+        shouldExclude :: Path -> Bool
+        shouldExclude = (`elem` excludePaths)
+
+      toModules . filter (not . shouldExclude) <$> getModuleFilesRecursive canonicalSrc
     else return []
 
 sortModules :: [Module] -> [Module]

src/Path.hs

@@ -1,5 +1,6 @@
 module Path where
 
+import qualified Data.List as List
 import           System.FilePath
 import           Data.String
 
@@ -23,3 +24,6 @@ instance IsString Path where
 
 newtype PathComponent = PathComponent {unPathComponent :: String}
   deriving Eq
+
+stripPrefix :: Path -> Path -> Maybe Path
+stripPrefix (Path xs) (Path ys) = Path <$> List.stripPrefix xs ys

test/EndToEndSpec.hs

@@ -1047,6 +1047,144 @@ spec = around_ (inTempDirectoryNamed "foo") $ do
         |]) {packageCabalVersion = "3.0"}
 
     context "when inferring modules" $ do
+      context "with source files that are used as `main`" $ do
+        let rendersTo :: HasCallStack => String -> Package -> Expectation
+            rendersTo = shouldRenderTo_ (removeDefaultLanguage . removePathsModule)
+
+        it "ignores these source files" $ do
+          touch "src/Main.hs"
+          touch "src/A.hs"
+          touch "src/B.hs"
+          [i|
+          library:
+            source-dirs: src
+          executable:
+            main: src/Main.hs
+          |] `rendersTo` package [i|
+          library
+            exposed-modules:
+                A
+                B
+            hs-source-dirs:
+                src
+          executable foo
+            main-is: src/Main.hs
+          |]
+
+        context "with source-dirs" $ do
+          it "takes these source-dirs into account when ignoring source files" $ do
+            touch "test/Doctest.hs"
+            touch "test/Spec.hs"
+            touch "test/Spec/FooSpec.hs"
+            [i|
+            source-dirs: test
+            tests:
+              doctest:
+                main: Doctest.hs
+              spec:
+                main: Spec.hs
+            |] `rendersTo` package [i|
+            test-suite doctest
+              type: exitcode-stdio-1.0
+              main-is: Doctest.hs
+              hs-source-dirs:
+                  test
+              other-modules:
+                  Spec.FooSpec
+                  Paths_foo
+            test-suite spec
+              type: exitcode-stdio-1.0
+              main-is: Spec.hs
+              hs-source-dirs:
+                  test
+              other-modules:
+                  Spec.FooSpec
+                  Paths_foo
+            |]
+
+        context "with `main` inside conditionals" $ do
+          it "ignores these source files" $ do
+            touch "src/Foo.hs"
+            touch "src/Windows.hs"
+            touch "src/Linux.hs"
+            [i|
+            library:
+              source-dirs: src
+            executable:
+              when:
+                condition: os(windows)
+                then:
+                  main: src/Windows.hs
+                else:
+                  main: src/Linux.hs
+            |] `rendersTo` package [i|
+            library
+              hs-source-dirs:
+                  src
+              exposed-modules:
+                  Foo
+            executable foo
+              if os(windows)
+                main-is: src/Windows.hs
+              else
+                main-is: src/Linux.hs
+            |]
+
+        context "with source-dirs inside conditionals" $ do
+          it "takes these source-dirs into account when ignoring source files" $ do
+            touch "src/Foo.hs"
+            touch "src/windows/Foo.hs"
+            touch "src/linux/Foo.hs"
+            [i|
+            library:
+              source-dirs: src
+
+            executable:
+              main: src/Foo.hs
+              when:
+                condition: os(windows)
+                then:
+                  source-dirs: windows
+                else:
+                  source-dirs: linux
+            |] `rendersTo` package [i|
+            library
+              hs-source-dirs:
+                  src
+              exposed-modules:
+                  Foo
+            executable foo
+              main-is: src/Foo.hs
+              if os(windows)
+                hs-source-dirs:
+                    windows
+              else
+                hs-source-dirs:
+                    linux
+            |]
+
+        context "when `main` is a custom entry point" $ do
+          it "does not ignore these source files" $ do
+            touch "src/Foo.x"
+            touch "src/Foo.hs"
+            [i|
+            source-dirs: src
+            library: {}
+            executable:
+              main: Foo.x
+            |] `rendersTo` package [i|
+            library
+              exposed-modules:
+                  Foo
+              hs-source-dirs:
+                  src
+            executable foo
+              hs-source-dirs:
+                  src
+              main-is: Foo.hs
+              ghc-options: -main-is Foo.x
+            |]
+
       context "with a library" $ do
         it "ignores duplicate source directories" $ do
           touch "src/Foo.hs"
@@ -1685,16 +1823,29 @@ instance Show RenderResult where
   show (RenderResult warnings output) = unlines (map ("WARNING: " ++) warnings) ++ output
 
 shouldRenderTo :: HasCallStack => String -> Package -> Expectation
-shouldRenderTo input p = do
+shouldRenderTo = shouldRenderTo_ id
+
+shouldRenderTo_ :: HasCallStack => ([String] -> [String]) -> String -> Package -> Expectation
+shouldRenderTo_ modifyOutput input p = do
   writeFile packageConfig ("name: foo\n" ++ unindent input)
   let currentDirectory = ".working-directory"
   createDirectory currentDirectory
   withCurrentDirectory currentDirectory $ do
     (warnings, output) <- run ".." (".." </> packageConfig) expected
-    RenderResult warnings (dropEmptyLines output) `shouldBe` RenderResult (packageWarnings p) expected
+    RenderResult warnings (mapLines (modifyOutput . dropEmptyLines) output) `shouldBe` RenderResult (packageWarnings p) expected
   where
-    expected = dropEmptyLines (renderPackage p)
-    dropEmptyLines = unlines . filter (not . null) . lines
+    expected = mapLines dropEmptyLines (renderPackage p)
+    dropEmptyLines = filter (not . null)
+    mapLines f = unlines . f . lines
+
+removeDefaultLanguage :: [String] -> [String]
+removeDefaultLanguage = filter (/= "  default-language: Haskell2010")
+
+removePathsModule :: [String] -> [String]
+removePathsModule = \ case
+  "  other-modules:" : "      Paths_foo" : xs -> removePathsModule xs
+  x : xs -> x : removePathsModule xs
+  [] -> []
 
 shouldWarn :: HasCallStack => String -> [String] -> Expectation
 shouldWarn input expected = do

test/Hpack/ModuleSpec.hs

@@ -12,19 +12,32 @@ spec = do
       touch (dir </> "src/Foo.hs")
       touch (dir </> "src/Bar/Baz.hs")
       touch (dir </> "src/Setup.hs")
-      getModules dir "src" >>= (`shouldMatchList` ["Foo", "Bar.Baz", "Setup"])
+      getModules dir [] "src" >>= (`shouldMatchList` ["Foo", "Bar.Baz", "Setup"])
 
     context "when source directory is '.'" $ do
       it "ignores Setup" $ \dir -> do
         touch (dir </> "Foo.hs")
         touch (dir </> "Setup.hs")
-        getModules dir  "." `shouldReturn` ["Foo"]
+        getModules dir  [] "." `shouldReturn` ["Foo"]
 
     context "when source directory is './.'" $ do
       it "ignores Setup" $ \dir -> do
         touch (dir </> "Foo.hs")
         touch (dir </> "Setup.hs")
-        getModules dir  "./." `shouldReturn` ["Foo"]
+        getModules dir  [] "./." `shouldReturn` ["Foo"]
+
+    context "with a list of paths to exclude" $ do
+      it "does not return files in that list" $ \dir -> do
+        touch (dir </> "src/Foo.hs")
+        touch (dir </> "src/Bar.hs")
+        let exclude = ["src/Foo.hs"]
+        getModules dir exclude "src" >>= (`shouldMatchList` ["Bar"])
+
+      it "works for '.'" $ \dir -> do
+        touch (dir </> "Foo.hs")
+        touch (dir </> "Bar.hs")
+        let exclude = ["Foo.hs"]
+        getModules dir exclude "." >>= (`shouldMatchList` ["Bar"])
 
   describe "toModule" $ do
     it "maps a Path to a Module" $ do