Re #6379 Better information about manual installation

src/Stack/Setup.hs

@@ -158,7 +158,8 @@ import           Stack.Types.Platform
                    , platformOnlyRelDir )
 import           Stack.Types.Runner ( HasRunner (..) )
 import           Stack.Types.SetupInfo ( SetupInfo (..) )
-import           Stack.Types.SourceMap ( SMActual (..), SourceMap (..) )
+import           Stack.Types.SourceMap
+                   ( SMActual (..), SMWanted (..), SourceMap (..) )
 import           Stack.Types.Version
                    ( VersionCheck, stackMinorVersion, stackVersion )
 import           Stack.Types.VersionedDownloadInfo
@@ -198,7 +199,7 @@ data SetupPrettyException
   | InvalidGhcAt !(Path Abs File) !SomeException
   | ExecutableNotFound ![Path Abs File]
   | SandboxedCompilerNotFound ![String] ![Path Abs Dir]
-  | UnsupportedSetupCombo !OS !Arch
+  | UnsupportedSetupCombo !OS !Arch !StyleDoc !StyleDoc
   | MissingDependencies ![String]
   | UnknownCompilerVersion
       !(Set.Set Text)
@@ -310,17 +311,20 @@ instance Pretty SetupPrettyException where
                 \tools, see the output of"
          , style Shell (flow "stack uninstall") <> "."
          ]
-  pretty (UnsupportedSetupCombo os arch) =
+  pretty (UnsupportedSetupCombo os arch tool suggestion) =
     "[S-1852]"
     <> line
     <> fillSep
-         [ flow "Stack does not know how to install GHC for the combination of \
-                \operating system"
+         [ flow "Stack does not know how to install"
+         , tool
+         , flow "for the combination of operating system"
          , style Shell (pretty os)
          , "and architecture"
          , style Shell (pretty arch) <> "."
          , flow "Please install manually."
          ]
+    <> blankLine
+    <> suggestion
   pretty (MissingDependencies tools) =
     "[S-2126]"
     <> line
@@ -1081,7 +1085,21 @@ ensureMsys sopts getSetupInfo' = do
         Nothing
           | soptsInstallIfMissing sopts -> do
               si <- runMemoized getSetupInfo'
-              osKey <- getOSKey platform
+              let suggestion = fillSep
+                    [ flow "To install manually MSYS2, its root directory \
+                           \should be named"
+                    , style Dir "msys2-yyyymmdd"
+                    , flow "(where yyyymmdd is the date-based version) and the \
+                           \directory should be accompanied by a file with the \
+                           \same name and extension"
+                    , style File ".installed"
+                    , flow "(which marks the MSYS2 version as installed). \
+                           \Those two items should be located in the \
+                           \subdirectory for the specified platform in Stack's \
+                           \directory for local tools"
+                    , parens (pretty localPrograms) <> "."
+                    ]
+              osKey <- getOSKey "MSYS2" suggestion platform
               config <- view configL
               VersionedDownloadInfo version info <-
                 case Map.lookup osKey $ siMsys2 si of
@@ -1094,7 +1112,7 @@ ensureMsys sopts getSetupInfo' = do
                          tool
                          (installMsys2Windows si)
           | otherwise -> do
-              prettyWarnS "Continuing despite missing tool: msys2"
+              prettyWarnS "Continuing despite missing tool: MSYS2."
               pure Nothing
     _ -> pure Nothing
 
@@ -2065,23 +2083,51 @@ downloadAndInstallPossibleCompilers possibleCompilers si wanted versionCheck mbi
       Right r -> pure (r, b)
 
 getGhcKey ::
-     (MonadReader env m, HasPlatform env, HasGHCVariant env, MonadThrow m)
+     ( HasBuildConfig env
+     , HasPlatform env
+     , HasGHCVariant env
+     )
   => CompilerBuild
-  -> m Text
+  -> RIO env Text
 getGhcKey ghcBuild = do
+  programsDir <- view $ configL.to configLocalPrograms
   ghcVariant <- view ghcVariantL
   platform <- view platformL
-  osKey <- getOSKey platform
-  pure $
-       osKey
-    <> T.pack (ghcVariantSuffix ghcVariant)
-    <> T.pack (compilerBuildSuffix ghcBuild)
+  wantedComiler <- view $ buildConfigL.to (smwCompiler . bcSMWanted)
+  ghcVersion <- case wantedComiler of
+        WCGhc version -> pure version
+        _ -> error "Impossible!"
+  let suggestion = fillSep
+        [ flow "To install manually the version of GHC, its root directory \
+               \should be named"
+        , style Dir ghcDir
+        , flow "and the directory should be accompanied by a file with the \
+               \same name and extension"
+        , style File ".installed"
+        , flow "(which marks the GHC version as installed). Those two items \
+               \should be located in the subdirectory for the specified \
+               \platform in Stack's directory for local tools"
+        , parens (pretty programsDir) <> "."
+        ]
+      ghcDir =
+           "ghc"
+        <> fromString variantSuffix
+        <> fromString buildSuffix
+        <> fromString (versionString ghcVersion)
+      variantSuffix = ghcVariantSuffix ghcVariant
+      buildSuffix = compilerBuildSuffix ghcBuild
+  osKey <- getOSKey "GHC" suggestion platform
+  pure $ osKey <> T.pack variantSuffix <> T.pack buildSuffix
 
 getOSKey ::
      (MonadThrow m)
-  => Platform
+  => StyleDoc
+     -- ^ Description of the tool that is being set up.
+  -> StyleDoc
+     -- ^ Suggestion if the platform is unsupported.
+  -> Platform
   -> m Text
-getOSKey platform =
+getOSKey tool suggestion platform =
   case platform of
     Platform I386                  Cabal.Linux   -> pure "linux32"
     Platform X86_64                Cabal.Linux   -> pure "linux64"
@@ -2098,7 +2144,8 @@ getOSKey platform =
     Platform Sparc                 Cabal.Linux   -> pure "linux-sparc"
     Platform AArch64               Cabal.OSX     -> pure "macosx-aarch64"
     Platform AArch64               Cabal.FreeBSD -> pure "freebsd-aarch64"
-    Platform arch os -> prettyThrowM $ UnsupportedSetupCombo os arch
+    Platform arch os ->
+      prettyThrowM $ UnsupportedSetupCombo os arch tool suggestion
 
 downloadOrUseLocal ::
      (HasTerm env, HasBuildConfig env)