Fix passing modules to stack-ide

commercialhaskell · Aug 12, 2015 · f7c0a45 · f7c0a45
1 parent 0e0d16e
commit f7c0a45
Show file tree

Hide file tree

Showing 5 changed files with 38 additions and 23 deletions.
diff --git a/src/Stack/Build/Source.hs b/src/Stack/Build/Source.hs
@@ -231,7 +231,7 @@ loadLocalPackage bopts targets (name, (lpv, gpkg)) = do
                 , lptbBenches = benches
                 }
     mbuildCache <- tryGetBuildCache $ lpvRoot lpv
-    files <- getPackageFiles (packageFiles pkg) (lpvCabalFP lpv)
+    files <- getPackageFiles (packageFiles pkg) AllFiles (lpvCabalFP lpv)
     (isDirty, newBuildCache) <- checkBuildCache
         (fromMaybe Map.empty mbuildCache)
         (map toFilePath $ Set.toList files)

diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs
@@ -70,6 +70,7 @@ data GhciPkgInfo = GhciPkgInfo
   , ghciPkgOpts :: [String]
   , ghciPkgDir :: Path Abs Dir
   , ghciPkgModules :: Set ModuleName
+  , ghciPkgFiles :: Set (Path Abs File)
   }
 
 ghciSetup
@@ -107,12 +108,14 @@ ghciSetup targets = do
                 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

diff --git a/src/Stack/Ide.hs b/src/Stack/Ide.hs
@@ -26,7 +26,6 @@ import           Data.Monoid
 import qualified Data.Set as S
 import           Data.Text (Text)
 import qualified Data.Text as T
-import           Distribution.Text (display)
 import           Network.HTTP.Client.Conduit
 import           Path
 import           Path.IO
@@ -69,12 +68,12 @@ ide targets useropts = do
                 return
                     ( ["--dist-dir=" <> toFilePath dist] ++
                       map ("--ghc-option=" ++) (ghciPkgOpts pkg)
-                    , (map display (S.toList (ghciPkgModules pkg)) <>
-                       (mapMaybe
-                            (fmap toFilePath . stripDir pwd)
-                            (if paths_foo_exists
-                                 then [paths_foo]
-                                 else []))))
+                    , mapMaybe
+                          (fmap toFilePath . stripDir pwd)
+                          (S.toList (ghciPkgFiles pkg) <>
+                           if paths_foo_exists
+                               then [paths_foo]
+                               else []))
     localdb <- packageDatabaseLocal
     depsdb <- packageDatabaseDeps
     mpath <- liftIO $ lookupEnv "PATH"

diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
@@ -146,15 +146,16 @@ resolvePackage packageConfig gpkg = Package
     { packageName = name
     , packageVersion = fromCabalVersion (pkgVersion pkgId)
     , packageDeps = deps
-    , packageFiles = GetPackageFiles $ \cabalfp -> do
+    , packageFiles = GetPackageFiles $ \typ cabalfp -> do
         distDir <- distDirFromDir (parent cabalfp)
-        (_,files) <- runReaderT (packageDescModulesAndFiles pkg)
+        (_,files) <- runReaderT (packageDescModulesAndFiles typ pkg)
                                 (cabalfp, buildDir distDir)
-        return $ S.insert cabalfp files
-
+        return $ case typ of
+                   AllFiles -> S.insert cabalfp files
+                   Modules -> files
     , packageModules = GetPackageModules $ \cabalfp -> do
         distDir <- distDirFromDir (parent cabalfp)
-        (modules,_) <- runReaderT (packageDescModulesAndFiles pkg)
+        (modules,_) <- runReaderT (packageDescModulesAndFiles AllFiles pkg)
                                   (cabalfp, buildDir distDir)
         return modules
     , packageTools = packageDescTools pkg
@@ -322,8 +323,8 @@ allBuildInfo' pkg_descr = [ bi | Just lib <- [library pkg_descr]
 -- | Get all files referenced by the package.
 packageDescModulesAndFiles
     :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m, MonadCatch m)
-    => PackageDescription -> m (Set ModuleName,Set (Path Abs File))
-packageDescModulesAndFiles pkg = do
+    => CabalFileType -> PackageDescription -> m (Set ModuleName,Set (Path Abs File))
+packageDescModulesAndFiles typ pkg = do
     libfiles <-
         liftM concat2 (mapM libraryFiles (maybe [] return (library pkg)))
     exefiles <- liftM concat2 (mapM executableFiles (executables pkg))
@@ -340,13 +341,19 @@ packageDescModulesAndFiles pkg = do
     docfiles <- liftM (mempty, ) (resolveGlobFiles (extraDocFiles pkg))
     return
         (concat2
-             [ libfiles
-             , exefiles
-             , dfiles
-             , srcfiles
-             , docfiles
-             , benchfiles
-             , testfiles])
+             (case typ of
+                AllFiles -> [ libfiles
+                            , exefiles
+                            , dfiles
+                            , srcfiles
+                            , docfiles
+                            , benchfiles
+                            , testfiles]
+                Modules -> [ libfiles
+                           , exefiles
+                           , srcfiles
+                           , benchfiles
+                           , testfiles]))
   where
     concat2 :: (Ord a,Ord b) => [(Set a, Set b)] -> (Set a, Set b)
     concat2 = (mconcat *** mconcat) . unzip

diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs
@@ -101,11 +101,17 @@ newtype GetPackageOpts = GetPackageOpts
 instance Show GetPackageOpts where
     show _ = "<GetPackageOpts>"
 
+-- | Files to get for a cabal package.
+data CabalFileType
+    = AllFiles
+    | Modules
+
 -- | Files that the package depends on, relative to package directory.
 -- Argument is the location of the .cabal file
 newtype GetPackageFiles = GetPackageFiles
     { getPackageFiles :: forall m env. (MonadIO m, MonadLogger m, MonadThrow m, MonadCatch m, MonadReader env m, HasPlatform env, HasEnvConfig env)
-                      => Path Abs File
+                      => CabalFileType
+                      -> Path Abs File
                       -> m (Set (Path Abs File))
     }
 instance Show GetPackageFiles where