Skip to content

Commit 35fd052

Browse files
sjakobisjakobi
committed
Warn if there are several executables with the same name
...in a multi-package project because any of them could be the one that ends up being used by `stack exec` or locally installed. Fixes commercialhaskell#1198.
1 parent 345ccc9 commit 35fd052

9 files changed

Lines changed: 174 additions & 0 deletions

File tree

‎src/Stack/Build.hs‎

Lines changed: 87 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,8 +29,10 @@ import Data.Aeson (Value (Object, Array), (.=), object)
2929
import Data.Function
3030
import qualified Data.HashMap.Strict as HM
3131
import Data.IORef.RunOnce (runOnce)
32+
import Data.List ((\\))
3233
import qualified Data.Map as Map
3334
import Data.Map.Strict (Map)
35+
import Data.Monoid
3436
import Data.Set (Set)
3537
import qualified Data.Set as Set
3638
import Data.Text (Text)
@@ -106,6 +108,8 @@ build setLocalFiles mbuildLk bopts = fixCodePage' $ do
106108
liftIO $ unlockFile lk
107109
_ -> return ()
108110

111+
warnIfExecutablesWithSameNameCouldBeOverwritten locals plan
112+
109113
when (boptsPreFetch bopts) $
110114
preFetch plan
111115

@@ -128,6 +132,89 @@ allLocal =
128132
Map.elems .
129133
planTasks
130134

135+
-- | See https://github.com/commercialhaskell/stack/issues/1198.
136+
warnIfExecutablesWithSameNameCouldBeOverwritten
137+
:: MonadLogger m => [LocalPackage] -> Plan -> m ()
138+
warnIfExecutablesWithSameNameCouldBeOverwritten locals plan =
139+
forM_ (Map.toList warnings) $ \(exe,(toBuild,otherLocals)) -> do
140+
let exe_s
141+
| length toBuild > 1 = "several executables with the same name:"
142+
| otherwise = "executable"
143+
exesText pkgs =
144+
T.intercalate
145+
", "
146+
["'" <> packageNameText p <> ":" <> exe <> "'" | p <- pkgs]
147+
($logWarn . T.unlines . concat)
148+
[ [ "Building " <> exe_s <> " " <> exesText toBuild <> "." ]
149+
, [ "Only one of them will be available via 'stack exec' or locally installed."
150+
| length toBuild > 1
151+
]
152+
, [ "Other executables with the same name might be overwritten: " <>
153+
exesText otherLocals <> "."
154+
| not (null otherLocals)
155+
]
156+
]
157+
where
158+
-- Cases of several local packages having executables with the same name.
159+
-- The Map entries have the following form:
160+
--
161+
-- executable name: ( package names for executables that are being built
162+
-- , package names for other local packages that have an
163+
-- executable with the same name
164+
-- )
165+
warnings :: Map Text ([PackageName],[PackageName])
166+
warnings =
167+
Map.mergeWithKey
168+
(\_exeName pkgsToBuild localPkgs ->
169+
case (pkgsToBuild,localPkgs \\ pkgsToBuild) of
170+
([],_) ->
171+
-- Can't happen because exesToBuild has only non-empty values.
172+
error $
173+
"warnIfExecutablesWithSameNameCouldBeOverwritten/warnings: " ++
174+
"empty value in exesToBuild"
175+
([_],[]) ->
176+
-- We want to build only a single executable called _exeName
177+
-- and there are no other local packages with an executable
178+
-- of that name. Nothing to warn about, ignore.
179+
Nothing
180+
(_,otherLocals) ->
181+
-- We could be here for two reasons (or their combination):
182+
-- 1) We are building two or more executables called _exeName
183+
-- that will end up overwriting each other.
184+
-- 2) There's at least one other local executable called _exeName
185+
-- that we aren't currently building and that might be
186+
-- overwritten.
187+
-- Both cases warrant a warning.
188+
Just (pkgsToBuild,otherLocals))
189+
(const Map.empty)
190+
(const Map.empty)
191+
exesToBuild
192+
localExes
193+
exesToBuild :: Map Text [PackageName]
194+
exesToBuild =
195+
Map.fromListWith
196+
(++)
197+
[ (exe,[pkgName])
198+
| (pkgName,task) <- Map.toList (planTasks plan)
199+
, isLocal task
200+
, exe <- (Set.toList . exeComponents . lpComponents . taskLP) task
201+
]
202+
where
203+
isLocal Task{taskType = (TTLocal _)} = True
204+
isLocal _ = False
205+
taskLP Task{taskType = (TTLocal lp)} = lp
206+
taskLP _ = error "warnIfExecutablesWithSameNameCouldBeOverwritten/taskLP: task isn't local"
207+
localExes :: Map Text [PackageName]
208+
localExes =
209+
Map.fromListWith
210+
(++)
211+
[(exe,[pkgName]) | (pkgName,exes) <- pkgExePairs, exe <- exes]
212+
where
213+
pkgExePairs =
214+
[ (packageName,Set.toList packageExes)
215+
| Package{..} <- map lpPackage locals
216+
]
217+
131218
-- | Get the @BaseConfigOpts@ necessary for constructing configure options
132219
mkBaseConfigOpts :: (MonadIO m, MonadReader env m, HasEnvConfig env, MonadThrow m)
133220
=> BuildOpts -> m BaseConfigOpts

