Make use of new targets code for stack ghci/ide

src/Stack/Build/Source.hs

@@ -255,7 +255,8 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do
                 , lptbBenches = benches
                 }
     mbuildCache <- tryGetBuildCache $ lpvRoot lpv
-    files <- getPackageFiles (packageFiles pkg) AllFiles (lpvCabalFP lpv)
+    (componentFiles,extraFiles) <- getPackageFiles (packageFiles pkg) (lpvCabalFP lpv)
+    let files = mconcat (M.elems componentFiles) <> extraFiles
     (isDirty, newBuildCache) <- checkBuildCache
         (fromMaybe Map.empty mbuildCache)
         (map toFilePath $ Set.toList files)

src/Stack/Ghci.hs

@@ -7,13 +7,14 @@
 
 -- | Run a GHCi configured with the user's project(s).
 
-module Stack.Ghci where
+module Stack.Ghci (GhciOpts(..),GhciPkgInfo(..), ghciSetup, ghci) where
 
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
 import           Control.Monad.Logger
 import           Control.Monad.Reader
-import           Control.Monad.Trans.Control (MonadBaseControl)
+import           Control.Monad.Trans.Resource
+import           Data.Function
 import           Data.List
 import qualified Data.Map.Strict as M
 import           Data.Maybe
@@ -22,26 +23,36 @@ import           Data.Set (Set)
 import qualified Data.Set as S
 import           Data.Text (Text)
 import qualified Data.Text as T
-import           Data.Typeable
 import           Distribution.ModuleName (ModuleName)
 import           Distribution.Text (display)
 import           Network.HTTP.Client.Conduit
 import           Path
-import           Path.IO
+import           Prelude
 import           Stack.Build.Source
+import           Stack.Build.Target
 import           Stack.Constants
 import           Stack.Exec
 import           Stack.Package
 import           Stack.Types
 
+-- | Command-line options for GHC.
 data GhciOpts = GhciOpts
