From 6e65345a2779780e62fddb7b0d3fd519a4066d0f Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Fri, 7 Aug 2015 16:31:29 -0700 Subject: [PATCH 1/6] Detect unlisted modules and TH dependent files (#32,#105) --- src/Stack/Build/Execute.hs | 2 +- src/Stack/Package.hs | 184 ++++++++++++++++++++++++++++--------- src/Stack/Types/Package.hs | 2 +- 3 files changed, 144 insertions(+), 44 deletions(-) diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 0473c50066..f8bb5911a7 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -985,4 +985,4 @@ getSetupHs dir = do extraBuildOptions :: M env m => m [String] extraBuildOptions = do hpcIndexDir <- toFilePath . ( dotHpc) <$> hpcRelativeDir - return ["--ghc-options", "-hpcdir " ++ hpcIndexDir] + return ["--ghc-options", "-hpcdir " ++ hpcIndexDir ++ " -ddump-hi -ddump-to-file"] diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index bfe30087e6..a50cef77fc 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -39,7 +39,8 @@ import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Logger (MonadLogger,logWarn) import Control.Monad.Reader -import qualified Data.ByteString as S +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as C8 import Data.Either import Data.Function import Data.List @@ -51,7 +52,7 @@ import Data.Monoid import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8With) +import Data.Text.Encoding (decodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import Distribution.Compiler import Distribution.ModuleName (ModuleName) @@ -61,20 +62,20 @@ import Distribution.PackageDescription hiding (FlagName) import Distribution.PackageDescription.Parse import Distribution.Simple.Utils import Distribution.System (OS (..), Arch, Platform (..)) -import Distribution.Text (display) +import Distribution.Text (display, simpleParse) import Path as FL import Path.Find import Path.IO import Prelude hiding (FilePath) +import Safe (headDef, tailSafe) import Stack.Constants import Stack.Types import qualified Stack.Types.PackageIdentifier -import System.Directory (getDirectoryContents) +import System.Directory (doesFileExist, getDirectoryContents) import System.FilePath (splitExtensions) import qualified System.FilePath as FilePath import System.IO.Error --- | Get the identifier of the package. packageIdentifier :: Package -> Stack.Types.PackageIdentifier.PackageIdentifier packageIdentifier pkg = Stack.Types.PackageIdentifier.PackageIdentifier @@ -86,13 +87,13 @@ readPackageUnresolved :: (MonadIO m, MonadThrow m) => Path Abs File -> m GenericPackageDescription readPackageUnresolved cabalfp = - liftIO (S.readFile (FL.toFilePath cabalfp)) + liftIO (BS.readFile (FL.toFilePath cabalfp)) >>= readPackageUnresolvedBS (Just cabalfp) -- | Read the raw, unresolved package information from a ByteString. readPackageUnresolvedBS :: (MonadThrow m) => Maybe (Path Abs File) - -> S.ByteString + -> BS.ByteString -> m GenericPackageDescription readPackageUnresolvedBS mcabalfp bs = case parsePackageDescription chars of @@ -116,7 +117,7 @@ readPackage packageConfig cabalfp = -- | Reads and exposes the package information, from a ByteString readPackageBS :: (MonadThrow m) => PackageConfig - -> S.ByteString + -> BS.ByteString -> m Package readPackageBS packageConfig bs = resolvePackage packageConfig `liftM` readPackageUnresolvedBS Nothing bs @@ -144,7 +145,9 @@ resolvePackage packageConfig gpkg = Package , packageVersion = fromCabalVersion (pkgVersion pkgId) , packageDeps = deps , packageFiles = GetPackageFiles $ \ty cabalfp -> do - files <- runReaderT (packageDescFiles ty pkg) cabalfp + distDir <- distDirFromDir (parent cabalfp) + files <- runReaderT (packageDescFiles ty pkg) + (cabalfp, buildDir distDir) return $ S.fromList $ case ty of Modules -> files @@ -260,7 +263,15 @@ generateBuildInfoOpts sourceMap mcabalmacros cabalDir distDir locals b = -- | Make the autogen dir. autogenDir :: Path Abs Dir -> Path Abs Dir -autogenDir distDir = distDir $(mkRelDir "build/autogen") +autogenDir distDir = buildDir distDir $(mkRelDir "autogen") + +-- | Make the build dir. +buildDir :: Path Abs Dir -> Path Abs Dir +buildDir distDir = distDir $(mkRelDir "build") + +-- | Make the component-specific subdirectory of the build directory. +getBuildComponentDir :: (MonadThrow m) => String -> m (Path Rel Dir) +getBuildComponentDir name = parseRelDir (name FilePath. (name ++ "-tmp")) -- | Get all dependencies of the package (buildable targets only). packageDependencies :: PackageDescription -> Map PackageName VersionRange @@ -271,7 +282,7 @@ packageDependencies = allBuildInfo' -- | Get all build tool dependencies of the package (buildable targets only). -packageToolDependencies :: PackageDescription -> Map S.ByteString VersionRange +packageToolDependencies :: PackageDescription -> Map BS.ByteString VersionRange packageToolDependencies = M.fromList . concatMap (map (\dep -> ((packageNameByteString $ depName dep),depRange dep)) . @@ -303,7 +314,7 @@ allBuildInfo' pkg_descr = [ bi | Just lib <- [library pkg_descr] -- | Get all files referenced by the package. packageDescFiles - :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File) m, MonadCatch m) + :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m, MonadCatch m) => CabalFileType -> PackageDescription -> m [Path Abs File] packageDescFiles ty pkg = do libfiles <- @@ -333,7 +344,7 @@ packageDescFiles ty pkg = do , testfiles])) -- | Resolve globbing of files (e.g. data files) to absolute paths. -resolveGlobFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File) m,MonadCatch m) +resolveGlobFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m,MonadCatch m) => [String] -> m [Path Abs File] resolveGlobFiles = liftM (catMaybes . concat) . @@ -344,7 +355,7 @@ resolveGlobFiles = then explode name else liftM return (resolveFileOrWarn name) explode name = do - dir <- asks parent + dir <- asks (parent . fst) names <- matchDirFileGlob' (FL.toFilePath dir) @@ -395,13 +406,16 @@ matchDirFileGlob_ dir filepath = case parseFileGlob filepath of matches -> return matches -- | Get all files referenced by the benchmark. -benchmarkFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File) m) +benchmarkFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => CabalFileType -> Benchmark -> m [Path Abs File] benchmarkFiles ty bench = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) - dir <- asks parent + dir <- asks (parent . fst) + let buildComponentDir = getBuildComponentDir (benchmarkName bench) exposed <- - resolveFiles + resolveFilesAndDeps + ty + buildComponentDir (dirs ++ [dir]) (case benchmarkInterface bench of BenchmarkExeV10 _ fp -> @@ -409,7 +423,7 @@ benchmarkFiles ty bench = do BenchmarkUnsupported _ -> []) haskellModuleExts - bfiles <- buildFiles ty dir build + bfiles <- buildFiles ty buildComponentDir dir build case ty of AllFiles -> return (concat [bfiles,exposed]) Modules -> return (concat [bfiles]) @@ -417,13 +431,16 @@ benchmarkFiles ty bench = do build = benchmarkBuildInfo bench -- | Get all files referenced by the test. -testFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File) m) +testFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => CabalFileType -> TestSuite -> m [Path Abs File] testFiles ty test = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) - dir <- asks parent + dir <- asks (parent . fst) + let buildComponentDir = getBuildComponentDir (testName test) exposed <- - resolveFiles + resolveFilesAndDeps + ty + buildComponentDir (dirs ++ [dir]) (case testInterface test of TestSuiteExeV10 _ fp -> @@ -433,7 +450,7 @@ testFiles ty test = do TestSuiteUnsupported _ -> []) haskellModuleExts - bfiles <- buildFiles ty dir build + bfiles <- buildFiles ty buildComponentDir dir build case ty of AllFiles -> return (concat [bfiles,exposed]) Modules -> return (concat [bfiles]) @@ -441,45 +458,52 @@ testFiles ty test = do build = testBuildInfo test -- | Get all files referenced by the executable. -executableFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File) m) +executableFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m) => CabalFileType -> Executable -> m [Path Abs File] executableFiles ty exe = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) - dir <- asks parent + dir <- asks (parent . fst) + let buildComponentDir = getBuildComponentDir (exeName exe) exposed <- - resolveFiles + resolveFilesAndDeps + ty + buildComponentDir (dirs ++ [dir]) [Right (modulePath exe)] haskellModuleExts - bfiles <- buildFiles ty dir build + bfiles <- buildFiles ty buildComponentDir dir build case ty of AllFiles -> return (concat [bfiles,exposed]) Modules -> return (concat [bfiles]) where build = buildInfo exe -- | Get all files referenced by the library. -libraryFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File) m) +libraryFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m) => CabalFileType -> Library -> m [Path Abs File] libraryFiles ty lib = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) - dir <- asks parent - exposed <- resolveFiles + dir <- asks (parent . fst) + exposed <- resolveFilesAndDeps + ty + Nothing (dirs ++ [dir]) (map Left (exposedModules lib)) haskellModuleExts - bfiles <- buildFiles ty dir build + bfiles <- buildFiles ty Nothing dir build case ty of AllFiles -> return (concat [bfiles,exposed]) Modules -> return (concat [bfiles,exposed]) where build = libBuildInfo lib -- | Get all files in a build. -buildFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File) m) - => CabalFileType -> Path Abs Dir -> BuildInfo -> m [Path Abs File] -buildFiles ty dir build = do +buildFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m) + => CabalFileType -> Maybe (Path Rel Dir) -> Path Abs Dir -> BuildInfo -> m [Path Abs File] +buildFiles ty buildComponentDir dir build = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) other <- - resolveFiles + resolveFilesAndDeps + ty + buildComponentDir (dirs ++ [dir]) (map Left (otherModules build)) haskellModuleExts @@ -604,11 +628,87 @@ depName = \(Dependency n _) -> fromCabalPackageName n depRange :: Dependency -> VersionRange depRange = \(Dependency _ r) -> r +-- | Try to resolve the list of base names in the given directory by +-- looking for unique instances of base names applied with the given +-- extensions, plus find any of their module and TemplateHaskell +-- dependencies. +resolveFilesAndDeps + :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) + => CabalFileType + -> Maybe (Path Rel Dir) -- ^ Subdirectory of buildDir where Cabal/GHC writes artifacts + -> [Path Abs Dir] -- ^ Directories to look in. + -> [Either ModuleName String] -- ^ Base names. + -> [Text] -- ^ Extentions. + -> m [Path Abs File] +resolveFilesAndDeps ty buildComponentDir dirs names0 exts = do + (moduleFiles,thFiles) <- loop names0 S.empty + return (S.toList moduleFiles ++ thFiles) + where + loop [] _ = return (S.empty, []) + loop names doneModules0 = do + resolvedFiles <- resolveFiles dirs names exts + pairs <- mapM getDependencies resolvedFiles + let doneModules' = S.union doneModules0 (S.fromList (lefts names)) + moduleDeps = S.unions (map fst pairs) + thDepFiles = concatMap snd pairs + modulesRemaining = S.difference moduleDeps doneModules' + (moduleDepFiles',thDepFiles') <- + loop (map Left (S.toList modulesRemaining)) doneModules' + return + ( S.union (S.fromList resolvedFiles) moduleDepFiles' + , thDepFiles ++ thDepFiles') + getDependencies resolvedFile = do + dir <- asks (parent . fst) + hiDir <- getHIDir + case stripDir dir resolvedFile of + Nothing -> return (S.empty, []) + Just fileRel -> do + let dumpHIPath = + FilePath.replaceExtension + (toFilePath (hiDir fileRel)) + ".dump-hi" + dumpHIExists <- liftIO $ doesFileExist dumpHIPath + if dumpHIExists + then parseDumpHI dumpHIPath + else return (S.empty, []) + parseDumpHI dumpHIPath = do + dir <- asks (parent . fst) + dumpHI <- liftIO $ fmap C8.lines (C8.readFile dumpHIPath) + let startModuleDeps = + dropWhile + (not . ("module dependencies:" `C8.isPrefixOf`)) + dumpHI + moduleDeps = + S.fromList $ + mapMaybe (simpleParse . T.unpack . decodeUtf8) $ + C8.words $ + C8.concat $ + C8.dropWhile (/= ' ') (headDef "" startModuleDeps) : + takeWhile (" " `C8.isPrefixOf`) (tailSafe startModuleDeps) + thDeps = + case ty of + AllFiles -> + mapMaybe + (fmap (dir ) . + parseRelFile . + T.unpack . + decodeUtf8 . + C8.takeWhile (/= '"') . + C8.dropWhile (== '"') . C8.dropWhile (/= '"')) $ + filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI + Modules -> [] + --liftIO $ putStrLn $ "XXX dumpHI " ++ show dumpHIPath ++ "\n XXX moduleDeps=" ++ show moduleDeps ++ "\n XXX thDeps=" ++ show thDeps + return + (moduleDeps, thDeps) + getHIDir = do + bld <- asks snd + return $ maybe bld (bld ) buildComponentDir + -- | Try to resolve the list of base names in the given directory by -- looking for unique instances of base names applied with the given -- extensions. resolveFiles - :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File) m) + :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => [Path Abs Dir] -- ^ Directories to look in. -> [Either ModuleName String] -- ^ Base names. -> [Text] -- ^ Extentions. @@ -619,13 +719,13 @@ resolveFiles dirs names exts = do -- | Find a candidate for the given module-or-filename from the list -- of directories and given extensions. findCandidate - :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File) m) + :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => [Path Abs Dir] -> [Text] -> Either ModuleName String -> m (Maybe (Path Abs File)) findCandidate dirs exts name = do - pkg <- ask >>= parsePackageNameFromFilePath + pkg <- asks fst >>= parsePackageNameFromFilePath candidates <- liftIO makeNameCandidates case candidates of [candidate] -> return (Just candidate) @@ -740,15 +840,15 @@ buildLogPath package' msuffix = do return $ stack $(mkRelDir "logs") fp -- Internal helper to define resolveFileOrWarn and resolveDirOrWarn -resolveOrWarn :: (MonadLogger m, MonadIO m, MonadReader (Path Abs File) m) +resolveOrWarn :: (MonadLogger m, MonadIO m, MonadReader (Path Abs File, Path Abs Dir) m) => Text -> (Path Abs Dir -> String -> m (Maybe a)) -> FilePath.FilePath -> m (Maybe a) resolveOrWarn subject resolver path = do cwd <- getWorkingDir - file <- ask - dir <- asks parent + file <- asks fst + dir <- asks (parent . fst) result <- resolver dir path when (isNothing result) $ $logWarn ("Warning: " <> subject <> " listed in " <> @@ -759,14 +859,14 @@ resolveOrWarn subject resolver path = -- | Resolve the file, if it can't be resolved, warn for the user -- (purely to be helpful). -resolveFileOrWarn :: (MonadThrow m,MonadIO m,MonadLogger m,MonadReader (Path Abs File) m) +resolveFileOrWarn :: (MonadThrow m,MonadIO m,MonadLogger m,MonadReader (Path Abs File, Path Abs Dir) m) => FilePath.FilePath -> m (Maybe (Path Abs File)) resolveFileOrWarn = resolveOrWarn "File" resolveFileMaybe -- | Resolve the directory, if it can't be resolved, warn for the user -- (purely to be helpful). -resolveDirOrWarn :: (MonadThrow m,MonadIO m,MonadLogger m,MonadReader (Path Abs File) m) +resolveDirOrWarn :: (MonadThrow m,MonadIO m,MonadLogger m,MonadReader (Path Abs File, Path Abs Dir) m) => FilePath.FilePath -> m (Maybe (Path Abs Dir)) resolveDirOrWarn = resolveOrWarn "Directory" resolveDirMaybe diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 10acbe45c0..2536df825b 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -100,7 +100,7 @@ instance Show GetPackageOpts where -- | Files that the package depends on, relative to package directory. -- Argument is the location of the .cabal file newtype GetPackageFiles = GetPackageFiles - { getPackageFiles :: forall m. (MonadIO m, MonadLogger m, MonadThrow m, MonadCatch m) + { getPackageFiles :: forall m env. (MonadIO m, MonadLogger m, MonadThrow m, MonadCatch m, MonadReader env m, HasPlatform env, HasEnvConfig env) => CabalFileType -> Path Abs File -> m (Set (Path Abs File)) From 6f84dffc54178a9a6a38b8240dc80eacf60a2085 Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Fri, 7 Aug 2015 21:52:18 -0700 Subject: [PATCH 2/6] Fix TH dependent file detection for absolute paths and special characters (#105) --- src/Stack/Package.hs | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index a50cef77fc..6ca1563b59 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -688,21 +688,24 @@ resolveFilesAndDeps ty buildComponentDir dirs names0 exts = do thDeps = case ty of AllFiles -> + -- The dependent file path is surrounded by quotes but is not escaped. + -- It can be an absolute or relative path. mapMaybe - (fmap (dir ) . - parseRelFile . - T.unpack . - decodeUtf8 . - C8.takeWhile (/= '"') . - C8.dropWhile (== '"') . C8.dropWhile (/= '"')) $ + (parseAbsOrRelFile dir <=< + (fmap T.unpack . + (T.stripSuffix "\"" <=< T.stripPrefix "\"") . + decodeUtf8 . C8.dropWhile (/= '"'))) $ filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI Modules -> [] --liftIO $ putStrLn $ "XXX dumpHI " ++ show dumpHIPath ++ "\n XXX moduleDeps=" ++ show moduleDeps ++ "\n XXX thDeps=" ++ show thDeps - return - (moduleDeps, thDeps) + return (moduleDeps, thDeps) getHIDir = do bld <- asks snd return $ maybe bld (bld ) buildComponentDir + parseAbsOrRelFile dir fp = + case parseRelFile fp of + Just rel -> Just (dir rel) + Nothing -> parseAbsFile fp -- | Try to resolve the list of base names in the given directory by -- looking for unique instances of base names applied with the given From 829f7de1003c77a3de1fe522712359bd881a08ca Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Sat, 8 Aug 2015 10:52:56 -0700 Subject: [PATCH 3/6] Groundwork for warnings about unlisted modules (#32) --- src/Stack/Package.hs | 61 ++++++++++++++++++++++++++------------------ 1 file changed, 36 insertions(+), 25 deletions(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 6ca1563b59..85e9f26c7a 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -270,8 +270,9 @@ buildDir :: Path Abs Dir -> Path Abs Dir buildDir distDir = distDir $(mkRelDir "build") -- | Make the component-specific subdirectory of the build directory. -getBuildComponentDir :: (MonadThrow m) => String -> m (Path Rel Dir) -getBuildComponentDir name = parseRelDir (name FilePath. (name ++ "-tmp")) +getBuildComponentDir :: Maybe String -> Maybe (Path Rel Dir) +getBuildComponentDir Nothing = Nothing +getBuildComponentDir (Just name) = parseRelDir (name FilePath. (name ++ "-tmp")) -- | Get all dependencies of the package (buildable targets only). packageDependencies :: PackageDescription -> Map PackageName VersionRange @@ -411,11 +412,10 @@ benchmarkFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs benchmarkFiles ty bench = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) - let buildComponentDir = getBuildComponentDir (benchmarkName bench) exposed <- resolveFilesAndDeps ty - buildComponentDir + (Just $ benchmarkName bench) (dirs ++ [dir]) (case benchmarkInterface bench of BenchmarkExeV10 _ fp -> @@ -423,7 +423,7 @@ benchmarkFiles ty bench = do BenchmarkUnsupported _ -> []) haskellModuleExts - bfiles <- buildFiles ty buildComponentDir dir build + bfiles <- buildFiles ty (Just $ benchmarkName bench) dir build case ty of AllFiles -> return (concat [bfiles,exposed]) Modules -> return (concat [bfiles]) @@ -436,11 +436,10 @@ testFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File testFiles ty test = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) - let buildComponentDir = getBuildComponentDir (testName test) exposed <- resolveFilesAndDeps ty - buildComponentDir + (Just $ testName test) (dirs ++ [dir]) (case testInterface test of TestSuiteExeV10 _ fp -> @@ -450,7 +449,7 @@ testFiles ty test = do TestSuiteUnsupported _ -> []) haskellModuleExts - bfiles <- buildFiles ty buildComponentDir dir build + bfiles <- buildFiles ty (Just $ testName test) dir build case ty of AllFiles -> return (concat [bfiles,exposed]) Modules -> return (concat [bfiles]) @@ -463,15 +462,14 @@ executableFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs F executableFiles ty exe = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) - let buildComponentDir = getBuildComponentDir (exeName exe) exposed <- resolveFilesAndDeps ty - buildComponentDir + (Just $ exeName exe) (dirs ++ [dir]) [Right (modulePath exe)] haskellModuleExts - bfiles <- buildFiles ty buildComponentDir dir build + bfiles <- buildFiles ty (Just $ exeName exe) dir build case ty of AllFiles -> return (concat [bfiles,exposed]) Modules -> return (concat [bfiles]) @@ -497,13 +495,13 @@ libraryFiles ty lib = -- | Get all files in a build. buildFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m) - => CabalFileType -> Maybe (Path Rel Dir) -> Path Abs Dir -> BuildInfo -> m [Path Abs File] -buildFiles ty buildComponentDir dir build = do + => CabalFileType -> Maybe (String) -> Path Abs Dir -> BuildInfo -> m [Path Abs File] +buildFiles ty component dir build = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) other <- resolveFilesAndDeps ty - buildComponentDir + component (dirs ++ [dir]) (map Left (otherModules build)) haskellModuleExts @@ -635,16 +633,27 @@ depRange = \(Dependency _ r) -> r resolveFilesAndDeps :: (MonadIO m, MonadLogger m, MonadThrow m, MonadReader (Path Abs File, Path Abs Dir) m) => CabalFileType - -> Maybe (Path Rel Dir) -- ^ Subdirectory of buildDir where Cabal/GHC writes artifacts + -> Maybe (String) -- ^ Package component name -> [Path Abs Dir] -- ^ Directories to look in. -> [Either ModuleName String] -- ^ Base names. -> [Text] -- ^ Extentions. -> m [Path Abs File] -resolveFilesAndDeps ty buildComponentDir dirs names0 exts = do - (moduleFiles,thFiles) <- loop names0 S.empty +resolveFilesAndDeps ty component dirs names0 exts = do + (moduleFiles,thFiles,_) <- loop names0 S.empty + -- cabalfp <- asks fst + -- forM_ (S.toList (foundModules `S.difference` (S.fromList (lefts names0)))) $ + -- \unlistedModule -> + -- $(logWarn) $ + -- T.pack $ + -- "XXX Warning: module not listed in " ++ + -- toFilePath (filename cabalfp) ++ + -- (case component of + -- Nothing -> " for library" + -- Just c -> " for " ++ c) ++ + -- " (add it to other-modules): " ++ display unlistedModule ++ "." return (S.toList moduleFiles ++ thFiles) where - loop [] _ = return (S.empty, []) + loop [] doneModules = return (S.empty, [], doneModules) loop names doneModules0 = do resolvedFiles <- resolveFiles dirs names exts pairs <- mapM getDependencies resolvedFiles @@ -652,20 +661,21 @@ resolveFilesAndDeps ty buildComponentDir dirs names0 exts = do moduleDeps = S.unions (map fst pairs) thDepFiles = concatMap snd pairs modulesRemaining = S.difference moduleDeps doneModules' - (moduleDepFiles',thDepFiles') <- + (moduleDepFiles',thDepFiles',doneModules'') <- loop (map Left (S.toList modulesRemaining)) doneModules' return ( S.union (S.fromList resolvedFiles) moduleDepFiles' - , thDepFiles ++ thDepFiles') + , thDepFiles ++ thDepFiles' + , doneModules'') getDependencies resolvedFile = do dir <- asks (parent . fst) - hiDir <- getHIDir + dumpHIDir <- getDumpHIDir case stripDir dir resolvedFile of Nothing -> return (S.empty, []) Just fileRel -> do let dumpHIPath = FilePath.replaceExtension - (toFilePath (hiDir fileRel)) + (toFilePath (dumpHIDir fileRel)) ".dump-hi" dumpHIExists <- liftIO $ doesFileExist dumpHIPath if dumpHIExists @@ -698,10 +708,11 @@ resolveFilesAndDeps ty buildComponentDir dirs names0 exts = do filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI Modules -> [] --liftIO $ putStrLn $ "XXX dumpHI " ++ show dumpHIPath ++ "\n XXX moduleDeps=" ++ show moduleDeps ++ "\n XXX thDeps=" ++ show thDeps - return (moduleDeps, thDeps) - getHIDir = do + return + (moduleDeps, thDeps) + getDumpHIDir = do bld <- asks snd - return $ maybe bld (bld ) buildComponentDir + return $ maybe bld (bld ) (getBuildComponentDir component) parseAbsOrRelFile dir fp = case parseRelFile fp of Just rel -> Just (dir rel) From 31712d302058d4fff3b0effb33f35035106d2f7d Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Sat, 8 Aug 2015 15:38:18 -0700 Subject: [PATCH 4/6] Warnings for unlisted modules (#32,#105) --- src/Stack/Package.hs | 173 +++++++++++++++++++++++-------------------- stack.cabal | 1 + 2 files changed, 93 insertions(+), 81 deletions(-) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 85e9f26c7a..6b4ac2dfdc 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -412,22 +412,26 @@ benchmarkFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs benchmarkFiles ty bench = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) - exposed <- - resolveFilesAndDeps - ty - (Just $ benchmarkName bench) - (dirs ++ [dir]) - (case benchmarkInterface bench of - BenchmarkExeV10 _ fp -> - [Right fp] - BenchmarkUnsupported _ -> - []) - haskellModuleExts - bfiles <- buildFiles ty (Just $ benchmarkName bench) dir build - case ty of - AllFiles -> return (concat [bfiles,exposed]) - Modules -> return (concat [bfiles]) + rfiles <- resolveFilesAndDeps + ty + (Just $ benchmarkName bench) + (dirs ++ [dir]) + names + haskellModuleExts + cfiles <- buildCSources ty build + return (rfiles ++ cfiles) where + names = + case ty of + AllFiles -> concat [bnames,exposed] + Modules -> concat [bnames] + exposed = + case benchmarkInterface bench of + BenchmarkExeV10 _ fp -> + [Right fp] + BenchmarkUnsupported _ -> + [] + bnames = map Left (otherModules build) build = benchmarkBuildInfo bench -- | Get all files referenced by the test. @@ -436,24 +440,28 @@ testFiles :: (MonadLogger m, MonadIO m, MonadThrow m, MonadReader (Path Abs File testFiles ty test = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) - exposed <- - resolveFilesAndDeps - ty - (Just $ testName test) - (dirs ++ [dir]) - (case testInterface test of - TestSuiteExeV10 _ fp -> - [Right fp] - TestSuiteLibV09 _ mn -> - [Left mn] - TestSuiteUnsupported _ -> - []) - haskellModuleExts - bfiles <- buildFiles ty (Just $ testName test) dir build - case ty of - AllFiles -> return (concat [bfiles,exposed]) - Modules -> return (concat [bfiles]) + rfiles <- resolveFilesAndDeps + ty + (Just $ testName test) + (dirs ++ [dir]) + names + haskellModuleExts + cfiles <- buildCSources ty build + return (rfiles ++ cfiles) where + names = + case ty of + AllFiles -> concat [bnames,exposed] + Modules -> concat [bnames] + exposed = + case testInterface test of + TestSuiteExeV10 _ fp -> + [Right fp] + TestSuiteLibV09 _ mn -> + [Left mn] + TestSuiteUnsupported _ -> + [] + bnames = map Left (otherModules build) build = testBuildInfo test -- | Get all files referenced by the executable. @@ -462,18 +470,22 @@ executableFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs F executableFiles ty exe = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) - exposed <- - resolveFilesAndDeps + rfiles <- resolveFilesAndDeps ty (Just $ exeName exe) (dirs ++ [dir]) - [Right (modulePath exe)] + names haskellModuleExts - bfiles <- buildFiles ty (Just $ exeName exe) dir build - case ty of - AllFiles -> return (concat [bfiles,exposed]) - Modules -> return (concat [bfiles]) - where build = buildInfo exe + cfiles <- buildCSources ty build + return (rfiles ++ cfiles) + where + names = + case ty of + AllFiles -> concat [bnames,exposed] + Modules -> concat [bnames] + bnames = map Left (otherModules build) + exposed = [Right (modulePath exe)] + build = buildInfo exe -- | Get all files referenced by the library. libraryFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m) @@ -481,34 +493,28 @@ libraryFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File libraryFiles ty lib = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . fst) - exposed <- resolveFilesAndDeps - ty - Nothing - (dirs ++ [dir]) - (map Left (exposedModules lib)) - haskellModuleExts - bfiles <- buildFiles ty Nothing dir build - case ty of - AllFiles -> return (concat [bfiles,exposed]) - Modules -> return (concat [bfiles,exposed]) - where build = libBuildInfo lib - --- | Get all files in a build. -buildFiles :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m) - => CabalFileType -> Maybe (String) -> Path Abs Dir -> BuildInfo -> m [Path Abs File] -buildFiles ty component dir build = do - dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) - other <- - resolveFilesAndDeps - ty - component - (dirs ++ [dir]) - (map Left (otherModules build)) - haskellModuleExts - cSources' <- mapMaybeM resolveFileOrWarn (cSources build) - case ty of - Modules -> return other - AllFiles -> return (other ++ cSources') + rfiles <- resolveFilesAndDeps + ty + Nothing + (dirs ++ [dir]) + names + haskellModuleExts + cfiles <- buildCSources ty build + return (rfiles ++ cfiles) + where + names = + case ty of + AllFiles -> concat [bnames,exposed] + Modules -> concat [bnames,exposed] + exposed = map Left (exposedModules lib) + bnames = map Left (otherModules build) + build = libBuildInfo lib + +-- | Get all C sources in a build. +buildCSources :: (MonadLogger m,MonadIO m,MonadThrow m,MonadReader (Path Abs File, Path Abs Dir) m) + => CabalFileType -> BuildInfo -> m [Path Abs File] +buildCSources Modules _ = return [] +buildCSources AllFiles build = mapMaybeM resolveFileOrWarn (cSources build) -- | Get all dependencies of a package, including library, -- executables, tests, benchmarks. @@ -639,18 +645,24 @@ resolveFilesAndDeps -> [Text] -- ^ Extentions. -> m [Path Abs File] resolveFilesAndDeps ty component dirs names0 exts = do - (moduleFiles,thFiles,_) <- loop names0 S.empty - -- cabalfp <- asks fst - -- forM_ (S.toList (foundModules `S.difference` (S.fromList (lefts names0)))) $ - -- \unlistedModule -> - -- $(logWarn) $ - -- T.pack $ - -- "XXX Warning: module not listed in " ++ - -- toFilePath (filename cabalfp) ++ - -- (case component of - -- Nothing -> " for library" - -- Just c -> " for " ++ c) ++ - -- " (add it to other-modules): " ++ display unlistedModule ++ "." + (moduleFiles,thFiles,foundModules) <- loop names0 S.empty + cabalfp <- asks fst + let unlistedModules = + foundModules `S.difference` (S.fromList (lefts names0)) + unless (S.null unlistedModules) $ + $(logWarn) $ + T.pack $ + "Warning: " ++ + (if S.size unlistedModules == 1 + then "module" + else "modules") ++ + " not listed in " ++ + toFilePath (filename cabalfp) ++ + (case component of + Nothing -> " for library" + Just c -> " for '" ++ c ++ "'") ++ + " component (add to other-modules):\n " ++ + intercalate "\n " (map display (S.toList unlistedModules)) return (S.toList moduleFiles ++ thFiles) where loop [] doneModules = return (S.empty, [], doneModules) @@ -707,7 +719,6 @@ resolveFilesAndDeps ty component dirs names0 exts = do decodeUtf8 . C8.dropWhile (/= '"'))) $ filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI Modules -> [] - --liftIO $ putStrLn $ "XXX dumpHI " ++ show dumpHIPath ++ "\n XXX moduleDeps=" ++ show moduleDeps ++ "\n XXX thDeps=" ++ show thDeps return (moduleDeps, thDeps) getDumpHIDir = do diff --git a/stack.cabal b/stack.cabal index c542fd5439..3d6c30e516 100644 --- a/stack.cabal +++ b/stack.cabal @@ -179,6 +179,7 @@ executable stack ghc-options: -Wall -threaded -rtsopts other-modules: Plugins Plugins.Commands + Paths_stack build-depends: base >=4.7 && < 5 , bytestring >= 0.10.4.0 From 06218bdc2ae283e46803f1fd22c5de20644f33aa Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Sat, 8 Aug 2015 22:10:37 -0700 Subject: [PATCH 5/6] Fix TH dependency parsing on Windows (#105) --- src/Stack/Package.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 6b4ac2dfdc..de8560d21f 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -716,6 +716,7 @@ resolveFilesAndDeps ty component dirs names0 exts = do (parseAbsOrRelFile dir <=< (fmap T.unpack . (T.stripSuffix "\"" <=< T.stripPrefix "\"") . + T.dropWhileEnd (== '\r') . decodeUtf8 . C8.dropWhile (/= '"'))) $ filter ("addDependentFile \"" `C8.isPrefixOf`) dumpHI Modules -> [] From c571c302bef41f2dbc40f0b2023fe8c85c4bc3eb Mon Sep 17 00:00:00 2001 From: Emanuel Borsboom Date: Sun, 9 Aug 2015 12:52:51 -0700 Subject: [PATCH 6/6] Remove Stack.Iface module (#105) --- src/Stack/Iface.hs | 290 --------------------------------------------- src/main/Main.hs | 8 -- stack.cabal | 1 - 3 files changed, 299 deletions(-) delete mode 100644 src/Stack/Iface.hs diff --git a/src/Stack/Iface.hs b/src/Stack/Iface.hs deleted file mode 100644 index d6ae186479..0000000000 --- a/src/Stack/Iface.hs +++ /dev/null @@ -1,290 +0,0 @@ -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - --- TODO(DanBurton): remove the following once the module is done. -{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-imports #-} - -module Stack.Iface where - -import Data.Map (Map) -import Data.ByteString(ByteString) -import Distribution.ModuleName (ModuleName) - -import Control.Monad.IO.Class -import Control.Monad.Reader -import Control.Monad.Catch -import Control.Monad.Logger -import Path -import Path.IO (fileExists) -import qualified Data.ByteString.Char8 as S8 -import qualified Data.Map as Map -import qualified Data.Set as Set -import qualified Data.Text as Text -import qualified Data.Text.Encoding as Text -import Data.Maybe -import Data.Monoid -import Data.Foldable (foldMap) -import Distribution.PackageDescription -import Distribution.Package hiding (packageName, PackageName) -import Distribution.Text (display) -import qualified Distribution.ModuleName as ModuleName -import System.Process (readProcess) -import System.FilePath (dropExtension, addExtension) - -import Stack.Build.Source -import Stack.Types.Build -import Stack.Constants -import Stack.Package -import Stack.Types - -type M m env = (MonadLogger m, MonadIO m, MonadCatch m, MonadReader env m, HasEnvConfig env) - -data TargetModules = TargetModules - { targetIsExecutable :: Bool - -- ^ Implies "Main" as a target module if True. - -- benchmark and test targets are also executable. - , targetExposedModules :: [ModuleName] - , targetOtherModules :: [ModuleName] - } - deriving (Show) - -type ShowIface = Path Abs File -> IO ByteString - --- All of the compiled modules for a given target --- can be found in a single directory tree. -detectFiles :: ShowIface -> Path Abs Dir -- place to find .hi files - -> TargetModules -> IO [FilePath] -detectFiles showIface hiDir targetModules = do - let targetFilesRel :: [FilePath] -- (Relative) FilePath representation of modules. - targetFilesRel - = if targetIsExecutable targetModules - then ["Main"] - else [] - <> map ModuleName.toFilePath (targetExposedModules targetModules) - <> map ModuleName.toFilePath (targetOtherModules targetModules) - let targetHiFilesAbs :: [Path Abs File] - targetHiFilesAbs = concatMap toHi targetFilesRel - where - toHi :: FilePath -> [Path Abs File] - toHi fp = case pathHiExtMay of - Just pathHiExt -> [hiDir pathHiExt] - Nothing -> [] -- warn? - where - pathHiExtMay - = parseRelFile - $ addExtension fp "hi" - - depFiles <- fmap concat $ forM targetHiFilesAbs $ \file -> do - exists <- fileExists file - if exists - then do - iface <- showIface file - return $ findDepFiles iface - else return [] -- warn? - - return depFiles - - -findDepFiles :: ByteString -> [FilePath] -findDepFiles bs = depFiles - where - text = Text.decodeUtf8 bs - ts = Text.lines text - depFiles = map Text.unpack $ mapMaybe f ts - f = Text.stripPrefix "addDependentFile \"" - >=> Text.stripSuffix "\"" - --- Map from Target to TargetModules -targetModules :: PackageDescription -> Map Target TargetModules -targetModules pDesc - = foldMap libraryTargetModules (library pDesc) - <> foldMap executableTargetModules (executables pDesc) - <> foldMap testSuiteTargetModules (testSuites pDesc) - <> foldMap benchmarkTargetModules (benchmarks pDesc) - -libraryTargetModules :: Library -> Map Target TargetModules -libraryTargetModules lib = Map.singleton TargetLibrary $ - TargetModules - { targetIsExecutable = False - , targetExposedModules = exposedModules lib - , targetOtherModules = otherModules (libBuildInfo lib) - } - -executableTargetModules :: Executable -> Map Target TargetModules -executableTargetModules exe = Map.singleton (TargetExecutable (exeName exe)) $ - TargetModules - { targetIsExecutable = True - , targetExposedModules = [] - , targetOtherModules = otherModules (buildInfo exe) - } - -testSuiteTargetModules :: TestSuite -> Map Target TargetModules -testSuiteTargetModules test = Map.singleton (TargetExecutable (testName test)) $ - TargetModules - { targetIsExecutable = True - , targetExposedModules = [] - , targetOtherModules = otherModules (testBuildInfo test) - } - -benchmarkTargetModules :: Benchmark -> Map Target TargetModules -benchmarkTargetModules bench = Map.singleton (TargetExecutable (benchmarkName bench)) $ - TargetModules - { targetIsExecutable = True - , targetExposedModules = [] - , targetOtherModules = otherModules (benchmarkBuildInfo bench) - } - -data CompilationContext = CompilationContext - { ccPackageName :: String - , ccPackageVersion :: Version - , ccProjectRoot :: Path Abs Dir - , ccGhcVersion :: Version - , ccPlatform :: String - , ccSnapshot :: String - , ccCabalLibVersion :: Version - } - --- Find the directory where the .hi files are for the given target. -targetHiDir :: MonadThrow m => CompilationContext -> Target -> m (Path Abs Dir) -targetHiDir cc TargetLibrary = do - let showGhcVer = versionString (ccGhcVersion cc) - let showPlat = ccPlatform cc - let showPackageAndVersion = ccPackageName cc <> "-" <> versionString (ccPackageVersion cc) - - platform <- parseRelDir (ccPlatform cc) - snapshot <- parseRelDir (ccSnapshot cc) - ghcVer <- parseRelDir showGhcVer - platGhc <- parseRelDir (showPlat <> "-ghc-" <> showGhcVer) - packageAndVersion - <- parseRelDir showPackageAndVersion - - return $ ccProjectRoot cc $(mkRelDir ".stack-work/install") - platform snapshot ghcVer - $(mkRelDir "lib") platGhc packageAndVersion -targetHiDir cc (TargetExecutable exeName) = do - let showCabalVersion = versionString (ccCabalLibVersion cc) - - arch <- parseRelDir (ccPlatform cc) - cabalWithVer <- parseRelDir ("Cabal-" <> showCabalVersion) - exe <- parseRelDir exeName - exeTmp <- parseRelDir (exeName <> "-tmp") - - return $ ccProjectRoot cc $(mkRelDir ".stack-work/dist") - arch cabalWithVer - $(mkRelDir "build") exe exeTmp - -data Target - = TargetLibrary - | TargetExecutable String - deriving (Eq, Ord, Show) - - --- Extract the contextual details needed to find the .hi files. -makeCompilationContext :: EnvConfig -> LocalPackage -> CompilationContext -makeCompilationContext EnvConfig{..} LocalPackage{..} = CompilationContext - { ccPackageName = show packageName - , ccPackageVersion = packageVersion - , ccProjectRoot = lpDir - , ccGhcVersion = envConfigGhcVersion - , ccPlatform = display configPlatform - , ccSnapshot = Text.unpack $ resolverName bcResolver - , ccCabalLibVersion = envConfigCabalVersion - } - where - BuildConfig{..} = envConfigBuildConfig - Config{..} = bcConfig - Package{..} = lpPackage - -sampleRun :: IO () -sampleRun = do - let showIface arg = do - str <- readProcess "ghc" ["--show-iface", toFilePath arg] "" - return $ S8.pack str - --let hiDir = - -- -- $(mkAbsDir "/home/dan/dep-file-test/.stack-work/install/x86_64-linux/lts-2.13/7.8.4/lib/x86_64-linux-ghc-7.8.4/dep-file-test-0.1.0.0") - -- $(mkAbsDir "/home/dan/dep-file-test/.stack-work/dist/x86_64-linux/Cabal-1.18.1.5/build/dep-file-test/dep-file-test-tmp") - sampleProjectRoot <- parseAbsDir "/home/dan/dep-file-test" - let ctx = CompilationContext - { ccPackageName = "dep-file-test" - , ccPackageVersion = $(mkVersion "0.1.0.0") - , ccProjectRoot = sampleProjectRoot - , ccGhcVersion = $(mkVersion "7.8.4") - , ccPlatform = "x86_64-linux" - , ccSnapshot = "lts-2.13" - , ccCabalLibVersion = $(mkVersion "1.18.1.5") - } - - hiDir <- targetHiDir ctx (TargetExecutable "dep-file-test") - let tModules = TargetModules - { targetIsExecutable = True - , targetExposedModules = [] - , targetOtherModules = [] - } - files <- detectFiles showIface hiDir tModules - mapM_ print files - -targets :: LocalPackage -> [Target] -targets LocalPackage{..} = - if packageHasLibrary - then [TargetLibrary] - else [] - <> map toTargetExe (Set.toList packageExes) - <> map toTargetExe (Set.toList packageTests) - <> map toTargetExe (Set.toList packageBenchmarks) - where - Package{..} = lpPackage - toTargetExe = TargetExecutable . Text.unpack - - --- copied and adapted from Ide.hs line 68 -defaultPackageConfig :: EnvConfig -> PackageName -> PackageConfig -defaultPackageConfig econfig name = PackageConfig - { packageConfigEnableTests = True - , packageConfigEnableBenchmarks = True - , packageConfigFlags = localFlags mempty bconfig name - , packageConfigGhcVersion = envConfigGhcVersion econfig - , packageConfigPlatform = configPlatform - (getConfig bconfig) - } - where - bconfig = envConfigBuildConfig econfig - -iface :: M m env => m () -iface = do - $logWarn "The iface command is experimental and will probably be removed" - - -- TODO(DanBurton): call with menv. - -- TODO(DanBurton): consider caching the result of this call. - let showIface arg = do - str <- readProcess "ghc" ["--show-iface", toFilePath arg] "" - return $ S8.pack str - - envConfig <- asks getEnvConfig - (lps, _, _) <- loadLocals defaultBuildOpts Map.empty - forM_ lps $ \lp -> do - let pName = packageName (lpPackage lp) - liftIO $ putStr "package: " - liftIO $ print pName - - let ctx = makeCompilationContext envConfig lp - gpDesc <- readPackageUnresolved (lpCabalFile lp) - - let pkgConfig = defaultPackageConfig envConfig pName - let pDesc = resolvePackageDescription pkgConfig gpDesc - let tModulesMap = targetModules pDesc - - forM_ (targets lp) $ \target -> do - liftIO $ putStr "target: " - liftIO $ print target - hiDir <- targetHiDir ctx target - case Map.lookup target tModulesMap of - Just tModules -> do - files <- liftIO $ detectFiles showIface hiDir tModules - forM_ files $ \file -> liftIO $ do - putStr "addDependentFile " - print file - Nothing -> error $ "target discrepancy: " <> show target - - return () diff --git a/src/main/Main.hs b/src/main/Main.hs index 4f81322612..90a31dfd13 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -50,7 +50,6 @@ import Stack.Exec import Stack.Fetch import Stack.FileWatch import Stack.Ide -import Stack.Iface (iface) import qualified Stack.Image as Image import Stack.Init import Stack.New @@ -270,10 +269,6 @@ main = withInterpreterArgs stackProgName $ \args isInterpreter -> fixCodePage $ "Clean the local packages" cleanCmd (pure ()) - addCommand "iface" - "Display TH dependencies" - ifaceCmd - (pure ()) addCommand "list-dependencies" "List the dependencies" listDependenciesCmd @@ -901,9 +896,6 @@ solverCmd fixStackYaml go = dotCmd :: DotOpts -> GlobalOpts -> IO () dotCmd dotOpts go = withBuildConfigAndLock go (\_ -> dot dotOpts) -ifaceCmd :: () -> GlobalOpts -> IO () -ifaceCmd () go = withBuildConfigAndLock go (\_ -> iface) - -- | List the dependencies listDependenciesCmd :: Text -> GlobalOpts -> IO () listDependenciesCmd sep go = withBuildConfig go (listDependencies sep') diff --git a/stack.cabal b/stack.cabal index 3d6c30e516..62d7b779e5 100644 --- a/stack.cabal +++ b/stack.cabal @@ -46,7 +46,6 @@ library Stack.FileWatch Stack.GhcPkg Stack.Init - Stack.Iface Stack.New Stack.Options Stack.Package