Proper build tool loading from Cabal files

Author: snoyberg

src/Stack/Build/ConstructPlan.hs

@@ -30,7 +30,6 @@ import qualified Data.Set as Set
 import qualified Data.Text as T
 import           Data.Text.Encoding (decodeUtf8With)
 import           Data.Text.Encoding.Error (lenientDecode)
-import qualified Distribution.Package as Cabal
 import qualified Distribution.Text as Cabal
 import qualified Distribution.Version as Cabal
 import           Generics.Deriving.Monoid (memptydefault, mappenddefault)
@@ -129,7 +128,7 @@ data Ctx = Ctx
     , baseConfigOpts :: !BaseConfigOpts
     , loadPackage    :: !(PackageLocationIndex FilePath -> Map FlagName Bool -> [Text] -> IO Package)
     , combinedMap    :: !CombinedMap
-    , toolToPackages :: !(Cabal.Dependency -> Map PackageName VersionRange)
+    , toolToPackages :: !(ExeName -> Map PackageName VersionRange)
     , ctxEnvConfig   :: !EnvConfig
     , callStack      :: ![PackageName]
     , extraToBuild   :: !(Set PackageName)
@@ -224,18 +223,18 @@ constructPlan ls0 baseConfigOpts0 locals extraToBuild0 localDumpPkgs loadPackage
         , baseConfigOpts = baseConfigOpts0
         , loadPackage = loadPackage0
         , combinedMap = combineMap sourceMap installedMap
-        , toolToPackages = \(Cabal.Dependency name _) ->
+        , toolToPackages = \name ->
           maybe Map.empty (Map.fromSet (const Cabal.anyVersion)) $
-          Map.lookup (T.pack . packageNameString . fromCabalPackageName $ name) (toolMap lp)
+          Map.lookup name toolMap
         , ctxEnvConfig = econfig
         , callStack = []
         , extraToBuild = extraToBuild0
         , getVersions = getVersions0
         , wanted = wantedLocalPackages locals <> extraToBuild0
         , localNames = Set.fromList $ map (packageName . lpPackage) locals
         }
-
-    toolMap = getToolMap ls0
+      where
+        toolMap = getToolMap ls0 lp
 
 -- | State to be maintained during the calculation of local packages
 -- to unregister.
@@ -795,51 +794,36 @@ packageDepsWithTools p = do
     ctx <- ask
     -- TODO: it would be cool to defer these warnings until there's an
     -- actual issue building the package.
-    let toEither (Cabal.Dependency (Cabal.unPackageName -> name) _) mp =
+    let toEither name mp =
             case Map.toList mp of
-                [] -> Left (NoToolFound name (packageName p))
                 [_] -> Right mp
-                xs -> Left (AmbiguousToolsFound name (packageName p) (map fst xs))
+                xs -> Left (ToolWarning name (packageName p) (map fst xs))
         (warnings0, toolDeps) =
              partitionEithers $
-             map (\dep -> toEither dep (toolToPackages ctx dep)) (packageTools p)
+             map (\dep -> toEither dep (toolToPackages ctx dep)) (Map.keys (packageTools p))
     -- Check whether the tool is on the PATH before warning about it.
-    warnings <- fmap catMaybes $ forM warnings0 $ \warning -> do
-        let toolName = case warning of
-                NoToolFound tool _ -> tool
-                AmbiguousToolsFound tool _ _ -> tool
+    warnings <- fmap catMaybes $ forM warnings0 $ \warning@(ToolWarning (ExeName toolName) _ _) -> do
         config <- view configL
         menv <- liftIO $ configEnvOverride config minimalEnvSettings { esIncludeLocals = True }
-        mfound <- findExecutable menv toolName
+        mfound <- findExecutable menv $ T.unpack toolName
         case mfound of
             Nothing -> return (Just warning)
             Just _ -> return Nothing
     tell mempty { wWarnings = (map toolWarningText warnings ++) }
-    when (any isNoToolFound warnings) $ do
-        let msg = T.unlines
-                [ "Missing build-tools may be caused by dependencies of the build-tool being overridden by extra-deps."
-                , "This should be fixed soon - see this issue https://github.com/commercialhaskell/stack/issues/595"
-                ]
-        tell mempty { wWarnings = (msg:) }
     return $ Map.unionsWith intersectVersionRanges
            $ packageDeps p
            : toolDeps
 
-data ToolWarning
-    = NoToolFound String PackageName
-    | AmbiguousToolsFound String PackageName [PackageName]
-
-isNoToolFound :: ToolWarning -> Bool
-isNoToolFound NoToolFound{} = True
-isNoToolFound _ = False
+data ToolWarning = ToolWarning ExeName PackageName [PackageName]
+  deriving Show
 
 toolWarningText :: ToolWarning -> Text
-toolWarningText (NoToolFound toolName pkgName) =
+toolWarningText (ToolWarning (ExeName toolName) pkgName []) =
     "No packages found in snapshot which provide a " <>
     T.pack (show toolName) <>
     " executable, which is a build-tool dependency of " <>
     T.pack (show (packageNameString pkgName))
-toolWarningText (AmbiguousToolsFound toolName pkgName options) =
+toolWarningText (ToolWarning (ExeName toolName) pkgName options) =
     "Multiple packages found in snapshot which provide a " <>
     T.pack (show toolName) <>
     " exeuctable, which is a build-tool dependency of " <>

src/Stack/BuildPlan.hs

@@ -152,7 +152,7 @@ instance Show BuildPlanException where
 -- both snapshot and local packages (deps and project packages).
 getToolMap :: LoadedSnapshot
            -> LocalPackages