-    {ghciTargets :: [Text]
-    ,ghciArgs :: [String]
-    ,ghciGhcCommand :: FilePath
-    ,ghciNoLoadModules :: Bool
-    ,ghciAdditionalPackages :: [String]
+    {ghciTargets            :: ![Text]
+    ,ghciArgs               :: ![String]
+    ,ghciGhcCommand         :: !FilePath
+    ,ghciNoLoadModules      :: !Bool
+    ,ghciAdditionalPackages :: ![String]
     } deriving (Show,Eq)
 
+-- | Necessary information to load a package or its components.
+data GhciPkgInfo = GhciPkgInfo
+  { ghciPkgName :: PackageName
+  , ghciPkgOpts :: [String]
+  , ghciPkgDir :: Path Abs Dir
+  , ghciPkgModules :: Set ModuleName
+  , ghciPkgFiles :: Set (Path Abs File)
+  }
+
 -- | Launch a GHCi session for the given local project targets with the
 -- given options and configure it with the load paths and extensions
 -- of those targets.
@@ -50,13 +61,15 @@ ghci :: (HasConfig r, HasBuildConfig r, HasHttpManager r,  HasEnvConfig r, Monad
     -> m ()
 ghci GhciOpts{..} = do
     pkgs <- ghciSetup ghciTargets
-    config <- asks getBuildConfig
+    bconfig <- asks getBuildConfig
     let pkgopts = concatMap ghciPkgOpts pkgs
         srcfiles
           | ghciNoLoadModules = []
-          | otherwise = concatMap (map display . S.toList . ghciPkgModules) pkgs
-        odir = ["-odir=" <> toFilePath (objectInterfaceDir config)
-               ,"-hidir=" <> toFilePath (objectInterfaceDir config)]
+          | otherwise =
+              concatMap (map display . S.toList . ghciPkgModules) pkgs
+        odir =
+            [ "-odir=" <> toFilePath (objectInterfaceDir bconfig)
+            , "-hidir=" <> toFilePath (objectInterfaceDir bconfig)]
     $logInfo
         ("Configuring GHCi with the following packages: " <>
          T.intercalate ", " (map (packageNameText . ghciPkgName) pkgs))
@@ -65,74 +78,86 @@ ghci GhciOpts{..} = do
         ghciGhcCommand
         ("--interactive" : odir <> pkgopts <> srcfiles <> ghciArgs)
 
-data GhciPkgInfo = GhciPkgInfo
-  { ghciPkgName :: PackageName
-  , ghciPkgOpts :: [String]
-  , ghciPkgDir :: Path Abs Dir
-  , ghciPkgModules :: Set ModuleName
-  , ghciPkgFiles :: Set (Path Abs File)
-  }
-
+-- | Create a list of infos for each target containing necessary
+-- information to load that package/components.
 ghciSetup
     :: (HasConfig r, HasHttpManager r, HasBuildConfig r, HasEnvConfig r, MonadReader r m, MonadIO m, MonadThrow m, MonadLogger m, MonadCatch m, MonadBaseControl IO m)
     => [Text] -> m [GhciPkgInfo]
-ghciSetup targets = do
+ghciSetup stringTargets = do
+    (_,_,targets) <-
+        parseTargetsFromBuildOpts
+            defaultBuildOpts
+            { boptsTargets = stringTargets
+            }
     econfig <- asks getEnvConfig
-    bconfig <- asks getBuildConfig
-    pwd <- getWorkingDir
     (_,_,_,sourceMap) <- loadSourceMap defaultBuildOpts
     locals <-
         liftM catMaybes $
         forM (M.toList (envConfigPackages econfig)) $
         \(dir,validWanted) ->
              do cabalfp <- getCabalFileName dir
                 name <- parsePackageNameFromFilePath cabalfp
-                if validWanted && wanted pwd cabalfp name
-                    then return (Just (name, cabalfp))
+                if validWanted
+                    then case M.lookup name targets of
+                             Just simpleTargets ->
+                                 return (Just (name, (cabalfp, simpleTargets)))
+                             Nothing -> return Nothing
                     else return Nothing
-    let findTarget x = find ((x ==) . packageNameText . fst) locals
-        unmetTargets = filter (isNothing . findTarget) targets
-    when (not (null unmetTargets)) $ throwM (TargetsNotFound unmetTargets)
     forM locals $
-        \(name,cabalfp) ->
-             do let config =
-                        PackageConfig
-                        { packageConfigEnableTests = True
-                        , packageConfigEnableBenchmarks = True
-                        , packageConfigFlags = localFlags mempty bconfig name
-                        , packageConfigGhcVersion = envConfigGhcVersion econfig
-                        , packageConfigPlatform = configPlatform
-                              (getConfig bconfig)
-                        }
-                pkg <- readPackage config cabalfp
-                pkgOpts <-
-                    getPackageOpts (packageOpts pkg) sourceMap (map fst locals) cabalfp
-                modules <- getPackageModules (packageModules pkg) cabalfp
-                moduleFiles <- getPackageFiles (packageFiles pkg) Modules cabalfp
-                return
-                    GhciPkgInfo
-                    { ghciPkgName = packageName pkg
-                    , ghciPkgOpts = filter (not . badForGhci) pkgOpts
-                    , ghciPkgDir = parent cabalfp
-                    , ghciPkgModules = modules
-                    , ghciPkgFiles = moduleFiles
-                    }
-  where
-    wanted pwd cabalfp name = isInWantedList || targetsEmptyAndInDir
-      where
-        isInWantedList = elem (packageNameText name) targets
-        targetsEmptyAndInDir = null targets || isParentOf (parent cabalfp) pwd
-    badForGhci :: String -> Bool
-    badForGhci x =
-        isPrefixOf "-O" x || elem x (words "-debug -threaded -ticky")
-
-data GhciSetupException =
-    TargetsNotFound [Text]
-    deriving Typeable
+        \(name,(cabalfp,components)) ->
+             makeGhciPkgInfo sourceMap (map fst locals) name cabalfp components
 
-instance Exception GhciSetupException
-instance Show GhciSetupException where
-    show (TargetsNotFound targets) = unlines
-        [ "Couldn't find targets: " ++ T.unpack (T.unwords targets)
-        , "(expecting package names)"
-        ]
+-- | Make information necessary to load the given package in GHCi.
+makeGhciPkgInfo
+    :: (MonadReader r m, HasEnvConfig r, MonadLogger m, MonadIO m, MonadCatch m)
+    => SourceMap
+    -> [PackageName]
+    -> PackageName
+    -> Path Abs File
+    -> SimpleTarget
+    -> m GhciPkgInfo
+makeGhciPkgInfo sourceMap locals name cabalfp components = do
+    econfig <- asks getEnvConfig
+    bconfig <- asks getBuildConfig
+    let config =
+            PackageConfig
+            { packageConfigEnableTests = True
+            , packageConfigEnableBenchmarks = True
+            , packageConfigFlags = localFlags mempty bconfig name
+            , packageConfigGhcVersion = envConfigGhcVersion econfig
+            , packageConfigPlatform = configPlatform (getConfig bconfig)
+            }
+    pkg <- readPackage config cabalfp
+    (componentsOpts,generalOpts) <-
+        getPackageOpts
+            (packageOpts pkg)
+            sourceMap
+            locals
+            cabalfp
+    componentsModules <- getPackageModules (packageModules pkg) cabalfp
+    (componentModFiles,generalFiles) <-
+        getPackageFiles (packageFiles pkg) cabalfp
+    let filterWithinWantedComponents m =
+            M.elems
+                (M.filterWithKey
+                     (\k _ ->
+                           case components of
+                               STLocalComps cs -> S.member k cs
+                               _ -> True)
+                     m)
+    return
+        GhciPkgInfo
+        { ghciPkgName = packageName pkg
+        , ghciPkgOpts = filter
+              (not . badForGhci)
+              (generalOpts <>
+               concat (filterWithinWantedComponents componentsOpts))
+        , ghciPkgDir = parent cabalfp
+        , ghciPkgModules = mconcat
+              (filterWithinWantedComponents componentsModules)
+        , ghciPkgFiles = generalFiles <>
+          mconcat (filterWithinWantedComponents componentModFiles)
+        }
+  where badForGhci :: String -> Bool
+        badForGhci x =
+            isPrefixOf "-O" x || elem x (words "-debug -threaded -ticky")