diff --git a/ChangeLog.md b/ChangeLog.md index 7169bf5e2c..3a3bc367f0 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -72,6 +72,8 @@ Bug fixes: now only added when there are no local targets. This allows it to be to load code that uses replacements for `base`. See [#3589](https://github.com/commercialhaskell/stack/issues/3589#issuecomment) +* `stack ghci` now uses correct paths for autogen files with + [#3791](https://github.com/commercialhaskell/stack/issues/3791) ## v1.6.3 diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs index 183dad9816..6a90a6c12b 100644 --- a/src/Stack/Build/ConstructPlan.hs +++ b/src/Stack/Build/ConstructPlan.hs @@ -28,7 +28,7 @@ import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as T -import Data.Text.Encoding (decodeUtf8With) +import Data.Text.Encoding (encodeUtf8, decodeUtf8With) import Data.Text.Encoding.Error (lenientDecode) import qualified Distribution.Text as Cabal import qualified Distribution.Version as Cabal @@ -728,7 +728,7 @@ checkDirtiness ps installed package present wanted = do , configCacheDeps = Set.fromList $ Map.elems present , configCacheComponents = case ps of - PSFiles lp _ -> Set.map renderComponent $ lpComponents lp + PSFiles lp _ -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp PSIndex{} -> Set.empty , configCacheHaddock = shouldHaddockPackage buildOpts wanted (packageName package) || diff --git a/src/Stack/Build/Execute.hs b/src/Stack/Build/Execute.hs index 8bc3f7647e..74892f1d73 100644 --- a/src/Stack/Build/Execute.hs +++ b/src/Stack/Build/Execute.hs @@ -794,7 +794,7 @@ getConfigCache ExecuteEnv {..} task@Task {..} installedMap enableTest enableBenc , configCacheDeps = allDeps , configCacheComponents = case taskType of - TTFiles lp _ -> Set.map renderComponent $ lpComponents lp + TTFiles lp _ -> Set.map (encodeUtf8 . renderComponent) $ lpComponents lp TTIndex{} -> Set.empty , configCacheHaddock = shouldHaddockPackage eeBuildOpts eeWanted (packageIdentifierName taskProvides) @@ -1417,9 +1417,9 @@ singleBuild ac@ActionContext {..} ee@ExecuteEnv {..} task@Task {..} installedMap -- https://github.com/commercialhaskell/stack/issues/2649 -- is resolved, we will want to partition the warnings -- based on variety, and output in different lists. - let showModuleWarning (UnlistedModulesWarning mcomp modules) = + let showModuleWarning (UnlistedModulesWarning comp modules) = "- In" <+> - maybe "the library component" (\c -> fromString c <+> "component") mcomp <> + fromString (T.unpack (renderComponent comp)) <> ":" <> line <> indent 4 (mconcat $ intersperse line $ map (styleGood . fromString . C.display) modules) forM_ mlocalWarnings $ \(cabalfp, warnings) -> do @@ -1943,7 +1943,7 @@ cabalIsSatisfied = all (== ExecutableBuilt) . M.elems -- Test-suite and benchmark build components. finalComponentOptions :: LocalPackage -> [String] finalComponentOptions lp = - map (T.unpack . decodeUtf8 . renderComponent) $ + map (T.unpack . renderComponent) $ Set.toList $ Set.filter (\c -> isCTest c || isCBench c) (lpComponents lp) diff --git a/src/Stack/Ghci.hs b/src/Stack/Ghci.hs index 1c414d8c0e..086d336275 100644 --- a/src/Stack/Ghci.hs +++ b/src/Stack/Ghci.hs @@ -398,7 +398,7 @@ runGhci GhciOpts{..} targets mainIsTargets pkgs extraFiles exposePackages = do scriptPath <- writeGhciScript tmpDirectory (renderScript isIntero pkgs mainFile ghciOnlyMain extraFiles) execGhci (macrosOptions ++ ["-ghci-script=" <> toFilePath scriptPath]) -writeMacrosFile :: (MonadIO m) => Path Abs Dir -> [GhciPkgInfo] -> m [String] +writeMacrosFile :: HasRunner env => Path Abs Dir -> [GhciPkgInfo] -> RIO env [String] writeMacrosFile tmpDirectory packages = do preprocessCabalMacros packages macrosFile where @@ -805,12 +805,21 @@ getExtraLoadDeps loadAllDeps sourceMap targets = (_, Just PSIndex{}) -> return loadAllDeps (_, _) -> return False -preprocessCabalMacros :: MonadIO m => [GhciPkgInfo] -> Path Abs File -> m [String] -preprocessCabalMacros pkgs out = liftIO $ do - let fps = nubOrd (concatMap (mapMaybe (bioCabalMacros . snd) . ghciPkgOpts) pkgs) - files <- mapM (S8.readFile . toFilePath) fps +preprocessCabalMacros :: HasRunner env => [GhciPkgInfo] -> Path Abs File -> RIO env [String] +preprocessCabalMacros pkgs out = do + fps <- fmap (nubOrd . catMaybes . concat) $ + forM pkgs $ \pkg -> forM (ghciPkgOpts pkg) $ \(_, bio) -> do + let cabalMacros = bioCabalMacros bio + exists <- liftIO $ doesFileExist cabalMacros + if exists + then return $ Just cabalMacros + else do + prettyWarnL ["Didn't find expected autogen file:", display cabalMacros] + return Nothing + files <- liftIO $ mapM (S8.readFile . toFilePath) fps if null files then return [] else do - S8.writeFile (toFilePath out) $ S8.concat $ map (<> "\n#undef CURRENT_PACKAGE_KEY\n#undef CURRENT_COMPONENT_ID\n") files + liftIO $ S8.writeFile (toFilePath out) $ S8.concat $ + map (<> "\n#undef CURRENT_PACKAGE_KEY\n#undef CURRENT_COMPONENT_ID\n") files return ["-optP-include", "-optP" <> toFilePath out] setScriptPerms :: MonadIO m => FilePath -> m () @@ -842,47 +851,3 @@ hasLocalComp p t = TargetComps s -> any p (S.toList s) TargetAll ProjectPackage -> True _ -> False - - -{- Copied from Stack.Ide, may be useful in the future - --- | Get options and target files for the given package info. -getPackageOptsAndTargetFiles - :: (MonadThrow m, MonadIO m, MonadReader env m, HasEnvConfig env) - => Path Abs Dir -> GhciPkgInfo -> m ([FilePath], [FilePath]) -getPackageOptsAndTargetFiles pwd pkg = do - dist <- distDirFromDir (ghciPkgDir pkg) - let autogen = autogenDir dist - paths_foo <- - liftM - (autogen ) - (parseRelFile - ("Paths_" ++ packageNameString (ghciPkgName pkg) ++ ".hs")) - paths_foo_exists <- doesFileExist paths_foo - let ghcOptions bio = - bioOneWordOpts bio ++ - bioOpts bio ++ - bioPackageFlags bio ++ - maybe [] (\cabalMacros -> ["-optP-include", "-optP" <> toFilePath cabalMacros]) (bioCabalMacros bio) - return - ( ("--dist-dir=" <> toFilePathNoTrailingSep dist) : - -- FIXME: use compilerOptionsCabalFlag - map ("--ghc-option=" ++) (concatMap (ghcOptions . snd) (ghciPkgOpts pkg)) - , mapMaybe - (fmap toFilePath . stripProperPrefix pwd) - (S.toList (ghciPkgCFiles pkg) <> S.toList (ghciPkgModFiles pkg) <> - [paths_foo | paths_foo_exists])) - --- | List load targets for a package target. -targetsCmd :: Text -> GlobalOpts -> IO () -targetsCmd target go@GlobalOpts{..} = - withBuildConfig go $ - do let boptsCli = defaultBuildOptsCLI { boptsCLITargets = [target] } - (_realTargets,_,pkgs) <- ghciSetup (ideGhciOpts boptsCli) - pwd <- getCurrentDir - targets <- - fmap - (concat . snd . unzip) - (mapM (getPackageOptsAndTargetFiles pwd) pkgs) - forM_ targets (liftIO . putStrLn) --} diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs index 6542dcb3c6..0a34785814 100644 --- a/src/Stack/Package.hs +++ b/src/Stack/Package.hs @@ -33,7 +33,6 @@ module Stack.Package ,resolvePackageDescription ,packageDescTools ,packageDependencies - ,autogenDir ,cabalFilePackageId ,gpdPackageIdentifier ,gpdPackageName @@ -102,7 +101,7 @@ import System.IO.Error import RIO.Process data Ctx = Ctx { ctxFile :: !(Path Abs File) - , ctxDir :: !(Path Abs Dir) + , ctxDistDir :: !(Path Abs Dir) , ctxEnvConfig :: !EnvConfig } @@ -342,7 +341,7 @@ packageFromPackageDescription packageConfig pkgFlags (PackageDescriptionPair pkg env <- view envConfigL (componentModules,componentFiles,dataFiles',warnings) <- runRIO - (Ctx cabalfp (buildDir distDir) env) + (Ctx cabalfp distDir env) (packageDescModulesAndFiles pkg) setupFiles <- if buildType pkg `elem` [Nothing, Just Custom] @@ -392,19 +391,13 @@ generatePkgDescOpts -> m (Map NamedComponent BuildInfoOpts) generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componentPaths = do config <- view configL + cabalVer <- view cabalVersionL distDir <- distDirFromDir cabalDir - let cabalMacros = autogenDir distDir $(mkRelFile "cabal_macros.h") - exists <- doesFileExist cabalMacros - let mcabalMacros = - if exists - then Just cabalMacros - else Nothing let generate namedComponent binfo = ( namedComponent , generateBuildInfoOpts BioInput { biSourceMap = sourceMap , biInstalledMap = installedMap - , biCabalMacros = mcabalMacros , biCabalDir = cabalDir , biDistDir = distDir , biOmitPackages = omitPkgs @@ -414,6 +407,7 @@ generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componen , biConfigLibDirs = configExtraLibDirs config , biConfigIncludeDirs = configExtraIncludeDirs config , biComponentName = namedComponent + , biCabalVersion = cabalVer } ) return @@ -448,7 +442,6 @@ generatePkgDescOpts sourceMap installedMap omitPkgs addPkgs cabalfp pkg componen data BioInput = BioInput { biSourceMap :: !SourceMap , biInstalledMap :: !InstalledMap - , biCabalMacros :: !(Maybe (Path Abs File)) , biCabalDir :: !(Path Abs Dir) , biDistDir :: !(Path Abs Dir) , biOmitPackages :: ![PackageName] @@ -458,6 +451,7 @@ data BioInput = BioInput , biConfigLibDirs :: !(Set FilePath) , biConfigIncludeDirs :: !(Set FilePath) , biComponentName :: !NamedComponent + , biCabalVersion :: !Version } -- | Generate GHC options for the target. Since Cabal also figures out @@ -477,7 +471,7 @@ generateBuildInfoOpts BioInput {..} = , bioOneWordOpts = nubOrd $ concat [extOpts, srcOpts, includeOpts, libOpts, fworks, cObjectFiles] , bioPackageFlags = deps - , bioCabalMacros = biCabalMacros + , bioCabalMacros = componentAutogen $(mkRelFile "cabal_macros.h") } where cObjectFiles = @@ -506,15 +500,21 @@ generateBuildInfoOpts BioInput {..} = isGhc GHC = True isGhc _ = False extOpts = map (("-X" ++) . D.display) (usedExtensions biBuildInfo) - srcOpts = - map - (("-i" <>) . toFilePathNoTrailingSep) - ([biCabalDir | null (hsSourceDirs biBuildInfo)] <> - mapMaybe toIncludeDir (hsSourceDirs biBuildInfo) <> - [autogenDir biDistDir,buildDir biDistDir] <> - [makeGenDir (buildDir biDistDir) - | Just makeGenDir <- [fileGenDirFromComponentName biComponentName]]) ++ - ["-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir)] + srcOpts = concat + [map (("-i" <>) . toFilePathNoTrailingSep) + (concat + [ [ componentBuildDir biCabalVersion biComponentName biDistDir ] + , [ biCabalDir + | null (hsSourceDirs biBuildInfo) + ] + , mapMaybe toIncludeDir (hsSourceDirs biBuildInfo) + , [ componentAutogen ] + , maybeToList (packageAutogenDir biCabalVersion biDistDir) + , [ componentOutputDir biComponentName biDistDir ] + ]) + , [ "-stubdir=" ++ toFilePathNoTrailingSep (buildDir biDistDir) ] + ] + componentAutogen = componentAutogenDir biCabalVersion biComponentName biDistDir toIncludeDir "." = Just biCabalDir toIncludeDir relDir = concatAndColapseAbsDir biCabalDir relDir includeOpts = @@ -577,35 +577,54 @@ makeObjectFilePathFromC cabalDir namedComponent distDir cFilePath = do relCFilePath <- stripProperPrefix cabalDir cFilePath relOFilePath <- parseRelFile (replaceExtension (toFilePath relCFilePath) "o") - addComponentPrefix <- fileGenDirFromComponentName namedComponent - return (addComponentPrefix (buildDir distDir) relOFilePath) + return (componentOutputDir namedComponent distDir relOFilePath) + +-- | Make the global autogen dir if Cabal version is new enough. +packageAutogenDir :: Version -> Path Abs Dir -> Maybe (Path Abs Dir) +packageAutogenDir cabalVer distDir + | cabalVer < $(mkVersion "2.0") = Nothing + | otherwise = Just $ buildDir distDir $(mkRelDir "global-autogen") + +-- | Make the autogen dir. +componentAutogenDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir +componentAutogenDir cabalVer component distDir = + componentBuildDir cabalVer component distDir $(mkRelDir "autogen") + +-- | See 'Distribution.Simple.LocalBuildInfo.componentBuildDir' +componentBuildDir :: Version -> NamedComponent -> Path Abs Dir -> Path Abs Dir +componentBuildDir cabalVer component distDir + | cabalVer < $(mkVersion "2.0") = buildDir distDir + | otherwise = + case component of + CLib -> buildDir distDir + CExe name -> buildDir distDir componentNameToDir name + CTest name -> buildDir distDir componentNameToDir name + CBench name -> buildDir distDir componentNameToDir name -- | The directory where generated files are put like .o or .hs (from .x files). -fileGenDirFromComponentName - :: MonadThrow m - => NamedComponent -> m (Path b Dir -> Path b Dir) -fileGenDirFromComponentName namedComponent = +componentOutputDir :: NamedComponent -> Path Abs Dir -> Path Abs Dir +componentOutputDir namedComponent distDir = case namedComponent of - CLib -> return id + CLib -> buildDir distDir CExe name -> makeTmp name CTest name -> makeTmp name CBench name -> makeTmp name - where makeTmp name = do - prefix <- parseRelDir (T.unpack name <> "/" <> T.unpack name <> "-tmp") - return ( prefix) - --- | Make the autogen dir. -autogenDir :: Path Abs Dir -> Path Abs Dir -autogenDir distDir = buildDir distDir $(mkRelDir "autogen") + where + makeTmp name = + buildDir distDir componentNameToDir (name <> "/" <> name <> "-tmp") --- | Make the build dir. +-- | Make the build dir. Note that Cabal >= 2.0 uses the +-- 'componentBuildDir' above for some things. buildDir :: Path Abs Dir -> Path Abs Dir buildDir distDir = distDir $(mkRelDir "build") --- | Make the component-specific subdirectory of the build directory. -getBuildComponentDir :: Maybe String -> Maybe (Path Rel Dir) -getBuildComponentDir Nothing = Nothing -getBuildComponentDir (Just name) = parseRelDir (name FilePath. (name ++ "-tmp")) +-- NOTE: don't export this, only use it for valid paths based on +-- component names. +componentNameToDir :: Text -> Path Rel Dir +componentNameToDir name = + case parseRelDir (T.unpack name) of + Nothing -> error "Invariant violated: component names should always parse as directory names" + Just dir -> dir -- | Get all dependencies of the package (buildable targets only). -- @@ -711,7 +730,7 @@ packageDescModulesAndFiles pkg = do testComponent = CTest . T.pack . Cabal.unUnqualComponentName . testName benchComponent = CBench . T.pack . Cabal.unUnqualComponentName . benchmarkName asModuleAndFileMap label f lib = do - (a,b,c) <- f lib + (a,b,c) <- f (label lib) lib return (M.singleton (label lib) a, M.singleton (label lib) b, c) foldTuples = foldl' (<>) (M.empty, M.empty, []) @@ -791,13 +810,15 @@ matchDirFileGlob_ dir filepath = case parseFileGlob filepath of -- | Get all files referenced by the benchmark. benchmarkFiles - :: Benchmark -> RIO Ctx (Map ModuleName (Path Abs File), Set DotCabalPath, [PackageWarning]) -benchmarkFiles bench = do + :: NamedComponent + -> Benchmark + -> RIO Ctx (Map ModuleName (Path Abs File), Set DotCabalPath, [PackageWarning]) +benchmarkFiles component bench = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . ctxFile) (modules,files,warnings) <- resolveFilesAndDeps - (Just $ Cabal.unUnqualComponentName $ benchmarkName bench) + component (dirs ++ [dir]) (bnames <> exposed) haskellModuleExts @@ -813,14 +834,15 @@ benchmarkFiles bench = do -- | Get all files referenced by the test. testFiles - :: TestSuite + :: NamedComponent + -> TestSuite -> RIO Ctx (Map ModuleName (Path Abs File), Set DotCabalPath, [PackageWarning]) -testFiles test = do +testFiles component test = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . ctxFile) (modules,files,warnings) <- resolveFilesAndDeps - (Just $ Cabal.unUnqualComponentName $ testName test) + component (dirs ++ [dir]) (bnames <> exposed) haskellModuleExts @@ -837,14 +859,15 @@ testFiles test = do -- | Get all files referenced by the executable. executableFiles - :: Executable + :: NamedComponent + -> Executable -> RIO Ctx (Map ModuleName (Path Abs File), Set DotCabalPath, [PackageWarning]) -executableFiles exe = do +executableFiles component exe = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . ctxFile) (modules,files,warnings) <- resolveFilesAndDeps - (Just $ Cabal.unUnqualComponentName $ exeName exe) + component (dirs ++ [dir]) (map DotCabalModule (otherModules build) ++ [DotCabalMain (modulePath exe)]) @@ -856,13 +879,15 @@ executableFiles exe = do -- | Get all files referenced by the library. libraryFiles - :: Library -> RIO Ctx (Map ModuleName (Path Abs File), Set DotCabalPath, [PackageWarning]) -libraryFiles lib = do + :: NamedComponent + -> Library + -> RIO Ctx (Map ModuleName (Path Abs File), Set DotCabalPath, [PackageWarning]) +libraryFiles component lib = do dirs <- mapMaybeM resolveDirOrWarn (hsSourceDirs build) dir <- asks (parent . ctxFile) (modules,files,warnings) <- resolveFilesAndDeps - Nothing + component (dirs ++ [dir]) names haskellModuleExts @@ -1066,7 +1091,7 @@ depRange (Dependency _ r) = r -- extensions, plus find any of their module and TemplateHaskell -- dependencies. resolveFilesAndDeps - :: Maybe String -- ^ Package component name + :: NamedComponent -- ^ Package component name -> [Path Abs Dir] -- ^ Directories to look in. -> [DotCabalDescriptor] -- ^ Base names. -> [Text] -- ^ Extensions. @@ -1146,7 +1171,7 @@ resolveFilesAndDeps component dirs names0 exts = do -- | Get the dependencies of a Haskell module file. getDependencies - :: Maybe String -> DotCabalPath -> RIO Ctx (Set ModuleName, [Path Abs File]) + :: NamedComponent -> DotCabalPath -> RIO Ctx (Set ModuleName, [Path Abs File]) getDependencies component dotCabalPath = case dotCabalPath of DotCabalModulePath resolvedFile -> readResolvedHi resolvedFile @@ -1155,7 +1180,7 @@ getDependencies component dotCabalPath = DotCabalCFilePath{} -> return (S.empty, []) where readResolvedHi resolvedFile = do - dumpHIDir <- getDumpHIDir + dumpHIDir <- componentOutputDir component <$> asks ctxDistDir dir <- asks (parent . ctxFile) case stripProperPrefix dir resolvedFile of Nothing -> return (S.empty, []) @@ -1168,9 +1193,6 @@ getDependencies component dotCabalPath = if dumpHIExists then parseDumpHI dumpHIPath else return (S.empty, []) - getDumpHIDir = do - bld <- asks ctxDir - return $ maybe bld (bld ) (getBuildComponentDir component) -- | Parse a .dump-hi file into a set of modules and files. parseDumpHI diff --git a/src/Stack/Types/NamedComponent.hs b/src/Stack/Types/NamedComponent.hs index 1199727d03..eeae1152ec 100644 --- a/src/Stack/Types/NamedComponent.hs +++ b/src/Stack/Types/NamedComponent.hs @@ -17,9 +17,7 @@ module Stack.Types.NamedComponent import Stack.Prelude import Stack.Types.PackageName import qualified Data.Set as Set -import Data.ByteString (ByteString) import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8, decodeUtf8) -- | A single, fully resolved component of a package data NamedComponent @@ -29,17 +27,17 @@ data NamedComponent | CBench !Text deriving (Show, Eq, Ord) -renderComponent :: NamedComponent -> ByteString +renderComponent :: NamedComponent -> Text renderComponent CLib = "lib" -renderComponent (CExe x) = "exe:" <> encodeUtf8 x -renderComponent (CTest x) = "test:" <> encodeUtf8 x -renderComponent (CBench x) = "bench:" <> encodeUtf8 x +renderComponent (CExe x) = "exe:" <> x +renderComponent (CTest x) = "test:" <> x +renderComponent (CBench x) = "bench:" <> x renderPkgComponents :: [(PackageName, NamedComponent)] -> Text renderPkgComponents = T.intercalate " " . map renderPkgComponent renderPkgComponent :: (PackageName, NamedComponent) -> Text -renderPkgComponent (pkg, comp) = packageNameText pkg <> ":" <> decodeUtf8 (renderComponent comp) +renderPkgComponent (pkg, comp) = packageNameText pkg <> ":" <> renderComponent comp exeComponents :: Set NamedComponent -> Set Text exeComponents = Set.fromList . mapMaybe mExeName . Set.toList diff --git a/src/Stack/Types/Package.hs b/src/Stack/Types/Package.hs index 8591fe40b1..1f7fda4054 100644 --- a/src/Stack/Types/Package.hs +++ b/src/Stack/Types/Package.hs @@ -141,7 +141,7 @@ data BuildInfoOpts = BuildInfoOpts -- ^ These options can safely have 'nubOrd' applied to them, as -- there are no multi-word options (see -- https://github.com/commercialhaskell/stack/issues/1255) - , bioCabalMacros :: Maybe (Path Abs File) + , bioCabalMacros :: Path Abs File } deriving Show -- | Files to get for a cabal package. @@ -165,7 +165,7 @@ instance Show GetPackageFiles where -- | Warning generated when reading a package data PackageWarning - = UnlistedModulesWarning (Maybe String) [ModuleName] + = UnlistedModulesWarning NamedComponent [ModuleName] -- ^ Modules found that are not listed in cabal file -- TODO: bring this back - see