Merge pull request #6547 from commercialhaskell/fix6546

Fix #6546 Add `stack config set recommend-stack-upgrade`

ChangeLog.md

@@ -48,6 +48,9 @@ Other enhancements:
   was modified manually. In YAML configuration files, the `hpack-force` key is
   introduced to allow Hpack to overwrite such a Cabal file. The corresponding
   `--hpack-force` flag is also added.
+* Add the `stack config set recommend-stack-upgrade` command to configure
+  whether or not Stack should notify the user if it identifes a new version of
+  Stack is available in YAML configuration files.
 
 Bug fixes:
 

doc/config_command.md

@@ -46,14 +46,16 @@ the [project Stack work directory](stack_work.md#project-stack-work-directory).
 stack config set COMMAND
 
 Available commands:
-  install-ghc              Configure whether Stack should automatically install
-                           GHC when necessary.
+  install-ghc              Configure whether or not Stack should automatically
+                           install GHC when necessary.
   package-index            Configure Stack's package index
+  recommend-stack-upgrade  Configure whether or not Stack should notify the user
+                           if it identifes a new version of Stack is available.
   resolver                 Change the snapshot of the current project, using the
                            resolver key.
   snapshot                 Change the snapshot of the current project.
-  system-ghc               Configure whether Stack should use a system GHC
-                           installation or not.
+  system-ghc               Configure whether or not Stack should use a system
+                           GHC installation.
 ~~~
 
 The `stack config set` commands allow the values of keys in YAML configuration
@@ -65,10 +67,11 @@ files to be set. See `stack config set` for the available keys.
 stack config set install-ghc [--global] true|false
 ~~~
 
-`stack config set install-ghc true` or `false` sets the `install-ghc` key in a
-YAML configuration file, accordingly. By default, the project-level
-configuration file (`stack.yaml`, by default) is altered. The `--global` flag
-specifies the user-specific global configuration file (`config.yaml`).
+`stack config set install-ghc true` or `false` sets the
+[`install-ghc`](yaml_configuration.md#install-ghc) key in a YAML configuration
+file, accordingly. By default, the project-level configuration file
+(`stack.yaml`, by default) is altered. The `--global` flag specifies the
+user-specific global configuration file (`config.yaml`).
 
 ## The `stack config set package-index download-prefix` command
 
@@ -79,10 +82,23 @@ stack config set package-index download-prefix [--global] [URL]
 ~~~
 
 `stack config set package-index download-prefix <url>` sets the
-`download-prefix` key of the `package-index` key in a YAML configuration file,
-accordingly. By default, the project-level configuration file (`stack.yaml`, by
-default) is altered. The `--global` flag specifies the user-specific global
-configuration file (`config.yaml`).
+`download-prefix` key of the
+[`package-index`](yaml_configuration.md#package-index) key in a YAML
+configuration file, accordingly. By default, the project-level configuration
+file (`stack.yaml`, by default) is altered. The `--global` flag specifies the
+user-specific global configuration file (`config.yaml`).
+
+## The `stack config set recommend-stack-upgrade` command
+
+~~~text
+stack config set recommend-stack-upgrade [--project] true|false
+~~~
+
+`stack config set recommend-stack-upgrade true` or `false` sets the
+[`recommend-stack-upgrade`](yaml_configuration.md#recommend-stack-upgrade) key
+in a YAML configuration file, accordingly. By default, the user-specific global
+configuration file (`config.yaml`) is altered. The `--project` flag specifies
+the project-level configuration file (`stack.yaml`, by default).
 
 ## The `stack config set resolver` command
 
@@ -102,9 +118,9 @@ but using the `resolver` key instead of the `snapshot` key.
 stack config set snapshot SNAPSHOT
 ~~~
 
-`stack config set snapshot <snapshot>` sets the `snapshot` key in the
-project-level configuration file (`stack.yaml`, by default) to the specified
-snapshot.
+`stack config set snapshot <snapshot>` sets the
+[`snapshot`](yaml_configuration.md#snapshot) key in the project-level
+configuration file (`stack.yaml`, by default) to the specified snapshot.
 
 A snapshot of `lts` or `nightly` will be translated into the most recent
 available. A snapshot of `lts-22` will be translated into the most recent
@@ -118,7 +134,8 @@ If a `resolver` key is present, it will be replaced by a `snapshot` key.
 stack config set system-ghc [--global] true|false
 ~~~
 
-`stack config set system-ghc true` or `false` sets the `system-ghc` key in a
-YAML configuration file, accordingly. By default, the project-level
-configuration file (`stack.yaml`, by default) is altered. The `--global` flag
-specifies the user-specific global configuration file (`config.yaml`).
+`stack config set system-ghc true` or `false` sets the
+[`system-ghc`](yaml_configuration.md#system-ghc) key in a YAML configuration
+file, accordingly. By default, the project-level configuration file
+(`stack.yaml`, by default) is altered. The `--global` flag specifies the
+user-specific global configuration file (`config.yaml`).

src/Stack/Config.hs

@@ -463,7 +463,7 @@ configFromConfigMonoid
         hackageBaseUrl =
           fromFirst Constants.hackageBaseUrl configMonoid.hackageBaseUrl
         hideSourcePaths = fromFirstTrue configMonoid.hideSourcePaths
-        recommendUpgrade = fromFirstTrue configMonoid.recommendUpgrade
+        recommendStackUpgrade = fromFirstTrue configMonoid.recommendStackUpgrade
         notifyIfNixOnPath = fromFirstTrue configMonoid.notifyIfNixOnPath
         notifyIfGhcUntested = fromFirstTrue configMonoid.notifyIfGhcUntested
         notifyIfCabalUntested = fromFirstTrue configMonoid.notifyIfCabalUntested
@@ -622,7 +622,7 @@ configFromConfigMonoid
                 , snapshot
                 , userStorage
                 , hideSourcePaths
-                , recommendUpgrade
+                , recommendStackUpgrade
                 , notifyIfNixOnPath
                 , notifyIfGhcUntested
                 , notifyIfCabalUntested

src/Stack/ConfigCmd.hs

@@ -42,7 +42,10 @@ import           Stack.Constants ( stackDotYaml )
 import           Stack.Prelude
 import           Stack.Types.Config ( Config (..), HasConfig (..) )
 import           Stack.Types.ConfigMonoid
-                   ( configMonoidInstallGHCName, configMonoidSystemGHCName )
+                   ( configMonoidInstallGHCName
+                   , configMonoidRecommendStackUpgradeName
+                   , configMonoidSystemGHCName
+                   )
 import           Stack.Types.EnvConfig ( EnvConfig )
 import           Stack.Types.EnvSettings ( EnvSettings (..) )
 import           Stack.Types.GHCVariant ( HasGHCVariant )
@@ -68,6 +71,7 @@ data ConfigCmdSet
   | ConfigCmdSetResolver !(Unresolved AbstractSnapshot)
   | ConfigCmdSetSystemGhc !CommandScope !Bool
   | ConfigCmdSetInstallGhc !CommandScope !Bool
+  | ConfigCmdSetRecommendStackUpgrade !CommandScope !Bool
   | ConfigCmdSetDownloadPrefix !CommandScope !Text
 
 data CommandScope
@@ -82,6 +86,7 @@ configCmdSetScope (ConfigCmdSetSnapshot _) = CommandScopeProject
 configCmdSetScope (ConfigCmdSetResolver _) = CommandScopeProject
 configCmdSetScope (ConfigCmdSetSystemGhc scope _) = scope
 configCmdSetScope (ConfigCmdSetInstallGhc scope _) = scope
+configCmdSetScope (ConfigCmdSetRecommendStackUpgrade scope _) = scope
 configCmdSetScope (ConfigCmdSetDownloadPrefix scope _) = scope
 
 cfgCmdSet ::
@@ -255,6 +260,8 @@ cfgCmdSetValue root (ConfigCmdSetResolver newSnapshot) =
   snapshotValue root newSnapshot
 cfgCmdSetValue _ (ConfigCmdSetSystemGhc _ bool') = pure $ Yaml.Bool bool'
 cfgCmdSetValue _ (ConfigCmdSetInstallGhc _ bool') = pure $ Yaml.Bool bool'
+cfgCmdSetValue _ (ConfigCmdSetRecommendStackUpgrade _ bool') =
+  pure $ Yaml.Bool bool'
 cfgCmdSetValue _ (ConfigCmdSetDownloadPrefix _ url) = pure $ Yaml.String url
 
 snapshotValue ::
@@ -274,6 +281,8 @@ cfgCmdSetKeys (ConfigCmdSetSnapshot _) = [["snapshot"], ["resolver"]]
 cfgCmdSetKeys (ConfigCmdSetResolver _) = [["resolver"], ["snapshot"]]
 cfgCmdSetKeys (ConfigCmdSetSystemGhc _ _) = [[configMonoidSystemGHCName]]
 cfgCmdSetKeys (ConfigCmdSetInstallGhc _ _) = [[configMonoidInstallGHCName]]
+cfgCmdSetKeys (ConfigCmdSetRecommendStackUpgrade _ _) =
+  [[configMonoidRecommendStackUpgradeName]]
 cfgCmdSetKeys (ConfigCmdSetDownloadPrefix _ _) =
   [["package-index", "download-prefix"]]
 
@@ -312,26 +321,34 @@ configCmdSetParser =
       , OA.command (T.unpack configMonoidSystemGHCName)
           ( OA.info
               (   ConfigCmdSetSystemGhc
-              <$> scopeFlag
+              <$> globalScopeFlag
               <*> boolArgument )
               ( OA.progDesc
-                  "Configure whether Stack should use a system GHC \
-                  \installation or not." ))
+                  "Configure whether or not Stack should use a system GHC \
+                  \installation." ))
       , OA.command (T.unpack configMonoidInstallGHCName)
           ( OA.info
               (   ConfigCmdSetInstallGhc
-              <$> scopeFlag
+              <$> globalScopeFlag
               <*> boolArgument )
               ( OA.progDesc
-                  "Configure whether Stack should automatically install \
+                  "Configure whether or not Stack should automatically install \
                   \GHC when necessary." ))
+      , OA.command (T.unpack configMonoidRecommendStackUpgradeName)
+          ( OA.info
+              (   ConfigCmdSetRecommendStackUpgrade
+              <$> projectScopeFlag
+              <*> boolArgument )
+              ( OA.progDesc
+                  "Configure whether or not Stack should notify the user if it \
+                  \identifes a new version of Stack is available." ))
       , OA.command "package-index"
           ( OA.info
               ( OA.hsubparser $
                   OA.command "download-prefix"
                     ( OA.info
                         (   ConfigCmdSetDownloadPrefix
-                        <$> scopeFlag
+                        <$> globalScopeFlag
                         <*> urlArgument )
                         ( OA.progDesc
                             "Configure download prefix for Stack's package \
@@ -340,8 +357,8 @@ configCmdSetParser =
                   "Configure Stack's package index" ))
       ]
 
-scopeFlag :: OA.Parser CommandScope
-scopeFlag = OA.flag
+globalScopeFlag :: OA.Parser CommandScope
+globalScopeFlag = OA.flag
   CommandScopeProject
   CommandScopeGlobal
   (  OA.long "global"
@@ -350,6 +367,16 @@ scopeFlag = OA.flag
        \instead of the project-level configuration file ('stack.yaml')."
   )
 
+projectScopeFlag :: OA.Parser CommandScope
+projectScopeFlag = OA.flag
+  CommandScopeGlobal
+  CommandScopeProject
+  (  OA.long "project"
+  <> OA.help
+       "Modify the project-level configuration file ('stack.yaml') instead of \
+       \the user-specific global configuration file ('config.yaml')."
+  )
+
 readBool :: OA.ReadM Bool
 readBool = do
   s <- OA.readerAsk

src/Stack/Runners.hs

@@ -253,7 +253,7 @@ withRunnerGlobal go inner = do
 shouldUpgradeCheck :: RIO Config ()
 shouldUpgradeCheck = do
   config <- ask
-  when config.recommendUpgrade $ do
+  when config.recommendStackUpgrade $ do
     now <- getCurrentTime
     let yesterday = addUTCTime (-(24 * 60 * 60)) now
     checks <- upgradeChecksSince yesterday

src/Stack/Types/Config.hs

@@ -185,7 +185,7 @@ data Config = Config
     -- ^ Database connection pool for user Stack database
   , hideSourcePaths        :: !Bool
     -- ^ Enable GHC hiding source paths?
-  , recommendUpgrade       :: !Bool
+  , recommendStackUpgrade  :: !Bool
     -- ^ Recommend a Stack upgrade?
   , notifyIfNixOnPath      :: !Bool
     -- ^ Notify if the Nix package manager (nix) is on the PATH, but

src/Stack/Types/ConfigMonoid.hs

@@ -11,6 +11,7 @@ module Stack.Types.ConfigMonoid
   , configMonoidAllowDifferentUserName
   , configMonoidGHCVariantName
   , configMonoidInstallGHCName
+  , configMonoidRecommendStackUpgradeName
   , configMonoidSystemGHCName
   ) where
 
@@ -174,8 +175,8 @@ data ConfigMonoid = ConfigMonoid
   , styles             :: !StylesUpdate
   , hideSourcePaths    :: !FirstTrue
     -- ^ See 'configHideSourcePaths'
-  , recommendUpgrade   :: !FirstTrue
-    -- ^ See 'configRecommendUpgrade'
+  , recommendStackUpgrade   :: !FirstTrue
+    -- ^ See 'configRecommendStackUpgrade'
   , notifyIfNixOnPath  :: !FirstTrue
     -- ^ See 'configNotifyIfNixOnPath'
   , notifyIfGhcUntested  :: !FirstTrue
@@ -325,7 +326,8 @@ parseConfigMonoidObject rootDir obj = do
   configMonoidStylesGB <- obj ..:? configMonoidStylesGBName
   let styles = fromMaybe mempty $ configMonoidStylesUS <|> configMonoidStylesGB
   hideSourcePaths <- FirstTrue <$> obj ..:? configMonoidHideSourcePathsName
-  recommendUpgrade <- FirstTrue <$> obj ..:? configMonoidRecommendUpgradeName
+  recommendStackUpgrade <-
+    FirstTrue <$> obj ..:? configMonoidRecommendStackUpgradeName
   notifyIfNixOnPath <- FirstTrue <$> obj ..:? configMonoidNotifyIfNixOnPathName
   notifyIfGhcUntested <-
     FirstTrue <$> obj ..:? configMonoidNotifyIfGhcUntestedName
@@ -396,7 +398,7 @@ parseConfigMonoidObject rootDir obj = do
     , colorWhen
     , styles
     , hideSourcePaths
-    , recommendUpgrade
+    , recommendStackUpgrade
     , notifyIfNixOnPath
     , notifyIfGhcUntested
     , notifyIfCabalUntested
@@ -574,8 +576,8 @@ configMonoidStylesGBName = "stack-colours"
 configMonoidHideSourcePathsName :: Text
 configMonoidHideSourcePathsName = "hide-source-paths"
 
-configMonoidRecommendUpgradeName :: Text
-configMonoidRecommendUpgradeName = "recommend-stack-upgrade"
+configMonoidRecommendStackUpgradeName :: Text
+configMonoidRecommendStackUpgradeName = "recommend-stack-upgrade"
 
 configMonoidNotifyIfNixOnPathName :: Text
 configMonoidNotifyIfNixOnPathName = "notify-if-nix-on-path"