Merge pull request #6392 from commercialhaskell/s-1852

Re #6379 Prettier S-6362

Author: mpilgrem

doc/maintainers/stack_errors.md

@@ -5,7 +5,7 @@
 In connection with considering Stack's support of the
 [Haskell Error Index](https://errors.haskell.org/) initiative, this page seeks
 to take stock of the errors that Stack itself can raise, by reference to the
-`master` branch of the Stack repository. Last updated: 2023-10-21.
+`master` branch of the Stack repository. Last updated: 2023-12-24.
 
 *   `Stack.main`: catches exceptions from action `commandLineHandler`.
 
@@ -350,7 +350,6 @@ to take stock of the errors that Stack itself can raise, by reference to the
 
         ~~~haskell
         [S-7178] = Couldn'tFindPkgId PackageName
-        [S-6362] | CompilerVersionMismatch (Maybe (ActualCompiler, Arch)) (WantedCompiler, Arch) GHCVariant CompilerBuild VersionCheck (Maybe (Path Abs File)) Text
         [S-3127] | Couldn'tParseTargets [Text]
         [S-2154] | UnknownTargets (Set PackageName) (Map PackageName Version) (Path Abs File)
         [S-1995] | TestSuiteFailure PackageIdentifier (Map Text (Maybe ExitCode)) (Maybe (Path Abs File)) ByteString
@@ -384,6 +383,7 @@ to take stock of the errors that Stack itself can raise, by reference to the
         [S-8664] | InvalidFlagSpecification (Set UnusedFlags)
         [S-8100] | GHCProfOptionInvalid
         [S-1727] | NotOnlyLocal [PackageName] [Text]
+        [S-6362] | CompilerVersionMismatch (Maybe (ActualCompiler, Arch)) (WantedCompiler, Arch) GHCVariant CompilerBuild VersionCheck (Maybe (Path Abs File)) Text
         ~~~
 
     -   `Stack.Types.Compiler.CompilerException`

package.yaml

@@ -111,7 +111,7 @@ dependencies:
 - project-template
 - random
 - rio >= 0.1.22.0
-- rio-prettyprint >= 0.1.7.0
+- rio-prettyprint >= 0.1.8.0
 - split
 - stm
 - tar

src/Stack/Setup.hs

@@ -117,7 +117,7 @@ import           Stack.Setup.Installed
 import           Stack.SourceMap
                    ( actualFromGhc, globalsFromDump, pruneGlobals )
 import           Stack.Storage.User ( loadCompilerPaths, saveCompilerPaths )
-import           Stack.Types.Build.Exception ( BuildException (..) )
+import           Stack.Types.Build.Exception ( BuildPrettyException (..) )
 import           Stack.Types.BuildConfig
                    ( BuildConfig (..), HasBuildConfig (..), projectRootL
                    , wantedCompilerVersionL
@@ -316,9 +316,9 @@ instance Pretty SetupPrettyException where
     <> fillSep
          [ flow "Stack does not know how to install GHC for the combination of \
                 \operating system"
-         , fromString $ show os
+         , style Shell (pretty os)
          , "and architecture"
-         , fromString $ show arch <> "."
+         , style Shell (pretty arch) <> "."
          , flow "Please install manually."
          ]
   pretty (MissingDependencies tools) =
@@ -549,14 +549,14 @@ instance Pretty SetupPrettyException where
     <> line
     <> fillSep
          [ flow "Binary upgrade not yet supported on OS:"
-         , fromString (show os) <> "."
+         , pretty os <> "."
          ]
   pretty (BinaryUpgradeOnArchUnsupported arch) =
     "[S-3249]"
     <> line
     <> fillSep
          [ flow "Binary upgrade not yet supported on architecture:"
-         , fromString (show arch) <> "."
+         , pretty arch <> "."
          ]
   pretty (ExistingMSYS2NotDeleted destDir e) =
     "[S-4230]"
@@ -605,7 +605,7 @@ data SetupOpts = SetupOpts
     -- ^ Don't check for a compatible GHC version/architecture
   , soptsSkipMsys :: !Bool
     -- ^ Do not use a custom msys installation on Windows
-  , soptsResolveMissingGHC :: !(Maybe Text)
+  , soptsResolveMissingGHC :: !(Maybe StyleDoc)
     -- ^ Message shown to user for how to resolve the missing GHC
   , soptsGHCBindistURL :: !(Maybe String)
     -- ^ Alternate GHC binary distribution (requires custom GHCVariant)
@@ -617,7 +617,8 @@ data SetupOpts = SetupOpts
 setupEnv ::
      NeedTargets
   -> BuildOptsCLI
-  -> Maybe Text -- ^ Message to give user when necessary GHC is not available
+  -> Maybe StyleDoc
+     -- ^ Message to give user when necessary GHC is not available.
   -> RIO BuildConfig EnvConfig
 setupEnv needTargets boptsCLI mResolveMissingGHC = do
   config <- view configL
@@ -1143,17 +1144,28 @@ installGhcBindist sopts getSetupInfo' installed = do
             (soptsCompilerCheck sopts)
             (soptsGHCBindistURL sopts)
       | otherwise -> do
-          let suggestion = fromMaybe
-                (mconcat
-                  [ "To install the correct GHC into "
-                  , T.pack (toFilePath (configLocalPrograms config))
-                  , ", try running 'stack setup' or use the '--install-ghc' flag."
-                  , " To use your system GHC installation, run \
-                    \'stack config set system-ghc --global true', \
-                    \or use the '--system-ghc' flag."
-                  ])
-                (soptsResolveMissingGHC sopts)
-          throwM $ CompilerVersionMismatch
+          let suggestion =
+                fromMaybe defaultSuggestion (soptsResolveMissingGHC sopts)
+              defaultSuggestion = fillSep
+                [ flow "To install the correct version of GHC into the \
+                       \subdirectory for the specified platform in Stack's \
+                       \directory for local tools"
+                , parens (pretty $ configLocalPrograms config) <> ","
+                , flow "try running"
+                , style Shell (flow "stack setup")
+                , flow "or use the"
+                , style Shell "--install-ghc"
+                , flow "flag. To use your system GHC installation, run"
+                ,    style
+                       Shell
+                       (flow "stack config set system-ghc --global true")
+                  <> ","
+                , flow "or use the"
+                , style Shell "--system-ghc"
+                , "flag."
+                ]
+
+          prettyThrowM $ CompilerVersionMismatch
             Nothing -- FIXME ((\(x, y, _) -> (x, y)) <$> msystem)
             (soptsWantedCompiler sopts, expectedArch)
             ghcVariant
@@ -2065,7 +2077,10 @@ getGhcKey ghcBuild = do
     <> T.pack (ghcVariantSuffix ghcVariant)
     <> T.pack (compilerBuildSuffix ghcBuild)
 
-getOSKey :: (MonadThrow m) => Platform -> m Text
+getOSKey ::
+     (MonadThrow m)
+  => Platform
+  -> m Text
 getOSKey platform =
   case platform of
     Platform I386                  Cabal.Linux   -> pure "linux32"

src/Stack/Types/Build/Exception.hs

@@ -45,14 +45,6 @@ import           Stack.Types.Version ( VersionCheck (..), VersionRange )
 -- names beginning @Stack.Build@.
 data BuildException
   = Couldn'tFindPkgId PackageName
-  | CompilerVersionMismatch
-      (Maybe (ActualCompiler, Arch)) -- found
-      (WantedCompiler, Arch) -- expected
-      GHCVariant -- expected
-      CompilerBuild -- expected
-      VersionCheck
-      (Maybe (Path Abs File)) -- Path to the stack.yaml file
-      Text -- recommended resolution
   | Couldn'tParseTargets [Text]
   | UnknownTargets
       (Set PackageName) -- no known version
@@ -93,34 +85,6 @@ instance Exception BuildException where
     , packageNameString name
     , ")."
     ]
-  displayException (CompilerVersionMismatch mactual (expected, eArch) ghcVariant ghcBuild check mstack resolution) = concat
-    [ "Error: [S-6362]\n"
-    , case mactual of
-        Nothing -> "No compiler found, expected "
-        Just (actual, arch) -> concat
-          [ "Compiler version mismatched, found "
-          , compilerVersionString actual
-          , " ("
-          , C.display arch
-          , ")"
-          , ", but expected "
-          ]
-    , case check of
-        MatchMinor -> "minor version match with "
-        MatchExact -> "exact version "
-        NewerMinor -> "minor version match or newer with "
-    , T.unpack $ utf8BuilderToText $ display expected
-    , " ("
-    , C.display eArch
-    , ghcVariantSuffix ghcVariant
-    , compilerBuildSuffix ghcBuild
-    , ") (based on "
-    , case mstack of
-        Nothing -> "command line arguments"
-        Just stack -> "resolver setting in " ++ toFilePath stack
-    , ").\n"
-    , T.unpack resolution
-    ]
   displayException (Couldn'tParseTargets targets) = unlines
     $ "Error: [S-3127]"
     : "The following targets could not be parsed as package names or \
@@ -286,6 +250,14 @@ data BuildPrettyException
   | InvalidFlagSpecification (Set UnusedFlags)
   | GHCProfOptionInvalid
   | NotOnlyLocal [PackageName] [Text]
+  | CompilerVersionMismatch
+      (Maybe (ActualCompiler, Arch)) -- found
+      (WantedCompiler, Arch) -- expected
+      GHCVariant -- expected
+      CompilerBuild -- expected
+      VersionCheck
+      (Maybe (Path Abs File)) -- Path to the stack.yaml file
+      StyleDoc -- recommended resolution
   deriving (Show, Typeable)
 
 instance Pretty BuildPrettyException where
@@ -417,6 +389,43 @@ instance Pretty BuildPrettyException where
                     (map (fromString . T.unpack) exes :: [StyleDoc])
                 )
            <> line
+  pretty (CompilerVersionMismatch mactual (expected, eArch) ghcVariant ghcBuild check mstack resolution) =
+    "[S-6362]"
+    <> line
+    <> fillSep
+         [ case mactual of
+             Nothing -> flow "No compiler found, expected"
+             Just (actual, arch) -> fillSep
+               [ flow "Compiler version mismatched, found"
+               , fromString $ compilerVersionString actual
+               , parens (pretty arch) <> ","
+               , flow "but expected"
+               ]
+         , case check of
+             MatchMinor -> flow "minor version match with"
+             MatchExact -> flow "exact version"
+             NewerMinor -> flow "minor version match or newer with"
+         , fromString $ T.unpack $ utf8BuilderToText $ display expected
+         , parens $ mconcat
+             [ pretty eArch
+             , fromString $ ghcVariantSuffix ghcVariant
+             , fromString $ compilerBuildSuffix ghcBuild
+             ]
+         ,    parens
+                ( fillSep
+                    [ flow "based on"
+                    , case mstack of
+                        Nothing -> flow "command line arguments"
+                        Just stack -> fillSep
+                          [ flow "resolver setting in"
+                          , pretty stack
+                          ]
+                    ]
+                )
+          <> "."
+         ]
+    <> blankLine
+    <> resolution
 
 instance Exception BuildPrettyException
 

stack.cabal

@@ -396,7 +396,7 @@ library
     , project-template
     , random
     , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.7.0
+    , rio-prettyprint >=0.1.8.0
     , split
     , stm
     , tar
@@ -518,7 +518,7 @@ executable stack
     , project-template
     , random
     , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.7.0
+    , rio-prettyprint >=0.1.8.0
     , split
     , stack
     , stm
@@ -621,7 +621,7 @@ executable stack-integration-test
     , project-template
     , random
     , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.7.0
+    , rio-prettyprint >=0.1.8.0
     , split
     , stm
     , tar
@@ -738,7 +738,7 @@ test-suite stack-unit-test
     , random
     , raw-strings-qq
     , rio >=0.1.22.0
-    , rio-prettyprint >=0.1.7.0
+    , rio-prettyprint >=0.1.8.0
     , split
     , stack
     , stm

stack.yaml

@@ -6,6 +6,8 @@ extra-deps:
 - Cabal-3.10.1.0@sha256:6d11adf7847d9734e7b02785ff831b5a0d11536bfbcefd6634b2b08411c63c94,12316
 # GHC 9.6.3 comes with process-1.6.17.0, which can segfault on macOS.
 - process-1.6.18.0@sha256:cd0a3e0376b5a8525983d3131a31e52f9ffefc278ce635eec45a9d3987b8be3e,3025
+# lts-22.0 specifies rio-prettyprint-0.1.7.0:
+- rio-prettyprint-0.1.8.0@sha256:28a034bfa2842043d4603800e47943027677746cca0b3b8088aee10168870105,1428
 
 docker:
   enable: false

stack.yaml.lock

@@ -18,6 +18,13 @@ packages:
       size: 1675
   original:
     hackage: process-1.6.18.0@sha256:cd0a3e0376b5a8525983d3131a31e52f9ffefc278ce635eec45a9d3987b8be3e,3025
+- completed:
+    hackage: rio-prettyprint-0.1.8.0@sha256:28a034bfa2842043d4603800e47943027677746cca0b3b8088aee10168870105,1428
+    pantry-tree:
+      sha256: 69850784d99d1c44e85f934433abafad729f87fdc40d375c590c8d4a1cb2886d
+      size: 779
+  original:
+    hackage: rio-prettyprint-0.1.8.0@sha256:28a034bfa2842043d4603800e47943027677746cca0b3b8088aee10168870105,1428
 snapshots:
 - completed:
     sha256: e176944bc843f740e05242fa7a66ca1f440c127e425254f7f1257f9b19add23f