Upgrade to ghc 9.10

.github/workflows/cabal.yml

@@ -9,13 +9,13 @@ jobs:
     strategy:
       matrix:
         os: [ubuntu-latest, macOS-latest]
-        ghc: ["9.4", "9.6", "9.8"]
+        ghc: ["9.6", "9.8", "9.10"]
       fail-fast: false
 
     steps:
     - uses: actions/checkout@v2
 
-    - uses: haskell/actions/setup@v2
+    - uses: haskell-actions/setup@v2
       name: Setup Haskell Cabal
       with:
         ghc-version: ${{ matrix.ghc }}
@@ -27,7 +27,7 @@ jobs:
         key: "${{ runner.os }}-${{ matrix.ghc }}-v9-${{ hashFiles('stylish-haskell.cabal') }}"
 
     - name: Build
-      run: cabal build 
+      run: cabal build
       id: build
 
     - name: Test

.github/workflows/ci.yml

@@ -47,7 +47,7 @@ jobs:
       env:
         PATAT_TAG: ${{ steps.get_version.outputs.version }}
 
-    - uses: actions/upload-artifact@v2
+    - uses: actions/upload-artifact@v4
       if: startsWith(github.ref, 'refs/tags')
       with:
         path: artifacts/*

lib/Language/Haskell/Stylish/GHC.hs

@@ -69,7 +69,7 @@ dropBeforeAndAfter :: Located a -> [RealLocated b] -> [RealLocated b]
 dropBeforeAndAfter loc = dropBeforeLocated (Just loc) . dropAfterLocated (Just loc)
 
 baseDynFlags :: GHC.DynFlags
-baseDynFlags = defaultDynFlags GHCEx.fakeSettings 
+baseDynFlags = defaultDynFlags GHCEx.fakeSettings
 
 getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs]
 getConDecls [email protected] {} = case GHC.dd_cons d of
@@ -80,7 +80,6 @@ showOutputable :: GHC.Outputable a => a -> String
 showOutputable = GHC.showPpr baseDynFlags
 
 epAnnComments :: GHC.EpAnn a -> [GHC.LEpaComment]
-epAnnComments GHC.EpAnnNotUsed = []
 epAnnComments GHC.EpAnn {..}   = priorAndFollowing comments
 
 deepAnnComments :: (Data a, Typeable a) => a -> [GHC.LEpaComment]

lib/Language/Haskell/Stylish/Ordering.hs

@@ -45,12 +45,12 @@ compareLIE = comparing $ ieKey . unLoc
     -- constructors first, followed by functions, and then operators.
     ieKey :: IE GhcPs -> (Int, String)
     ieKey = \case
-        IEVar _ n            -> nameKey n
-        IEThingAbs _ n       -> nameKey n
-        IEThingAll _ n       -> nameKey n
-        IEThingWith _ n _ _  -> nameKey n
-        IEModuleContents _ n -> nameKey n
-        _                    -> (2, "")
+        IEVar _ n  _          -> nameKey n
+        IEThingAbs _ n _      -> nameKey n
+        IEThingAll _ n  _     -> nameKey n
+        IEThingWith _ n _ _ _ -> nameKey n
+        IEModuleContents _ n  -> nameKey n
+        _                     -> (2, "")
 
 
 --------------------------------------------------------------------------------

lib/Language/Haskell/Stylish/Printer.hs

@@ -61,7 +61,6 @@ import           Control.Monad.Reader            (MonadReader, ReaderT (..),
                                                   asks, local)
 import           Control.Monad.State             (MonadState, State, get, gets,
                                                   modify, put, runState)
-import           Data.List                       (foldl')
 
 --------------------------------------------------------------------------------
 import           Language.Haskell.Stylish.GHC    (showOutputable)
@@ -138,7 +137,6 @@ putComment epaComment = case GHC.ac_tok epaComment of
   GHC.EpaLineComment s  -> putText s
   GHC.EpaDocOptions s   -> putText s
   GHC.EpaBlockComment s -> putText s
-  GHC.EpaEofComment     -> pure ()
 
 putMaybeLineComment :: Maybe GHC.EpaComment -> P ()
 putMaybeLineComment = \case
@@ -149,8 +147,7 @@ putMaybeLineComment = \case
 putRdrName :: GenLocated GHC.SrcSpanAnnN RdrName -> P ()
 putRdrName rdrName = case GHC.unLoc rdrName of
     Unqual name -> do
-      let (pre, post) = nameAnnAdornments $
-            GHC.epAnnAnnsL $ GHC.ann $ GHC.getLoc rdrName
+      let (pre, post) = nameAnnAdornment $ GHC.anns $ GHC.getLoc rdrName
       putText pre
       putText (showOutputable name)
       putText post
@@ -161,12 +158,6 @@ putRdrName rdrName = case GHC.unLoc rdrName of
     Exact name ->
       putText (showOutputable name)
 
-nameAnnAdornments :: [GHC.NameAnn] -> (String, String)
-nameAnnAdornments = foldl'
-    (\(accl, accr) nameAnn ->
-        let (l, r) = nameAnnAdornment nameAnn in (accl ++ l, r ++ accr))
-    (mempty, mempty)
-
 nameAnnAdornment :: GHC.NameAnn -> (String, String)
 nameAnnAdornment = \case
     GHC.NameAnn {..}       -> fromAdornment nann_adornment
@@ -239,7 +230,7 @@ putType ltp = case GHC.unLoc ltp of
     putOutputable ltp
   GHC.HsQualTy {} ->
     putOutputable ltp
-  GHC.HsAppKindTy _ _ _ _ ->
+  GHC.HsAppKindTy _ _ _ ->
     putOutputable ltp
   GHC.HsListTy _ _ ->
     putOutputable ltp

lib/Language/Haskell/Stylish/Step/Data.hs

@@ -93,14 +93,19 @@ step cfg = makeStep "Data" \ls m -> Editor.apply (changes m) ls
     changes :: Module -> Editor.Edits
     changes = foldMap (formatDataDecl cfg) . dataDecls
 
+    getComments :: GHC.AddEpAnn -> [GHC.LEpaComment]
+    getComments (GHC.AddEpAnn _ epaLoc) = case epaLoc of
+        GHC.EpaDelta _ comments -> comments
+        GHC.EpaSpan _ -> []
+
     dataDecls :: Module -> [DataDecl]
     dataDecls m = do
         ldecl <- GHC.hsmodDecls $ GHC.unLoc m
         GHC.TyClD _ tycld <- pure $ GHC.unLoc ldecl
         loc <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl
         case tycld of
             GHC.DataDecl {..} -> pure $ MkDataDecl
-                { dataComments = epAnnComments tcdDExt
+                { dataComments = foldMap getComments tcdDExt
                 , dataLoc      = loc
                 , dataDeclName = tcdLName
                 , dataTypeVars = tcdTyVars
@@ -330,7 +335,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
   GHC.ConDeclGADT {..} -> do
     -- Put argument to constructor first:
     case con_g_args of
-      GHC.PrefixConGADT _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names
+      GHC.PrefixConGADT _ _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names
       GHC.RecConGADT _ _ -> error . mconcat $
           [ "Language.Haskell.Stylish.Step.Data.putConstructor: "
           , "encountered a GADT with record constructors, not supported yet"
@@ -350,7 +355,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
             GHC.HsOuterExplicit {..} -> hso_bndrs)
     forM_ con_mb_cxt $ putContext cfg
     case con_g_args of
-        GHC.PrefixConGADT scaledTys -> forM_ scaledTys $ \scaledTy -> do
+        GHC.PrefixConGADT _ scaledTys -> forM_ scaledTys $ \scaledTy -> do
             putType $ GHC.hsScaledThing scaledTy
             space >> putText "->" >> space
         GHC.RecConGADT _ _ -> error . mconcat $
@@ -384,7 +389,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
         let commented = commentGroups
                 (GHC.srcSpanToRealSrcSpan . GHC.getLocA)
                 (GHC.unLoc largs)
-                (epAnnComments . GHC.ann $ GHC.getLoc largs)
+                (epAnnComments $ GHC.getLoc largs)
 
         forM_ (flagEnds commented) $ \(CommentGroup {..}, firstCommentGroup, _) -> do
 

lib/Language/Haskell/Stylish/Step/Imports.hs

@@ -58,6 +58,7 @@ import           Language.Haskell.Stylish.Ordering
 import           Language.Haskell.Stylish.Printer
 import           Language.Haskell.Stylish.Step
 import           Language.Haskell.Stylish.Util
+import Control.Applicative ((<|>))
 
 --------------------------------------------------------------------------------
 data Options = Options
@@ -507,19 +508,19 @@ printQualified Options{..} padNames stats ldecl = do
 
 --------------------------------------------------------------------------------
 printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()
-printImport _ (GHC.IEVar _ name) = do
+printImport _ (GHC.IEVar _ name _) = do
     printIeWrappedName name
-printImport _ (GHC.IEThingAbs _ name) = do
+printImport _ (GHC.IEThingAbs _ name _) = do
     printIeWrappedName name
-printImport separateLists (GHC.IEThingAll _ name) = do
+printImport separateLists (GHC.IEThingAll _ name _) = do
     printIeWrappedName name
     when separateLists space
     putText "(..)"
 printImport _ (GHC.IEModuleContents _ modu) = do
     putText "module"
     space
     putText . GHC.moduleNameString $ GHC.unLoc modu
-printImport separateLists (GHC.IEThingWith _ name wildcard imps) = do
+printImport separateLists (GHC.IEThingWith _ name wildcard imps _) = do
     printIeWrappedName name
     when separateLists space
     let ellipsis = case wildcard of
@@ -637,24 +638,24 @@ prepareImportList =
   prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs
   prepareInner = \case
     -- Simplify `A ()` to `A`.
-    GHC.IEThingWith x n GHC.NoIEWildcard [] -> GHC.IEThingAbs x n
-    GHC.IEThingWith x n w ns ->
-      GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns)
+    GHC.IEThingWith x n GHC.NoIEWildcard [] md -> GHC.IEThingAbs x n md
+    GHC.IEThingWith x n w ns md ->
+      GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns) md
     ie -> ie
 
   -- Merge two import items, assuming they have the same name.
   ieMerge :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs -> Maybe (GHC.IE GHC.GhcPs)
-  ieMerge l@(GHC.IEVar _ _)      _                  = Just l
-  ieMerge _                  r@(GHC.IEVar _ _)      = Just r
-  ieMerge (GHC.IEThingAbs _ _)   r                  = Just r
-  ieMerge l                  (GHC.IEThingAbs _ _)   = Just l
-  ieMerge l@(GHC.IEThingAll _ _) _                  = Just l
-  ieMerge _                  r@(GHC.IEThingAll _ _) = Just r
-  ieMerge (GHC.IEThingWith x0 n0 w0 ns0) (GHC.IEThingWith _ _ w1 ns1)
+  ieMerge l@(GHC.IEVar _ _ _)      _                  = Just l
+  ieMerge _                  r@(GHC.IEVar _ _ _)      = Just r
+  ieMerge (GHC.IEThingAbs _ _ _)   r                  = Just r
+  ieMerge l                  (GHC.IEThingAbs _ _ _)   = Just l
+  ieMerge l@(GHC.IEThingAll _ _ _) _                  = Just l
+  ieMerge _                  r@(GHC.IEThingAll _ _ _) = Just r
+  ieMerge (GHC.IEThingWith x0 n0 w0 ns0 me0) (GHC.IEThingWith _ _ w1 ns1 me1)
     | w0 /= w1  = Nothing
     | otherwise = Just $
         -- TODO: sort the `ns0 ++ ns1`?
-        GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1)
+        GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1) (me0 <|> me1)
   ieMerge _ _ = Nothing
 
 

lib/Language/Haskell/Stylish/Step/ModuleHeader.hs

@@ -83,7 +83,7 @@ printModuleHeader maxCols conf ls lmodul =
 
         keywordLine kw = listToMaybe $ do
             GHC.EpAnn {..} <- pure $ GHC.hsmodAnn $ GHC.hsmodExt modul
-            GHC.AddEpAnn kw' (GHC.EpaSpan s _) <- GHC.am_main anns
+            GHC.AddEpAnn kw' (GHC.EpaSpan (GHC.RealSrcSpan s _)) <- GHC.am_main anns
             guard $ kw == kw'
             pure $ GHC.srcSpanEndLine s
 
@@ -104,7 +104,7 @@ printModuleHeader maxCols conf ls lmodul =
             Just lexports -> Just $ doSort $ commentGroups
                 (GHC.srcSpanToRealSrcSpan . GHC.getLocA)
                 (GHC.unLoc lexports)
-                (epAnnComments . GHC.ann $ GHC.getLoc lexports)
+                (epAnnComments $ GHC.getLoc lexports)
 
         printedModuleHeader = runPrinter_
             (PrinterConfig maxCols)

lib/Language/Haskell/Stylish/Step/SimpleAlign.hs

@@ -12,7 +12,8 @@ module Language.Haskell.Stylish.Step.SimpleAlign
 --------------------------------------------------------------------------------
 import           Data.Either                     (partitionEithers)
 import           Data.Foldable                   (toList)
-import           Data.List                       (foldl', foldl1', sortOn)
+import           Data.List                       (foldl1', sortOn)
+import qualified Data.List                       as List
 import           Data.Maybe                      (fromMaybe)
 import qualified GHC.Hs                          as Hs
 import qualified GHC.Parser.Annotation           as GHC
@@ -117,7 +118,7 @@ matchToAlignable (GHC.L matchLoc m@(Hs.Match _ Hs.CaseAlt pats@(_ : _) grhss)) =
       pat        = last patsLocs
       guards     = getGuards m
       guardsLocs = map GHC.getLocA guards
-      left       = foldl' GHC.combineSrcSpans pat guardsLocs
+      left       = List.foldl' GHC.combineSrcSpans pat guardsLocs
   body     <- rhsBody grhss
   matchPos <- GHC.srcSpanToRealSrcSpan $ GHC.locA matchLoc
   leftPos  <- GHC.srcSpanToRealSrcSpan left
@@ -160,9 +161,9 @@ multiWayIfToAlignable _conf _ = []
 
 --------------------------------------------------------------------------------
 grhsToAlignable
-    :: GHC.GenLocated (GHC.SrcSpanAnn' a) (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))
+    :: GHC.GenLocated (GHC.EpAnnCO) (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))
     -> Maybe (Alignable GHC.RealSrcSpan)
-grhsToAlignable (GHC.L (GHC.SrcSpanAnn _ grhsloc) (Hs.GRHS _ guards@(_ : _) body)) = do
+grhsToAlignable (GHC.L (GHC.EpAnn (GHC.EpaSpan grhsloc) _ _ ) (Hs.GRHS _ guards@(_ : _) body)) = do
     let guardsLocs = map GHC.getLocA guards
         bodyLoc    = GHC.getLocA $ body
         left       = foldl1' GHC.combineSrcSpans guardsLocs

lib/Language/Haskell/Stylish/Step/Squash.hs

@@ -45,11 +45,10 @@ squashFieldDecl _ = mempty
 
 
 --------------------------------------------------------------------------------
-fieldDeclSeparator :: GHC.EpAnn [GHC.AddEpAnn]-> Maybe GHC.RealSrcSpan
-fieldDeclSeparator GHC.EpAnn {..} = listToMaybe $ do
-    GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan s _) <- anns
+fieldDeclSeparator :: [GHC.AddEpAnn]-> Maybe GHC.RealSrcSpan
+fieldDeclSeparator anns = listToMaybe $ do
+    GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan (GHC.RealSrcSpan s _)) <- anns
     pure s
-fieldDeclSeparator _ = Nothing
 
 
 --------------------------------------------------------------------------------
@@ -76,7 +75,7 @@ squashMatch lmatch = case GHC.m_grhss match of
 --------------------------------------------------------------------------------
 matchSeparator :: GHC.EpAnn GHC.GrhsAnn -> Maybe GHC.RealSrcSpan
 matchSeparator GHC.EpAnn {..}
-    | GHC.AddEpAnn _ (GHC.EpaSpan s _) <- GHC.ga_sep anns = Just s
+    | GHC.AddEpAnn _ (GHC.EpaSpan (GHC.RealSrcSpan s _)) <- GHC.ga_sep anns = Just s
 matchSeparator _ = Nothing
 
 

lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs

@@ -20,19 +20,20 @@ import           Language.Haskell.Stylish.Util                 (everything)
 --------------------------------------------------------------------------------
 hsTyReplacements :: GHC.HsType GHC.GhcPs -> Editor.Edits
 hsTyReplacements (GHC.HsFunTy _ arr _ _)
-    | GHC.HsUnrestrictedArrow (GHC.L (GHC.TokenLoc epaLoc) GHC.HsNormalTok) <- arr=
+    | GHC.HsUnrestrictedArrow (GHC.EpUniTok epaLoc GHC.NormalSyntax) <- arr =
         Editor.replaceRealSrcSpan (GHC.epaLocationRealSrcSpan epaLoc) "→"
 hsTyReplacements (GHC.HsQualTy _ ctx _)
-    | Just arrow <- GHC.ac_darrow . GHC.anns . GHC.ann $ GHC.getLoc ctx
-    , (GHC.NormalSyntax, GHC.EpaSpan loc _) <- arrow =
+    | Just arrow <- GHC.ac_darrow . GHC.anns $ GHC.getLoc ctx
+    , (GHC.NormalSyntax, GHC.EpaSpan (GHC.RealSrcSpan loc _)) <- arrow =
         Editor.replaceRealSrcSpan loc "⇒"
 hsTyReplacements _ = mempty
 
+
 --------------------------------------------------------------------------------
 hsSigReplacements :: GHC.Sig GHC.GhcPs -> Editor.Edits
 hsSigReplacements (GHC.TypeSig ann _ _)
-    | GHC.AddEpAnn GHC.AnnDcolon epaLoc <- GHC.asDcolon $ GHC.anns ann
-    , GHC.EpaSpan loc _ <- epaLoc =
+    | GHC.AddEpAnn GHC.AnnDcolon epaLoc <- GHC.asDcolon ann
+    , GHC.EpaSpan (GHC.RealSrcSpan loc _) <- epaLoc =
         Editor.replaceRealSrcSpan loc "∷"
 hsSigReplacements _ = mempty
 

stack.yaml

@@ -1,11 +1,13 @@
-resolver: nightly-2024-01-05
+resolver: nightly-2024-10-02
 
 extra-deps:
-  - ghc-lib-parser-9.8.1.20231121
-  - ghc-lib-parser-ex-9.8.0.0
+  - ghc-lib-parser-9.10.1.20240511
+  - ghc-lib-parser-ex-9.10.0.0
   - test-framework-0.8.2.0
   - test-framework-hunit-0.3.0.2
   - ansi-wl-pprint-0.6.9
+  - ansi-terminal-1.0.2
+  - ansi-terminal-types-0.11.5
 
 save-hackage-creds: false
-compiler: ghc-9.8.1
+compiler: ghc-9.8.2