From bf21a7ad82e3a40d68b8bc79267a21f822143bec Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Tue, 25 Aug 2015 09:16:01 +0300
Subject: [PATCH] Check for duplicate local package names

---
 ChangeLog.md              |  1 +
 src/Stack/Build/Source.hs | 17 +++++++++++++++--
 src/Stack/Types/Build.hs  | 11 +++++++++++
 3 files changed, 27 insertions(+), 2 deletions(-)

diff --git a/ChangeLog.md b/ChangeLog.md
index e88544909e..a6322eefca 100644
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -18,6 +18,7 @@ Other enhancements:
 * Use a precompiled Setup.hs for simple build types [#801](https://github.com/commercialhaskell/stack/issues/801)
 * Set --enable-tests and --enable-benchmarks optimistically [#805](https://github.com/commercialhaskell/stack/issues/805)
 * `--only-configure` option added [#820](https://github.com/commercialhaskell/stack/issues/820)
+* Check for duplicate local package names
 
 Bug fixes:
 
diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
index 6f27e24692..2fca9a67e7 100644
--- a/src/Stack/Build/Source.hs
+++ b/src/Stack/Build/Source.hs
@@ -222,8 +222,7 @@ getLocalPackageViews :: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfi
                      => m (Map PackageName (LocalPackageView, GenericPackageDescription))
 getLocalPackageViews = do
     econfig <- asks getEnvConfig
-    -- TODO ensure that there are no overlapping package names
-    liftM Map.fromList $ forM (Map.toList $ envConfigPackages econfig) $ \(dir, validWanted) -> do
+    locals <- forM (Map.toList $ envConfigPackages econfig) $ \(dir, validWanted) -> do
         cabalfp <- getCabalFileName dir
         gpkg <- readPackageUnresolved cabalfp
         let cabalID = package $ packageDescription gpkg
@@ -238,6 +237,8 @@ getLocalPackageViews = do
                 , lpvComponents = getNamedComponents gpkg
                 }
         return (name, (lpv, gpkg))
+    checkDuplicateNames locals
+    return $ Map.fromList locals
   where
     getNamedComponents gpkg = Set.fromList $ concat
         [ maybe [] (const [CLib]) (C.condLibrary gpkg)
@@ -248,6 +249,18 @@ getLocalPackageViews = do
       where
         go wrapper f = map (wrapper . T.pack . fst) $ f gpkg
 
+-- | Check if there are any duplicate package names and, if so, throw an
+-- exception.
+checkDuplicateNames :: MonadThrow m => [(PackageName, (LocalPackageView, gpd))] -> m ()
+checkDuplicateNames locals =
+    case filter hasMultiples $ Map.toList $ Map.fromListWith (++) $ map toPair locals of
+        [] -> return ()
+        x -> throwM $ DuplicateLocalPackageNames x
+  where
+    toPair (pn, (lpv, _)) = (pn, [lpvRoot lpv])
+    hasMultiples (_, _:_:_) = True
+    hasMultiples _ = False
+
 splitComponents :: [NamedComponent]
                 -> (Set Text, Set Text, Set Text)
 splitComponents =
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
index f49959a6dc..344897a862 100644
--- a/src/Stack/Types/Build.hs
+++ b/src/Stack/Types/Build.hs
@@ -110,6 +110,7 @@ data StackBuildException
   | NoSetupHsFound (Path Abs Dir)
   | InvalidFlagSpecification (Set UnusedFlags)
   | TargetParseException [Text]
+  | DuplicateLocalPackageNames [(PackageName, [Path Abs Dir])]
   deriving Typeable
 
 data FlagSource = FSCommandLine | FSStackYaml
@@ -293,6 +294,16 @@ instance Show StackBuildException where
         $ "The following errors occurred while parsing the build targets:"
         : map (("- " ++) . T.unpack) errs
 
+    show (DuplicateLocalPackageNames pairs) = concat
+        $ "The same package name is used in multiple local packages\n"
+        : map go pairs
+      where
+        go (name, dirs) = unlines
+            $ ""
+            : (packageNameString name ++ " used in:")
+            : map goDir dirs
+        goDir dir = "- " ++ toFilePath dir
+
 instance Exception StackBuildException
 
 data ConstructPlanException