Fix #6457 Allow MSYS2 environment to be configured

ChangeLog.md

@@ -12,6 +12,11 @@ Behavior changes:
 
 Other enhancements:
 
+* In YAML configuration files, the `msys-environment` key is introduced to
+  allow, on Windows, the MSYS2 environment to be specified. The default
+  environment is still `MINGW64` on 64-bit Windows and `MINGW32` on 32-bit
+  Windows.
+
 Bug fixes:
 
 ## v2.15.1

doc/developing_on_windows.md

@@ -3,11 +3,11 @@
 # Developing on Windows #
 
 On Windows, Stack comes with an installation of [MSYS2](https://www.msys2.org/).
-The MINGW64 (MINGW32 on 32-bit Windows) environment of MSYS2 will be used by
-Stack to provide a Unix-like shell and environment for Stack. This may be
-necessary for installing some Haskell packages, such as those which use
-`configure` scripts, or if your project needs some additional tools during the
-build phase.
+An environment of MSYS2 (by default, `MINGW64` on 64-bit Windows or `MINGW32` on
+32-bit Windows) will be used by Stack to provide a Unix-like shell and
+environment for Stack. This may be necessary for installing some Haskell
+packages, such as those which use `configure` scripts, or if your project needs
+some additional tools during the build phase.
 
 No matter which terminal software you choose (Windows Terminal, Console Windows
 Host, Command Prompt, PowerShell, Git bash or any other) you can use this
@@ -26,19 +26,26 @@ example, help about the operation `--sync` (or `-S`) can be obtained with
 `stack exec -- pacman --sync --help` or, equivalently,
 `stack exec -- pacman -Sh`.
 
-Command `stack path --bin-path` to see the PATH in the Stack environment. On
-Windows, it includes the `\mingw64\bin` (`\mingw32\bin` on 32-bit Windows),
-`\usr\bin` and `\usr\local\bin` directories of the Stack-supplied MSYS2. If your
-executable depends on files (for example, dynamic-link libraries) in those
-directories and you want to run it outside of the Stack environment, you will
-need to ensure copies of those files are on the PATH.
+Command `stack path --bin-path` to see the PATH in the Stack environment. If the
+relevant MSYS2 environment is `MINGW64`, on Windows, it includes the
+`\mingw64\bin`, `\usr\bin` and `\usr\local\bin` directories of the
+Stack-supplied MSYS2. (It includes the corresponding directory if the relevant
+MSYS2 environment is other than `MINGW64`.) If your executable depends on files
+(for example, dynamic-link libraries) in those directories and you want to run
+it outside of the Stack environment, you will need to ensure copies of those
+files are on the PATH.
 
 Command `stack path --extra-include-dirs` and `stack path --extra-library-dirs`
 to see the extra directories searched for C header files or system libraries
-files in the Stack environment. On Windows, it includes the `\mingw64\include`
-(`mingw32\include` on 32-bit Windows) (include) and the `\mingw64\lib` and
-`\mingw64\bin` directories (`mingw32\lib` and `mingw32\bin` on 32-bit Windows)
-(library) of the Stack-supplied MSYS2.
+files in the Stack environment. If the relevant MSYS2 environment is `MINGW64`,
+on Windows, it includes the `\mingw64\include` (include) and the `\mingw64\lib`
+and `\mingw64\bin` directories (library) of the Stack-supplied MSYS2. (It
+includes the corresponding directories if the relevant MSYS2 environment is
+other than `MINGW64`.)
+
+For further information about configuring the relevant MSYS2 environment, see
+Stack's [`msys-environment`](yaml_configuration.md#msys-environment)
+configuration option.
 
 ## Updating the Stack-supplied MSYS2 ##
 

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-12-24.
+`master` branch of the Stack repository. Last updated: 2024-01-29.
 
 *   `Stack.main`: catches exceptions from action `commandLineHandler`.
 
@@ -420,6 +420,8 @@ to take stock of the errors that Stack itself can raise, by reference to the
         [S-7462] | StackWorkEnvNotRelativeDir String
         [S-3251] | MultiplePackageIndices [PackageIndexConfig]
         [S-5470] | DuplicateLocalPackageNames [(PackageName, [PackageLocation])]
+        [S-6854] | BadMsysEnvironment MsysEnvironment Arch
+        [S-5006] | NoDefaultMsysEnvironmentBug
         ~~~
 
     -   `Stack.Types.Config.ParseAbsolutePathException`

doc/yaml_configuration.md

@@ -1230,6 +1230,18 @@ Whether to modify the code page for UTF-8 output.
 modify-code-page: false
 ~~~
 
+### msys-environment
+
+:octicons-tag-24: UNRELEASED
+
+Restrictions: Windows systems only.
+
+Default: `MINGW64` (64-bit Windows) or `MINGW32` (32-bit Windows)
+
+The name of the MSYS2 environment (case-sensitive) used in the Stack
+environment. Valid environments are `CLANG32`, `CLANG64`, `CLANGARM64`,
+`MINGW32`, `MINGW64`, and `UCRT64`.
+
 ### nix
 
 [:octicons-tag-24: 0.1.10.0](https://github.com/commercialhaskell/stack/releases/tag/v0.1.10.0)

package.yaml

@@ -317,6 +317,7 @@ library:
   - Stack.Types.Installed
   - Stack.Types.IsMutable
   - Stack.Types.LockFileBehavior
+  - Stack.Types.MsysEnvironment
   - Stack.Types.NamedComponent
   - Stack.Types.Nix
   - Stack.Types.Package

src/Stack/Config.hs

@@ -122,6 +122,8 @@ import           Stack.Types.Casa ( CasaOptsMonoid (..) )
 import           Stack.Types.Docker ( DockerOpts (..), DockerOptsMonoid (..) )
 import           Stack.Types.DumpLogs ( DumpLogs (..) )
 import           Stack.Types.GlobalOpts (  GlobalOpts (..) )
+import           Stack.Types.MsysEnvironment
+                   ( MsysEnvironment (..), msysEnvArch )
 import           Stack.Types.Nix ( NixOpts (..) )
 import           Stack.Types.Platform
                    ( PlatformVariant (..), platformOnlyRelDir )
@@ -311,6 +313,10 @@ configFromConfigMonoid
         installGHC = fromFirstTrue configMonoid.installGHC
         skipGHCCheck = fromFirstFalse configMonoid.skipGHCCheck
         skipMsys = fromFirstFalse configMonoid.skipMsys
+        defMsysEnvironment = case platform of
+          Platform I386 Windows -> Just MINGW32
+          Platform X86_64 Windows -> Just MINGW64
+          _ -> Nothing
         extraIncludeDirs = configMonoid.extraIncludeDirs
         extraLibDirs = configMonoid.extraLibDirs
         customPreprocessorExts = configMonoid.customPreprocessorExts
@@ -325,6 +331,15 @@ configFromConfigMonoid
         requireStackVersion = simplifyVersionRange
           configMonoid.requireStackVersion.intersectingVersionRange
         compilerCheck = fromFirst MatchMinor configMonoid.compilerCheck
+    msysEnvironment <- case defMsysEnvironment of
+      -- Ignore the configuration setting if there is no default for the
+      -- platform.
+      Nothing -> pure Nothing
+      Just defMsysEnv -> do
+        let msysEnv = fromFirst defMsysEnv configMonoid.msysEnvironment
+        if msysEnvArch msysEnv == arch
+          then pure $ Just msysEnv
+          else prettyThrowM $ BadMsysEnvironment msysEnv arch
     platformVariant <- liftIO $
       maybe PlatformVariantNone PlatformVariant <$> lookupEnv platformVariantEnvVar
     let build = buildOptsFromMonoid configMonoid.buildOpts
@@ -541,6 +556,7 @@ configFromConfigMonoid
                 , installGHC
                 , skipGHCCheck
                 , skipMsys
+                , msysEnvironment
                 , compilerCheck
                 , compilerRepository
                 , localBin

src/Stack/Constants.hs

@@ -89,6 +89,10 @@ module Stack.Constants
   , relDirMingw
   , relDirMingw32
   , relDirMingw64
+  , relDirClang32
+  , relDirClang64
+  , relDirClangArm64
+  , relDirUcrt64
   , relDirLocal
   , relDirUsr
   , relDirInclude
@@ -513,6 +517,18 @@ relDirMingw32 = $(mkRelDir "mingw32")
 relDirMingw64 :: Path Rel Dir
 relDirMingw64 = $(mkRelDir "mingw64")
 
+relDirClang32 :: Path Rel Dir
+relDirClang32 = $(mkRelDir "clang32")
+
+relDirClang64 :: Path Rel Dir
+relDirClang64 = $(mkRelDir "clang64")
+
+relDirClangArm64 :: Path Rel Dir
+relDirClangArm64 = $(mkRelDir "clangarm64")
+
+relDirUcrt64 :: Path Rel Dir
+relDirUcrt64 = $(mkRelDir "ucrt64")
+
 relDirLocal :: Path Rel Dir
 relDirLocal = $(mkRelDir "local")
 

src/Stack/Setup.hs

@@ -727,7 +727,8 @@ setupEnv needTargets buildOptsCLI mResolveMissingGHC = do
   mGhcRtsEnvVar <- liftIO $ lookupEnv "GHCRTS"
 
   envRef <- liftIO $ newIORef Map.empty
-  let getProcessContext' es = do
+  let msysEnv = maybe "" (T.pack . show) config.msysEnvironment
+      getProcessContext' es = do
         m <- readIORef envRef
         case Map.lookup es m of
           Just eo -> pure eo
@@ -753,9 +754,9 @@ setupEnv needTargets buildOptsCLI mResolveMissingGHC = do
 
               $ case (sopts.skipMsys, platform) of
                   (False, Platform Cabal.I386   Cabal.Windows) ->
-                    Map.insert "MSYSTEM" "MINGW32"
+                    Map.insert "MSYSTEM" msysEnv
                   (False, Platform Cabal.X86_64 Cabal.Windows) ->
-                    Map.insert "MSYSTEM" "MINGW64"
+                    Map.insert "MSYSTEM" msysEnv
                   _ -> id
 
               -- See https://github.com/commercialhaskell/stack/issues/3444

src/Stack/Setup/Installed.hs

@@ -32,14 +32,16 @@ import           Path ( (</>), filename, parseRelDir, parseRelFile )
 import           Path.IO ( doesDirExist, ignoringAbsence, listDir, removeFile )
 import           RIO.Process ( HasProcessContext, proc, readProcess_ )
 import           Stack.Constants
-                   ( relDirBin, relDirInclude, relDirLib, relDirLocal, relDirMingw
-                   , relDirMingw32, relDirMingw64, relDirUsr
+                   ( relDirBin, relDirInclude, relDirLib, relDirLocal
+                   , relDirMingw, relDirUsr
                    )
 import           Stack.Prelude
 import           Stack.Types.Compiler
                    ( ActualCompiler (..), WhichCompiler (..) )
 import           Stack.Types.Config ( Config (..), HasConfig (..) )
+import           Stack.Types.Config.Exception ( ConfigPrettyException (..) )
 import           Stack.Types.ExtraDirs ( ExtraDirs (..) )
+import           Stack.Types.MsysEnvironment ( relDirMsysEnv )
 
 data Tool
   = Tool PackageIdentifier -- ^ e.g. ghc-7.8.4, msys2-20150512
@@ -137,6 +139,9 @@ toolExtraDirs :: HasConfig env => Tool -> RIO env ExtraDirs
 toolExtraDirs tool = do
   config <- view configL
   dir <- installDir config.localPrograms tool
+  msysEnv <- case config.msysEnvironment of
+    Just msysEnv -> pure msysEnv
+    Nothing -> throwM NoMsysEnvironmentBug
   case (config.platform, toolNameString tool) of
     (Platform _ Cabal.Windows, isGHC -> True) -> pure mempty
       { bins =
@@ -146,30 +151,30 @@ toolExtraDirs tool = do
       }
     (Platform Cabal.I386 Cabal.Windows, "msys2") -> pure mempty
       { bins =
-          [ dir </> relDirMingw32 </> relDirBin
+          [ dir </> relDirMsysEnv msysEnv </> relDirBin
           , dir </> relDirUsr </> relDirBin
           , dir </> relDirUsr </> relDirLocal </> relDirBin
           ]
       , includes =
-          [ dir </> relDirMingw32 </> relDirInclude
+          [ dir </> relDirMsysEnv msysEnv </> relDirInclude
           ]
       , libs =
-          [ dir </> relDirMingw32 </> relDirLib
-          , dir </> relDirMingw32 </> relDirBin
+          [ dir </> relDirMsysEnv msysEnv </> relDirLib
+          , dir </> relDirMsysEnv msysEnv </> relDirBin
           ]
       }
     (Platform Cabal.X86_64 Cabal.Windows, "msys2") -> pure mempty
       { bins =
-          [ dir </> relDirMingw64 </> relDirBin
+          [ dir </> relDirMsysEnv msysEnv </> relDirBin
           , dir </> relDirUsr </> relDirBin
           , dir </> relDirUsr </> relDirLocal </> relDirBin
           ]
       , includes =
-          [ dir </> relDirMingw64 </> relDirInclude
+          [ dir </> relDirMsysEnv msysEnv </> relDirInclude
           ]
       , libs =
-          [ dir </> relDirMingw64 </> relDirLib
-          , dir </> relDirMingw64 </> relDirBin
+          [ dir </> relDirMsysEnv msysEnv </> relDirLib
+          , dir </> relDirMsysEnv msysEnv </> relDirBin
           ]
       }
     (_, isGHC -> True) -> pure mempty

src/Stack/Types/Config.hs

@@ -43,6 +43,7 @@ import           Stack.Types.Docker ( DockerOpts )
 import           Stack.Types.DumpLogs ( DumpLogs )
 import           Stack.Types.EnvSettings ( EnvSettings )
 import           Stack.Types.GHCVariant ( GHCVariant (..), HasGHCVariant (..) )
+import           Stack.Types.MsysEnvironment ( MsysEnvironment )
 import           Stack.Types.Nix ( NixOpts )
 import           Stack.Types.Platform ( HasPlatform (..), PlatformVariant )
 import           Stack.Types.Project ( Project (..) )
@@ -100,6 +101,9 @@ data Config = Config
     -- ^ Don't bother checking the GHC version or architecture.
   , skipMsys               :: !Bool
     -- ^ On Windows: don't use a sandboxed MSYS
+  , msysEnvironment        :: !(Maybe MsysEnvironment)
+    -- ^ On Windows: what MSYS2 environment to apply. Nothing on other operating
+    -- systems.
   , compilerCheck          :: !VersionCheck
     -- ^ Specifies which versions of the compiler are acceptable.
   , compilerRepository     :: !CompilerRepository

src/Stack/Types/Config/Exception.hs

@@ -14,12 +14,14 @@ module Stack.Types.Config.Exception
 import qualified Data.Text as T
 import           Data.Yaml ( ParseException )
 import qualified Data.Yaml as Yaml
+import           Distribution.System ( Arch )
 import           Path( dirname, filename )
 import           Stack.Prelude
 import           Stack.Types.ConfigMonoid
                    ( configMonoidAllowDifferentUserName
                    , configMonoidGHCVariantName, configMonoidSystemGHCName
                    )
+import           Stack.Types.MsysEnvironment ( MsysEnvironment )
 import           Stack.Types.Version
                    ( VersionRange, stackVersion, versionRangeText )
 
@@ -159,6 +161,8 @@ data ConfigPrettyException
   | StackWorkEnvNotRelativeDir !String
   | MultiplePackageIndices [PackageIndexConfig]
   | DuplicateLocalPackageNames ![(PackageName, [PackageLocation])]
+  | BadMsysEnvironment !MsysEnvironment !Arch
+  | NoMsysEnvironmentBug
   deriving (Show, Typeable)
 
 instance Pretty ConfigPrettyException where
@@ -214,9 +218,10 @@ instance Pretty ConfigPrettyException where
     "[S-5470]"
     <> line
     <> fillSep
-        [ flow "The same package name is used in more than one local package or"
-        , style Shell "extra-deps" <> "."
-        ]
+         [ flow "The same package name is used in more than one local package \
+                \or"
+         , style Shell "extra-deps" <> "."
+         ]
     <> mconcat (map go pairs)
    where
     go (name, dirs) =
@@ -227,6 +232,17 @@ instance Pretty ConfigPrettyException where
            ]
       <> line
       <> bulletedList (map (fromString . T.unpack . textDisplay) dirs)
+  pretty (BadMsysEnvironment msysEnv arch) =
+    "[S-6854]"
+    <> line
+    <> fillSep
+         [ flow "The specified MSYS2 environment"
+         , style Error (fromString $ show msysEnv)
+         , flow "is not consistent with the architecture"
+         , fromString (show arch) <> "."
+         ]
+  pretty NoMsysEnvironmentBug = bugPrettyReport "[S-5006]" $
+    flow "No default MSYS2 environment."
 
 instance Exception ConfigPrettyException