Merge pull request #6021 from commercialhaskell/ghc2021

Move Stack to -XGHC2021

Author: mpilgrem

package.yaml

@@ -1,3 +1,6 @@
+# Hpack >= 0.35.0 is provided by Stack >= 2.9.1.
+spec-version: 0.35.0
+
 name: stack
 version: '2.10.0'
 synopsis: The Haskell Tool Stack
@@ -8,7 +11,7 @@ description: |
   If building a 'stack' executable for distribution, please download the
   source code from <https://github.com/commercialhaskell/stack/releases>
   and build it using Stack itself in order to ensure identical behaviour
-  to official binaries.  This package on Hackage is provided for convenience
+  to official binaries. This package on Hackage is provided for convenience
   and bootstrapping purposes.
   .
   Note that the API for the library is not currently stable, and may
@@ -39,6 +42,8 @@ extra-source-files:
 - test/package-dump/ghc-head.txt
 - src/test/Stack/Untar/test1.tar.gz
 - src/test/Stack/Untar/test2.tar.gz
+# GHC's GHC2021 language extension is supported by GHC >= 9.2.1
+language: GHC2021
 ghc-options:
 - -fwrite-ide-info
 - -hiedir=.hie

src/Control/Concurrent/Execute.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE NoImplicitPrelude  #-}
-{-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE RecordWildCards    #-}
 
 -- Concurrent execution with dependencies. Types currently hard-coded for needs

src/Data/Monoid/Map.hs

@@ -1,6 +1,3 @@
-{-# LANGUAGE DeriveGeneric              #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
 module Data.Monoid.Map
   ( MonoidMap (..)
   ) where

src/Options/Applicative/Builder/Extra.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude   #-}
 {-# LANGUAGE RecordWildCards     #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Extra functions for optparse-applicative.
 

src/Path/CheckInstall.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Path.CheckInstall

src/Stack/Build.hs

@@ -1,10 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude   #-}
-{-# LANGUAGE ConstraintKinds     #-}
-{-# LANGUAGE DeriveDataTypeable  #-}
-{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE LambdaCase          #-}
 {-# LANGUAGE OverloadedStrings   #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
 -- | Build the project.
 

src/Stack/Build/Cache.hs

@@ -1,10 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
 
 -- | Cache information about previous builds
 module Stack.Build.Cache

src/Stack/Build/ConstructPlan.hs

@@ -1,12 +1,6 @@
 {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE DeriveGeneric         #-}
-{-# LANGUAGE FlexibleContexts      #-}
 {-# LANGUAGE LambdaCase            #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE ViewPatterns          #-}
 
 -- | Construct a @Plan@ for how to build

src/Stack/Build/Execute.hs

@@ -1,13 +1,7 @@
 {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
 {-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE TypeFamilies          #-}
 
 -- | Perform a build
@@ -69,7 +63,7 @@ import           Distribution.Types.UnqualComponentName
                    ( mkUnqualComponentName )
 import           Distribution.Verbosity ( showForCabal )
 import           Distribution.Version ( mkVersion )
-import           Pantry.Internal.Companion ( withCompanion )
+import           Pantry.Internal.Companion ( Companion, withCompanion )
 import           Path
                    ( PathException, (</>), addExtension, filename
                    , isProperPrefixOf, parent, parseRelDir, parseRelFile
@@ -1170,40 +1164,43 @@ announceTask ee task action = logInfo $
 -- | Ensure we're the only action using the directory.  See
 -- <https://github.com/commercialhaskell/stack/issues/2730>
 withLockedDistDir ::
-     HasEnvConfig env
+     forall env a. HasEnvConfig env
   => (Utf8Builder -> RIO env ()) -- ^ announce
   -> Path Abs Dir -- ^ root directory for package
   -> RIO env a
   -> RIO env a
 withLockedDistDir announce root inner = do
   distDir <- distRelativeDir
   let lockFP = root </> distDir </> relFileBuildLock
+      lockFP' = toFilePath lockFP
   ensureDir $ parent lockFP
 
   mres <-
     withRunInIO $ \run ->
-    withTryFileLock (toFilePath lockFP) Exclusive $ \_lock ->
+    withTryFileLock lockFP' Exclusive $ \_lock ->
     run inner
 
   case mres of
     Just res -> pure res
     Nothing -> do
-      let complainer delay = do
-            delay 5000000 -- 5 seconds
-            announce $
-                 "blocking for directory lock on "
-              <> fromString (toFilePath lockFP)
-            forever $ do
-              delay 30000000 -- 30 seconds
-              announce $
-                   "still blocking for directory lock on "
-                <> fromString (toFilePath lockFP)
-                <> "; maybe another Stack process is running?"
-      withCompanion complainer $
+      withCompanion (complainer lockFP') $
         \stopComplaining ->
           withRunInIO $ \run ->
-            withFileLock (toFilePath lockFP) Exclusive $ \_ ->
+            withFileLock lockFP' Exclusive $ \_ ->
               run $ stopComplaining *> inner
+ where
+  complainer :: FilePath -> Companion (RIO env)
+  complainer fp delay = do
+    delay 5000000 -- 5 seconds
+    announce $
+         "blocking for directory lock on "
+      <> fromString fp
+    forever $ do
+      delay 30000000 -- 30 seconds
+      announce $
+           "still blocking for directory lock on "
+        <> fromString fp
+        <> "; maybe another Stack process is running?"
 
 -- | How we deal with output from GHC, either dumping to a log file or the
 -- console (with some prefix).

src/Stack/Build/Haddock.hs

@@ -1,10 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude     #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE NamedFieldPuns        #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
 
 -- | Generate haddocks
 module Stack.Build.Haddock