Add a stack-developer-mode flag #5134

Author: snoyberg

ChangeLog.md

@@ -13,6 +13,8 @@ Behavior changes:
 
 Other enhancements:
 
+* Add the `stack-developer-mode` flag
+
 Bug fixes:
 
 * When using the `STACK_YAML` env var with Docker, make the path absolute.

doc/yaml_configuration.md

@@ -1187,3 +1187,13 @@ recommend-stack-upgrade: true
 ```
 
 Since 2.0
+
+### stack-developer-mode
+
+Turns on a mode where some messages are printed at WARN level instead of DEBUG level, especially useful for developers of Stack itself. For official distributed binaries, this is set to `false` by default. When you build from source, it is set to `true` by default.
+
+```yaml
+stack-developer-mode: false
+```
+
+Since 2.3.3

etc/scripts/release.hs

@@ -91,7 +91,7 @@ main =
                 gUploadLabel = Nothing
                 gTestHaddocks = True
                 gProjectRoot = "" -- Set to real value velow.
-                gBuildArgs = []
+                gBuildArgs = ["--flag", "stack:-developer-mode"]
                 gCertificateName = Nothing
                 gUploadOnly = False
                 global0 = foldl (flip id) Global{..} flags

package.yaml

@@ -141,6 +141,11 @@ when:
     - hsc2hs
     dependencies:
     - unix
+- condition: flag(developer-mode)
+  then:
+    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=True
+  else:
+    cpp-options: -DSTACK_DEVELOPER_MODE_DEFAULT=False
 library:
   source-dirs: src/
   ghc-options:
@@ -348,3 +353,7 @@ flags:
       requests more difficult."
     manual: true
     default: false
+  developer-mode:
+    description: "By default, should extra developer information be output?"
+    manual: true
+    default: false

src/Stack/Config.hs

@@ -371,6 +371,9 @@ configFromConfigMonoid
              Nothing -> throwString $ "Failed to parse PANTRY_ROOT environment variable (expected absolute directory): " ++ show dir
              Just x -> pure x
          Nothing -> pure $ configStackRoot </> relDirPantry
+
+     let configStackDeveloperMode = fromFirst stackDeveloperModeDefault configMonoidStackDeveloperMode
+
      withPantryConfig
        pantryRoot
        hsc

src/Stack/Constants.hs

@@ -120,6 +120,7 @@ module Stack.Constants
     ,usrLibDirs
     ,testGhcEnvRelFile
     ,relFileBuildLock
+    ,stackDeveloperModeDefault
     )
     where
 
@@ -555,3 +556,7 @@ testGhcEnvRelFile = $(mkRelFile "test-ghc-env")
 -- | File inside a dist directory to use for locking
 relFileBuildLock :: Path Rel File
 relFileBuildLock = $(mkRelFile "build-lock")
+
+-- | What should the default be for stack-developer-mode
+stackDeveloperModeDefault :: Bool
+stackDeveloperModeDefault = STACK_DEVELOPER_MODE_DEFAULT

src/Stack/Package.hs

@@ -1100,7 +1100,7 @@ parseHI hiPath = do
   result <- liftIO $ Iface.fromFile hiPath
   case result of
     Left msg -> do
-      prettyWarnL
+      prettyStackDevL
         [ flow "Failed to decode module interface:"
         , style File $ fromString hiPath
         , flow "Decoding failure:"

src/Stack/Types/Config.hs

@@ -169,6 +169,8 @@ module Stack.Types.Config
   ,envOverrideSettingsL
   ,shouldForceGhcColorFlag
   ,appropriateGhcColorFlag
+  -- * Helper logging functions
+  ,prettyStackDevL
   -- * Lens reexport
   ,view
   ,to
@@ -214,7 +216,7 @@ import           Pantry.Internal (Storage)
 import           Path
 import qualified Paths_stack as Meta
 import qualified RIO.List as List
-import           RIO.PrettyPrint (HasTerm (..))
+import           RIO.PrettyPrint (HasTerm (..), StyleDoc, prettyWarnL, prettyDebugL)
 import           RIO.PrettyPrint.StylesUpdate (StylesUpdate,
                      parseStylesUpdateFromString, HasStylesUpdate (..))
 import           Stack.Constants
@@ -377,6 +379,8 @@ data Config =
          -- ^ Enable GHC hiding source paths?
          ,configRecommendUpgrade    :: !Bool
          -- ^ Recommend a Stack upgrade?
+         ,configStackDeveloperMode  :: !Bool
+         -- ^ Turn on Stack developer mode for additional messages?
          }
 
 -- | A bit of type safety to ensure we're talking to the right database.
@@ -859,6 +863,8 @@ data ConfigMonoid =
     , configMonoidRecommendUpgrade   :: !FirstTrue
     -- ^ See 'configRecommendUpgrade'
     , configMonoidCasaRepoPrefix     :: !(First CasaRepoPrefix)
+    , configMonoidStackDeveloperMode :: !(First Bool)
+    -- ^ See 'configStackDeveloperMode'
     }
   deriving (Show, Generic)
 
@@ -983,6 +989,8 @@ parseConfigMonoidObject rootDir obj = do
 
     configMonoidCasaRepoPrefix <- First <$> obj ..:? configMonoidCasaRepoPrefixName
 
+    configMonoidStackDeveloperMode <- First <$> obj ..:? configMonoidStackDeveloperModeName
+
     return ConfigMonoid {..}
   where
     handleExplicitSetupDep :: (Monad m, MonadFail m) => (Text, Bool) -> m (Maybe PackageName, Bool)
@@ -1148,6 +1156,9 @@ configMonoidRecommendUpgradeName = "recommend-stack-upgrade"
 configMonoidCasaRepoPrefixName :: Text
 configMonoidCasaRepoPrefixName = "casa-repo-prefix"
 
+configMonoidStackDeveloperModeName :: Text
+configMonoidStackDeveloperModeName = "stack-developer-mode"
+
 data ConfigException
   = ParseConfigFileException (Path Abs File) ParseException
   | ParseCustomSnapshotException Text ParseException
@@ -2126,3 +2137,11 @@ terminalL = globalOptsL.lens globalTerminal (\x y -> x { globalTerminal = y })
 -- | See 'globalReExecVersion'
 reExecL :: HasRunner env => SimpleGetter env Bool
 reExecL = globalOptsL.to (isJust . globalReExecVersion)
+
+-- | In dev mode, print as a warning, otherwise as debug
+prettyStackDevL :: HasConfig env => [StyleDoc] -> RIO env ()
+prettyStackDevL docs = do
+  config <- view configL
+  if configStackDeveloperMode config
+    then prettyWarnL docs
+    else prettyDebugL docs

stack-ghc-84.yaml

@@ -3,6 +3,10 @@ resolver: lts-12.26
 packages:
 - .
 
+flags:
+  stack:
+    developer-mode: true
+
 docker:
   enable: false
   repo: fpco/stack-build-small:lts-12.26

stack-ghc-88.yaml

@@ -16,6 +16,7 @@ flags:
   stack:
     hide-dependency-versions: true
     supported-build: true
+    developer-mode: true
 
 ghc-options:
    "$locals": -fhide-source-paths