Merge pull request #5333 from commercialhaskell/stable-into-master

Stable into master

Author: snoyberg

ChangeLog.md

@@ -27,6 +27,7 @@ Other enhancements:
   [#5280](https://github.com/commercialhaskell/stack/issues/5280)
 * Build failures now show a hint to scroll up to the corresponding section
   [#5279](https://github.com/commercialhaskell/stack/issues/5279)
+* Add the `stack-developer-mode` flag
 
 Bug fixes:
 

doc/yaml_configuration.md

@@ -1188,6 +1188,16 @@ 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
+
 ### snapshot-location-base
 Sets the base location of LTS Haskell/Stackage Nightly snapshots. Default is https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/ (as set in the `pantry` library).
 
@@ -1202,4 +1212,4 @@ has the following effect:
 This field is convenient in setups that restrict access to GitHub, for instance closed corporate setups. In this setting, it is common for the development environment to have general access to the internet, but not for testing/building environments. To avoid the firewall, one can run a local snapshots mirror and then use a custom `snapshot-location-base` in the closed environments only.
 
 
-Since FIXME:
+Since 2.5.0

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

@@ -374,7 +374,7 @@ configFromConfigMonoid
          Nothing -> pure $ configStackRoot </> relDirPantry
 
      let snapLoc =
-            case getFirst configMonoidSnapshotLocation of 
+            case getFirst configMonoidSnapshotLocation of
                 Nothing -> defaultSnapshotLocation
                 Just addr -> customSnapshotLocation
                                 where
@@ -391,6 +391,9 @@ configFromConfigMonoid
                             <> "/" <> display day <> ".yaml"
                     mkRSLUrl builder = RSLUrl (utf8BuilderToText builder) Nothing
                     addr' = display $ T.dropWhileEnd (=='/') addr
+
+     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.
@@ -861,6 +865,8 @@ data ConfigMonoid =
     , configMonoidCasaRepoPrefix     :: !(First CasaRepoPrefix)
     , configMonoidSnapshotLocation :: !(First Text)
     -- ^ Custom location of LTS/Nightly snapshots
+    , configMonoidStackDeveloperMode :: !(First Bool)
+    -- ^ See 'configStackDeveloperMode'
     }
   deriving (Show, Generic)
 
@@ -986,6 +992,8 @@ parseConfigMonoidObject rootDir obj = do
     configMonoidCasaRepoPrefix <- First <$> obj ..:? configMonoidCasaRepoPrefixName
     configMonoidSnapshotLocation <- First <$> obj ..:? configMonoidSnapshotLocationName
 
+    configMonoidStackDeveloperMode <- First <$> obj ..:? configMonoidStackDeveloperModeName
+
     return ConfigMonoid {..}
   where
     handleExplicitSetupDep :: (Monad m, MonadFail m) => (Text, Bool) -> m (Maybe PackageName, Bool)
@@ -1154,6 +1162,9 @@ configMonoidCasaRepoPrefixName = "casa-repo-prefix"
 configMonoidSnapshotLocationName :: Text
 configMonoidSnapshotLocationName = "snapshot-location-base"
 
+configMonoidStackDeveloperModeName :: Text
+configMonoidStackDeveloperModeName = "stack-developer-mode"
+
 data ConfigException
   = ParseConfigFileException (Path Abs File) ParseException
   | ParseCustomSnapshotException Text ParseException
@@ -2132,3 +2143,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