Skip to content

Commit

Permalink
Check for duplicate local package names
Browse files Browse the repository at this point in the history
  • Loading branch information
snoyberg committed Aug 25, 2015
1 parent a110470 commit bf21a7a
Show file tree
Hide file tree
Showing 3 changed files with 27 additions and 2 deletions.
1 change: 1 addition & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -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:

Expand Down
17 changes: 15 additions & 2 deletions src/Stack/Build/Source.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)
Expand All @@ -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 =
Expand Down
11 changes: 11 additions & 0 deletions src/Stack/Types/Build.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit bf21a7a

Please sign in to comment.