-           -> Map Text (Set PackageName)
+           -> Map ExeName (Set PackageName)
 getToolMap ls locals =
 
     {- We no longer do this, following discussion at:
@@ -171,13 +171,13 @@ getToolMap ls locals =
         ]
   where
     goSnap (pname, lpi) =
-        map (flip Map.singleton (Set.singleton pname) . unExeName)
+        map (flip Map.singleton (Set.singleton pname))
       $ Set.toList
       $ lpiProvidedExes lpi
 
     goLocalProj (pname, lpv) =
         map (flip Map.singleton (Set.singleton pname))
-        [t | CExe t <- Set.toList (lpvComponents lpv)]
+        [ExeName t | CExe t <- Set.toList (lpvComponents lpv)]
 
     goLocalDep (pname, (gpd, _loc)) =
         map (flip Map.singleton (Set.singleton pname))
@@ -186,8 +186,8 @@ getToolMap ls locals =
     -- TODO consider doing buildable checking. Not a big deal though:
     -- worse case scenario is we build an extra package that wasn't
     -- strictly needed.
-    gpdExes :: GenericPackageDescription -> [Text]
-    gpdExes = map (T.pack . C.unUnqualComponentName . fst) . condExecutables
+    gpdExes :: GenericPackageDescription -> [ExeName]
+    gpdExes = map (ExeName . T.pack . C.unUnqualComponentName . fst) . condExecutables
 
 gpdPackages :: [GenericPackageDescription] -> Map PackageName Version
 gpdPackages gpds = Map.fromList $

src/Stack/Package.hs

@@ -65,7 +65,6 @@ import           Distribution.Simple.Utils
 import           Distribution.System (OS (..), Arch, Platform (..))
 import qualified Distribution.Text as D
 import qualified Distribution.Types.CondTree as Cabal
-import qualified Distribution.Types.Dependency as Cabal
 import qualified Distribution.Types.ExeDependency as Cabal
 import qualified Distribution.Types.LegacyExeDependency as Cabal
 import qualified Distribution.Types.UnqualComponentName as Cabal
@@ -83,7 +82,7 @@ import           Stack.Constants.Config
 import           Stack.Prelude
 import           Stack.PrettyPrint
 import           Stack.Types.Build
-import           Stack.Types.BuildPlan (PackageLocationIndex (..), PackageLocation (..))
+import           Stack.Types.BuildPlan (PackageLocationIndex (..), PackageLocation (..), ExeName (..))
 import           Stack.Types.Compiler
 import           Stack.Types.Config
 import           Stack.Types.FlagName
@@ -222,9 +221,7 @@ packageFromPackageDescription packageConfig pkgFlags pkg =
     , packageLicense = license pkg
     , packageDeps = deps
     , packageFiles = pkgFiles
-    , packageTools = map
-        (\(Cabal.ExeDependency name' _ range) -> Cabal.Dependency name' range)
-        (packageDescTools pkg)
+    , packageTools = packageDescTools pkg
     , packageGhcOptions = packageConfigGhcOptions packageConfig
     , packageFlags = packageConfigFlags packageConfig
     , packageDefaultFlags = M.fromList
@@ -544,8 +541,20 @@ packageToolDependencies =
   allBuildInfo
 
 -- | Get all dependencies of the package (buildable targets only).
-packageDescTools :: PackageDescription -> [Cabal.ExeDependency]
-packageDescTools = concatMap buildToolDepends . allBuildInfo
+--
+-- This uses both the new 'buildToolDepends' and old 'buildTools'
+-- information.
+packageDescTools :: PackageDescription -> Map ExeName VersionRange
+packageDescTools =
+  M.fromList . concatMap tools . allBuildInfo
+  where
+    tools bi = map go1 (buildTools bi) ++ map go2 (buildToolDepends bi)
+
+    go1 :: Cabal.LegacyExeDependency -> (ExeName, VersionRange)
+    go1 (Cabal.LegacyExeDependency name range) = (ExeName $ T.pack name, range)
+
+    go2 :: Cabal.ExeDependency -> (ExeName, VersionRange)
+    go2 (Cabal.ExeDependency _pkg name range) = (ExeName $ T.pack $ Cabal.unUnqualComponentName name, range)
 
 -- | Get all files referenced by the package.
 packageDescModulesAndFiles

src/Stack/Types/Package.hs

@@ -21,11 +21,10 @@ import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
 import           Distribution.InstalledPackageInfo (PError)
 import           Distribution.License (License)
 import           Distribution.ModuleName (ModuleName)
-import           Distribution.Package hiding (Package,PackageName,packageName,packageVersion,PackageIdentifier)
 import           Distribution.PackageDescription (TestSuiteInterface, BuildType)
 import           Distribution.System (Platform (..))
 import           Path as FL
-import           Stack.Types.BuildPlan (PackageLocation, PackageLocationIndex (..))
+import           Stack.Types.BuildPlan (PackageLocation, PackageLocationIndex (..), ExeName)
 import           Stack.Types.Compiler
 import           Stack.Types.Config
 import           Stack.Types.FlagName
@@ -77,7 +76,7 @@ data Package =
           ,packageLicense :: !License                     -- ^ The license the package was released under.
           ,packageFiles :: !GetPackageFiles               -- ^ Get all files of the package.
           ,packageDeps :: !(Map PackageName VersionRange) -- ^ Packages that the package depends on.
-          ,packageTools :: ![Dependency]                  -- ^ A build tool name.
+          ,packageTools :: !(Map ExeName VersionRange)    -- ^ A build tool name.
           ,packageAllDeps :: !(Set PackageName)           -- ^ Original dependencies (not sieved).
           ,packageGhcOptions :: ![Text]                   -- ^ Ghc options used on package.
           ,packageFlags :: !(Map FlagName Bool)           -- ^ Flags used on package.