diff --git a/ChangeLog.md b/ChangeLog.md index 013308e54f..8e61afd805 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -178,6 +178,9 @@ Other enhancements: packages. See [#2465](https://github.com/commercialhaskell/stack/issues/2465) * Store caches in SQLite database instead of files. * No longer use "global" Docker image database (`docker.db`). +* User config files are respected for the script command. See + [#3705](https://github.com/commercialhaskell/stack/issues/3705), + [#3887](https://github.com/commercialhaskell/stack/issues/3887). Bug fixes: diff --git a/src/Stack/Build/Target.hs b/src/Stack/Build/Target.hs index 9d71a89d9f..6f5875ae28 100644 --- a/src/Stack/Build/Target.hs +++ b/src/Stack/Build/Target.hs @@ -479,4 +479,4 @@ parseTargets needTargets haddockDeps boptscli smActual = do case configProject $ bcConfig bconfig of PCProject _ -> False PCGlobalProject -> True - PCNoConfig _ -> False + PCNoProject _ -> False diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs index d9c84f6e93..9afb1e558d 100644 --- a/src/Stack/Config.hs +++ b/src/Stack/Config.hs @@ -36,7 +36,6 @@ import Control.Monad.Extra (firstJustM) import Stack.Prelude import Data.Aeson.Extended import qualified Data.ByteString as S -import Data.ByteString.Builder (toLazyByteString) import Data.Coerce (coerce) import qualified Data.IntMap as IntMap import qualified Data.Map as Map @@ -53,7 +52,6 @@ import GHC.Conc (getNumProcessors) import Lens.Micro ((.~)) import Network.HTTP.StackClient (httpJSON, parseUrlThrow, getResponseBody) import Options.Applicative (Parser, strOption, long, help) -import qualified Pantry.SHA256 as SHA256 import Path import Path.Extra (toFilePathNoTrailingSep) import Path.Find (findInParents) @@ -174,41 +172,18 @@ getLatestResolver = do listToMaybe (reverse (IntMap.toList (snapshotsLts snapshots))) pure $ fromMaybe (nightlySnapshotLocation (snapshotsNightly snapshots)) mlts --- | Create a 'Config' value when we're not using any local --- configuration files (e.g., the script command) -configNoLocalConfig - :: HasRunner env - => Path Abs Dir -- ^ stack root - -> Maybe AbstractResolver - -> ConfigMonoid - -> [PackageIdentifierRevision] - -> (Config -> RIO env a) - -> RIO env a -configNoLocalConfig _ Nothing _ _ _ = throwIO NoResolverWhenUsingNoLocalConfig -configNoLocalConfig stackRoot (Just resolver) configMonoid extraDeps inner = do - userConfigPath <- liftIO $ getFakeConfigPath stackRoot resolver - configFromConfigMonoid - stackRoot - userConfigPath - False - (Just resolver) - (PCNoConfig extraDeps) - configMonoid - inner - -- Interprets ConfigMonoid options. configFromConfigMonoid :: HasRunner env => Path Abs Dir -- ^ stack root, e.g. ~/.stack -> Path Abs File -- ^ user config file path, e.g. ~/.stack/config.yaml - -> Bool -- ^ allow locals? -> Maybe AbstractResolver -> ProjectConfig (Project, Path Abs File) -> ConfigMonoid -> (Config -> RIO env a) -> RIO env a configFromConfigMonoid - configStackRoot configUserConfigPath configAllowLocals configResolver + configStackRoot configUserConfigPath configResolver configProject ConfigMonoid{..} inner = do -- If --stack-work is passed, prefer it. Otherwise, if STACK_WORK -- is set, use that. If neither, use the default ".stack-work" @@ -217,7 +192,12 @@ configFromConfigMonoid case configProject of PCProject pair -> Just pair PCGlobalProject -> Nothing - PCNoConfig _deps -> Nothing + PCNoProject _deps -> Nothing + configAllowLocals = + case configProject of + PCProject _ -> True + PCGlobalProject -> True + PCNoProject _ -> False configWorkDir0 <- maybe (return relDirStackWork) (liftIO . parseRelDir) mstackWorkEnv let configWorkDir = fromFirst configWorkDir0 configMonoidWorkDir configLatestSnapshot = fromFirst @@ -411,31 +391,25 @@ loadConfig inner = do case mproject of PCProject (proj, fp, cm) -> (PCProject (proj, fp), (cm:)) PCGlobalProject -> (PCGlobalProject, id) - PCNoConfig deps -> (PCNoConfig deps, id) - let loadHelper inner2 = do - userConfigPath <- getDefaultUserConfigPath stackRoot - extraConfigs0 <- getExtraConfigs userConfigPath >>= - mapM (\file -> loadConfigYaml (parseConfigMonoid (parent file)) file) - let extraConfigs = - -- non-project config files' existence of a docker section should never default docker - -- to enabled, so make it look like they didn't exist - map (\c -> c {configMonoidDockerOpts = - (configMonoidDockerOpts c) {dockerMonoidDefaultEnable = Any False}}) - extraConfigs0 - + PCNoProject deps -> (PCNoProject deps, id) + + userConfigPath <- getDefaultUserConfigPath stackRoot + extraConfigs0 <- getExtraConfigs userConfigPath >>= + mapM (\file -> loadConfigYaml (parseConfigMonoid (parent file)) file) + let extraConfigs = + -- non-project config files' existence of a docker section should never default docker + -- to enabled, so make it look like they didn't exist + map (\c -> c {configMonoidDockerOpts = + (configMonoidDockerOpts c) {dockerMonoidDefaultEnable = Any False}}) + extraConfigs0 + + let withConfig = configFromConfigMonoid stackRoot userConfigPath - True -- allow locals mresolver mproject' (mconcat $ configArgs : addConfigMonoid extraConfigs) - inner2 - - let withConfig = case mproject of - PCNoConfig extraDeps -> configNoLocalConfig stackRoot mresolver configArgs extraDeps - PCProject _project -> loadHelper - PCGlobalProject -> loadHelper withConfig $ \config -> do unless (mkVersion' Meta.version `withinRange` configRequireStackVersion config) @@ -469,8 +443,11 @@ loadBuildConfig = do PCProject (project, fp) -> do forM_ (projectUserMsg project) (logWarn . fromString) return (project, fp) - PCNoConfig extraDeps -> do - p <- assert (isJust mresolver) (getEmptyProject mresolver extraDeps) + PCNoProject extraDeps -> do + p <- + case mresolver of + Nothing -> throwIO NoResolverWhenUsingNoProject + Just _ -> getEmptyProject mresolver extraDeps return (p, configUserConfigPath config) PCGlobalProject -> do logDebug "Run from outside a project, using implicit global project config" @@ -779,7 +756,7 @@ getProjectConfig SYLDefault = do if exists then return $ Just fp else return Nothing -getProjectConfig (SYLNoConfig extraDeps) = return $ PCNoConfig extraDeps +getProjectConfig (SYLNoProject extraDeps) = return $ PCNoProject extraDeps -- | Find the project config file location, respecting environment variables -- and otherwise traversing parents. If no config is found, we supply a default @@ -799,9 +776,9 @@ loadProjectConfig mstackYaml = do PCGlobalProject -> do logDebug "No project config file found, using defaults." return PCGlobalProject - PCNoConfig extraDeps -> do + PCNoProject extraDeps -> do logDebug "Ignoring config files" - return $ PCNoConfig extraDeps + return $ PCNoProject extraDeps where load fp = do iopc <- loadConfigYaml (parseProjectAndConfigMonoid (parent fp)) fp @@ -843,29 +820,6 @@ getDefaultUserConfigPath stackRoot = do liftIO $ S.writeFile (toFilePath path) defaultConfigYaml return path --- | Get a fake configuration file location, used when doing a "no --- config" run (the script command). -getFakeConfigPath - :: (MonadIO m, MonadThrow m) - => Path Abs Dir -- ^ stack root - -> AbstractResolver - -> m (Path Abs File) -getFakeConfigPath stackRoot ar = do - asString <- - case ar of - ARResolver r -> pure $ T.unpack $ SHA256.toHexText $ SHA256.hashLazyBytes $ toLazyByteString $ getUtf8Builder $ display r - _ -> throwM $ InvalidResolverForNoLocalConfig $ show ar - -- This takeWhile is an ugly hack. We don't actually need this - -- path for anything useful. But if we take the raw value for - -- a custom snapshot, it will be unparseable in a PATH. - -- Therefore, we add in this silly "strip up to :". - -- Better would be to defer figuring out this value until - -- after we have a fully loaded snapshot with a hash. - asDir <- parseRelDir $ takeWhile (/= ':') asString - let full = stackRoot relDirScript asDir relFileConfigYaml - ensureDir (parent full) - return full - packagesParser :: Parser [String] packagesParser = many (strOption (long "package" <> help "Additional packages that must be installed")) diff --git a/src/Stack/ConfigCmd.hs b/src/Stack/ConfigCmd.hs index 7a34f14b7a..ca3298c839 100644 --- a/src/Stack/ConfigCmd.hs +++ b/src/Stack/ConfigCmd.hs @@ -67,7 +67,7 @@ cfgCmdSet cmd = do case mstackYaml of PCProject stackYaml -> return stackYaml PCGlobalProject -> liftM ( stackDotYaml) (getImplicitGlobalProjectDir conf) - PCNoConfig _extraDeps -> throwString "config command used when no local configuration available" + PCNoProject _extraDeps -> throwString "config command used when no project configuration available" -- maybe modify the ~/.stack/config.yaml file instead? CommandScopeGlobal -> return (configUserConfigPath conf) -- We don't need to worry about checking for a valid yaml here (config :: Yaml.Object) <- diff --git a/src/Stack/Freeze.hs b/src/Stack/Freeze.hs index bdba5b517e..c751b3145d 100644 --- a/src/Stack/Freeze.hs +++ b/src/Stack/Freeze.hs @@ -27,7 +27,7 @@ freeze (FreezeOpts mode) = do case mproject of PCProject (p, _) -> doFreeze p mode PCGlobalProject -> warn - PCNoConfig _ -> warn + PCNoProject _ -> warn doFreeze :: (HasProcessContext env, HasLogFunc env, HasPantryConfig env) diff --git a/src/Stack/Options/Completion.hs b/src/Stack/Options/Completion.hs index 6b7eb6a211..b4c760d908 100644 --- a/src/Stack/Options/Completion.hs +++ b/src/Stack/Options/Completion.hs @@ -86,7 +86,7 @@ flagCompleter = buildConfigCompleter $ \input -> do case configProject (bcConfig bconfig) of PCProject (p, _) -> projectFlags p PCGlobalProject -> mempty - PCNoConfig _ -> mempty + PCNoProject _ -> mempty flagEnabled name fl = fromMaybe (C.flagDefault fl) $ Map.lookup (C.flagName fl) $ diff --git a/src/Stack/Script.hs b/src/Stack/Script.hs index 54518b1819..a44701d8d5 100644 --- a/src/Stack/Script.hs +++ b/src/Stack/Script.hs @@ -68,7 +68,7 @@ scriptCmd opts = do fromString (toFilePath fp) SYLGlobalProject -> logError "Ignoring SYLGlobalProject for script command" SYLDefault -> return () - SYLNoConfig _ -> assert False (return ()) + SYLNoProject _ -> assert False (return ()) file <- resolveFile' $ soFile opts let scriptDir = parent file @@ -76,7 +76,7 @@ scriptCmd opts = do { globalConfigMonoid = (globalConfigMonoid go) { configMonoidInstallGHC = FirstTrue $ Just True } - , globalStackYaml = SYLNoConfig $ soScriptExtraDeps opts + , globalStackYaml = SYLNoProject $ soScriptExtraDeps opts } -- Optimization: if we're compiling, and the executable is newer diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs index 6e51ca8d04..fb3ea38dfd 100644 --- a/src/Stack/Types/Config.hs +++ b/src/Stack/Types/Config.hs @@ -364,7 +364,7 @@ configProjectRoot c = case configProject c of PCProject (_, fp) -> Just $ parent fp PCGlobalProject -> Nothing - PCNoConfig _deps -> Nothing + PCNoProject _deps -> Nothing -- | Which packages do ghc-options on the command line apply to? data ApplyGhcOptions = AGOTargets -- ^ all local targets @@ -463,8 +463,9 @@ data StackYamlLoc -- ^ Use the standard parent-directory-checking logic | SYLOverride !(Path Abs File) -- ^ Use a specific stack.yaml file provided - | SYLNoConfig ![PackageIdentifierRevision] - -- ^ Extra dependencies included in the script command line. + | SYLNoProject ![PackageIdentifierRevision] + -- ^ Do not load up a project, just user configuration. Include + -- the given extra dependencies with the resolver. | SYLGlobalProject -- ^ Do not look for a project configuration, and use the implicit global. deriving Show @@ -481,9 +482,8 @@ data ProjectConfig a | PCGlobalProject -- ^ No project was found when using 'SYLDefault'. Instead, use -- the implicit global. - | PCNoConfig ![PackageIdentifierRevision] - -- ^ Use a no config run, which explicitly ignores any local - -- configuration values. This comes from 'SYLNoConfig'. + | PCNoProject ![PackageIdentifierRevision] + -- ^ Use a no project run. This comes from 'SYLNoProject'. -- | Parsed global command-line options monoid. data GlobalOptsMonoid = GlobalOptsMonoid @@ -1037,8 +1037,7 @@ data ConfigException | UserDoesn'tOwnDirectory (Path Abs Dir) | ManualGHCVariantSettingsAreIncompatibleWithSystemGHC | NixRequiresSystemGhc - | NoResolverWhenUsingNoLocalConfig - | InvalidResolverForNoLocalConfig String + | NoResolverWhenUsingNoProject | DuplicateLocalPackageNames ![(PackageName, [PackageLocation])] deriving Typeable instance Show ConfigException where @@ -1142,8 +1141,7 @@ instance Show ConfigException where , configMonoidSystemGHCName , "' or disable the Nix integration." ] - show NoResolverWhenUsingNoLocalConfig = "When using the script command, you must provide a resolver argument" - show (InvalidResolverForNoLocalConfig ar) = "The script command requires a specific resolver, you provided " ++ ar + show NoResolverWhenUsingNoProject = "When using the script command, you must provide a resolver argument" show (DuplicateLocalPackageNames pairs) = concat $ "The same package name is used in multiple local packages\n" : map go pairs