Warn about missing extra-deps #1521

Author: mgsloan

ChangeLog.md

@@ -70,6 +70,8 @@ Other enhancements:
   [#2727](https://github.com/commercialhaskell/stack/issues/2727)
   * `--color` option added to override auto-detection of ANSI support
   [#2725](https://github.com/commercialhaskell/stack/issues/2725)
+  * Missing extra-deps are now warned about, adding a degree of typo detection
+  [#1521](https://github.com/commercialhaskell/stack/issues/1521)
 
 Bug fixes:
 

src/Stack/Build.hs

@@ -36,9 +36,11 @@ import           Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as Map
 import           Data.Map.Strict (Map)
+import           Data.Maybe (catMaybes)
 import           Data.Monoid
 import           Data.Set (Set)
 import qualified Data.Set as Set
+import           Data.String
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Data.Text.Encoding (decodeUtf8)
@@ -58,6 +60,8 @@ import           Stack.Build.Target
 import           Stack.Fetch as Fetch
 import           Stack.GhcPkg
 import           Stack.Package
+import           Stack.PackageIndex
+import           Stack.PrettyPrint
 import           Stack.Types.Build
 import           Stack.Types.Config
 import           Stack.Types.FlagName
@@ -92,7 +96,7 @@ build setLocalFiles mbuildLk boptsCli = fixCodePage $ do
     let profiling = boptsLibProfile bopts || boptsExeProfile bopts
     menv <- getMinimalEnvOverride
 
-    (targets, mbp, locals, extraToBuild, sourceMap) <- loadSourceMap NeedTargets boptsCli
+    (targets, mbp, locals, extraToBuild, extraDeps, sourceMap) <- loadSourceMapFull NeedTargets boptsCli
 
     -- Set local files, necessary for file watching
     stackYaml <- asks $ bcStackYaml . getBuildConfig
@@ -108,6 +112,8 @@ build setLocalFiles mbuildLk boptsCli = fixCodePage $ do
                          , getInstalledHaddock   = shouldHaddockDeps bopts }
                      sourceMap
 
+    warnMissingExtraDeps installedMap extraDeps
+
     baseConfigOpts <- mkBaseConfigOpts boptsCli
     plan <- withLoadPackage menv $ \loadPackage ->
         constructPlan mbp baseConfigOpts locals extraToBuild localDumpPkgs loadPackage sourceMap installedMap
@@ -164,6 +170,25 @@ data CabalVersionException = CabalVersionException { unCabalVersionException ::
 instance Show CabalVersionException where show = unCabalVersionException
 instance Exception CabalVersionException
 
+warnMissingExtraDeps
+    :: (StackM env m, HasConfig env)
+    => InstalledMap -> Map PackageName Version -> m ()
+warnMissingExtraDeps installed extraDeps = do
+    missingExtraDeps <-
+        fmap catMaybes $ forM (Map.toList extraDeps) $ \(n, v) ->
+            if Map.member n installed
+                then return Nothing
+                else do
+                    vs <- getPackageVersions n
+                    if Set.null vs
+                        then return $ Just $
+                            fromString (packageNameString n ++ "-" ++ versionString v)
+                        else return Nothing
+    when (not (null missingExtraDeps)) $
+        $prettyWarn $
+            "Some extra-deps are neither installed nor in the index:" <> line <>
+            indent 4 (bulletedList missingExtraDeps)
+
 -- | See https://github.com/commercialhaskell/stack/issues/1198.
 warnIfExecutablesWithSameNameCouldBeOverwritten
     :: MonadLogger m => [LocalPackage] -> Plan -> m ()
@@ -378,7 +403,7 @@ queryBuildInfo selectors0 =
 -- | Get the raw build information object
 rawBuildInfo :: (StackM env m, HasEnvConfig env) => m Value
 rawBuildInfo = do
-    (_, _mbp, locals, _extraToBuild, _sourceMap) <- loadSourceMap NeedTargets defaultBuildOptsCLI
+    (locals, _sourceMap) <- loadSourceMap NeedTargets defaultBuildOptsCLI
     return $ object
         [ "locals" .= Object (HM.fromList $ map localToPair locals)
         ]

src/Stack/Build/Source.hs

@@ -10,6 +10,7 @@
 -- Load information on package sources
 module Stack.Build.Source
     ( loadSourceMap
+    , loadSourceMapFull
     , SourceMap
     , PackageSource (..)
     , getLocalFlags
@@ -76,16 +77,29 @@ import              System.FilePath (takeFileName)
 import              System.IO (withBinaryFile, IOMode (ReadMode))
 import              System.IO.Error (isDoesNotExistError)
 
+-- | Like 'loadSourceMapFull', but doesn't return values that aren't as
+-- commonly needed.
 loadSourceMap :: (StackM env m, HasEnvConfig env)
               => NeedTargets
               -> BuildOptsCLI
-              -> m ( Map PackageName SimpleTarget
-                   , MiniBuildPlan
-                   , [LocalPackage]
-                   , Set PackageName -- non-local targets
+              -> m ( [LocalPackage]
                    , SourceMap
                    )
 loadSourceMap needTargets boptsCli = do
+    (_, _, locals, _, _, sourceMap) <- loadSourceMapFull needTargets boptsCli
+    return (locals, sourceMap)
+
+loadSourceMapFull :: (StackM env m, HasEnvConfig env)
+                  => NeedTargets
+                  -> BuildOptsCLI
+                  -> m ( Map PackageName SimpleTarget
+                       , MiniBuildPlan
+                       , [LocalPackage]
+                       , Set PackageName -- non-local targets
+                       , Map PackageName Version -- extra-deps from configuration and cli
+                       , SourceMap
+                       )
+loadSourceMapFull needTargets boptsCli = do
     bconfig <- asks getBuildConfig
     rawLocals <- getLocalPackageViews
     (mbp0, cliExtraDeps, targets) <- parseTargetsFromBuildOptsWith rawLocals needTargets boptsCli
@@ -159,7 +173,7 @@ loadSourceMap needTargets boptsCli = do
                  in PSUpstream (mpiVersion mpi) Snap (mpiFlags mpi) (mpiGhcOptions mpi ++ configOpts) (mpiGitSHA1 mpi)
             ] `Map.difference` Map.fromList (map (, ()) (HashSet.toList wiredInPackages))
 
-    return (targets, mbp, locals, nonLocalTargets, sourceMap)
+    return (targets, mbp, locals, nonLocalTargets, extraDeps0, sourceMap)
 
 -- | All flags for a local package
 getLocalFlags

src/Stack/Dot.hs

@@ -115,7 +115,7 @@ createDependencyGraph :: (StackM env m, HasEnvConfig env, MonadBaseUnlift IO m)
                        => DotOpts
                        -> m (Map PackageName (Set PackageName, DotPayload))
 createDependencyGraph dotOpts = do
-  (_,_,locals,_,sourceMap) <- loadSourceMap NeedTargets defaultBuildOptsCLI
+  (locals,sourceMap) <- loadSourceMap NeedTargets defaultBuildOptsCLI
       { boptsCLITargets = dotTargets dotOpts
       , boptsCLIFlags = dotFlags dotOpts
       }

src/Stack/Ghci.hs

@@ -132,7 +132,7 @@ instance Show GhciException where
 ghci :: (StackM r m, HasEnvConfig r, MonadBaseUnlift IO m) => GhciOpts -> m ()
 ghci opts@GhciOpts{..} = do
     -- Load source map, without explicit targets, to collect all info.
-    (_, _, locals, _, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI
+    (locals, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI
         { boptsCLITargets = [] }
     -- Parse --main-is argument.
     mainIsTargets <- parseMainIsTargets ghciMainIs

src/Stack/PrettyPrint.hs

@@ -17,6 +17,8 @@ module Stack.PrettyPrint
     , errorRed, goodGreen, shellMagenta
     , displayTargetPkgId, displayCurrentPkgId, displayErrorPkgId
     , displayMilliseconds
+      -- * Formatting utils
+    , bulletedList
       -- * Re-exports from "Text.PrettyPrint.Leijen.Extended"
     , Display(..), AnsiDoc, AnsiAnn(..), HasAnsiAnn(..), Doc
     , nest, line, linebreak, group, softline, softbreak
@@ -30,6 +32,7 @@ module Stack.PrettyPrint
 import           Control.Exception.Lifted
 import           Control.Monad.Logger
 import           Control.Monad.Reader
+import           Data.List (intersperse)
 import           Data.Monoid
 import           Data.String (fromString)
 import qualified Data.Text as T
@@ -135,3 +138,6 @@ instance Display (PackageName, NamedComponent) where
 displayMilliseconds :: Clock.TimeSpec -> AnsiDoc
 displayMilliseconds t = goodGreen $
     (fromString . show . (`div` 10^(6 :: Int)) . Clock.toNanoSecs) t <> "ms"
+
+bulletedList :: [AnsiDoc] -> AnsiDoc
+bulletedList = mconcat . intersperse line . map ("*" <+>)

src/Stack/SDist.hs

@@ -132,7 +132,7 @@ getCabalLbs :: (StackM env m, HasEnvConfig env) => PvpBounds -> FilePath -> m L.
 getCabalLbs pvpBounds fp = do
     bs <- liftIO $ S.readFile fp
     (_warnings, gpd) <- readPackageUnresolvedBS Nothing bs
-    (_, _, _, _, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI
+    (_, sourceMap) <- loadSourceMap AllowNoTargets defaultBuildOptsCLI
     menv <- getMinimalEnvOverride
     (installedMap, _, _, _) <- getInstalled menv GetInstalledOpts
                                 { getInstalledProfiling = False
@@ -214,7 +214,7 @@ getSDistFileList lp =
         let bopts = defaultBuildOpts
         let boptsCli = defaultBuildOptsCLI
         baseConfigOpts <- mkBaseConfigOpts boptsCli
-        (_, _mbp, locals, _extraToBuild, _sourceMap) <- loadSourceMap NeedTargets boptsCli
+        (locals, _) <- loadSourceMap NeedTargets boptsCli
         runInBase <- liftBaseWith $ \run -> return (void . run)
         withExecuteEnv menv bopts boptsCli baseConfigOpts locals
             [] [] [] -- provide empty list of globals. This is a hack around custom Setup.hs files