‎test/integration/lib/StackTest.hs‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,16 @@ stackErr args = do
4141
then error "stack was supposed to fail, but didn't"
4242
else return ()
4343

44+
-- | Run stack with arguments and apply a check to the resulting
45+
-- stderr output if the process succeeded.
46+
stackCheckStderr :: [String] -> (String -> IO ()) -> IO ()
47+
stackCheckStderr args check = do
48+
stack <- getEnv "STACK_EXE"
49+
(ec, _, stderr) <- readProcessWithExitCode stack args ""
50+
if ec /= ExitSuccess
51+
then error $ "Exited with exit code: " ++ show ec
52+
else check stderr
53+
4454
doesNotExist :: FilePath -> IO ()
4555
doesNotExist fp = do
4656
logInfo $ "doesNotExist " ++ fp

‎test/integration/tests/1198-multiple-exes-with-same-name/Main.hs‎

Lines changed: 32 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,32 @@
1+
import Control.Monad (unless,when)
2+
import Data.List (isInfixOf)
3+
import StackTest
4+
5+
main :: IO ()
6+
main = do
7+
stack ["clean"]
8+
stack ["init", "--force"]
9+
stackCheckStderr
10+
["build", "also-has-exe-foo", "has-exe-foo"]
11+
(expectMessage buildMessage1)
12+
stackCheckStderr
13+
["build", "has-exe-foo-too"]
14+
(expectMessage buildMessage2)
15+
16+
expectMessage :: String -> String -> IO ()
17+
expectMessage msg stderr =
18+
unless (msg `isInfixOf` stderr)
19+
(error $ "Expected a warning: \n" ++ show msg)
20+
21+
buildMessage1 =
22+
unlines
23+
[ "Building several executables with the same name: 'has-exe-foo:foo', 'also-has-exe-foo:foo'."
24+
, "Only one of them will be available via 'stack exec' or locally installed."
25+
, "Other executables with the same name might be overwritten: 'has-exe-foo-too:foo'."
26+
]
27+
28+
buildMessage2 =
29+
unlines
30+
[ "Building executable 'has-exe-foo-too:foo'."
31+
, "Other executables with the same name might be overwritten: 'has-exe-foo:foo', 'also-has-exe-foo:foo'."
32+
]

‎test/integration/tests/1198-multiple-exes-with-same-name/files/also-has-exe-foo/also-has-exe-foo.cabal‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
name: also-has-exe-foo
2+
version: 0.1.0.0
3+
build-type: Simple
4+
cabal-version: >=1.10
5+
6+
executable foo
7+
hs-source-dirs: app
8+
main-is: Main.hs
9+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
10+
build-depends: base
11+
default-language: Haskell2010

‎test/integration/tests/1198-multiple-exes-with-same-name/files/also-has-exe-foo/app/Main.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module Main where
2+
3+
main :: IO ()
4+
main = putStrLn "This is foo from also-has-exe-foo"

‎test/integration/tests/1198-multiple-exes-with-same-name/files/app/Main.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module Main where
2+
3+
main :: IO ()
4+
main = putStrLn "This is foo from has-exe-foo"

‎test/integration/tests/1198-multiple-exes-with-same-name/files/has-exe-foo-too/app/Main.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
module Main where
2+
3+
main :: IO ()
4+
main = putStrLn "This is foo from has-exe-foo-too"

‎test/integration/tests/1198-multiple-exes-with-same-name/files/has-exe-foo-too/has-exe-foo-too.cabal‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
name: has-exe-foo-too
2+
version: 0.1.0.0
3+
build-type: Simple
4+
cabal-version: >=1.10
5+
6+
executable foo
7+
hs-source-dirs: app
8+
main-is: Main.hs
9+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
10+
build-depends: base
11+
default-language: Haskell2010

‎test/integration/tests/1198-multiple-exes-with-same-name/files/has-exe-foo.cabal‎

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
name: has-exe-foo
2+
version: 0.1.0.0
3+
build-type: Simple
4+
cabal-version: >=1.10
5+
6+
executable foo
7+
hs-source-dirs: app
8+
main-is: Main.hs
9+
ghc-options: -threaded -rtsopts -with-rtsopts=-N
10+
build-depends: base
11+
default-language: Haskell2010

0 commit comments

Comments
 (0)