Upgrade to ghc 9.10

.github/workflows/ci.yml

@@ -4,12 +4,12 @@ on: ['pull_request', 'push']
 
 jobs:
   build:
-    name: Build on ${{ matrix.os }}
+    name: Build on ${{ matrix.os }} with GHC ${{ matrix.ghc }}
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
         os: [ubuntu-latest, macOS-latest]
-        ghc: ["9.4", "9.6", "9.8"]
+        ghc: ["9.6", "9.8", "9.10"]
 
     steps:
     - uses: actions/checkout@v4

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,15 +93,27 @@ step cfg = makeStep "Data" \ls m -> Editor.apply (changes m) ls
     changes :: Module -> Editor.Edits
     changes = foldMap (formatDataDecl cfg) . dataDecls
 
+    getComments :: GHC.RealSrcSpan -> GHC.SrcSpanAnnA -> [GHC.LEpaComment]
+    getComments declSpan declAnnos=
+        filter isAfterStart $ epAnnComments declAnnos
+      where
+        -- workaround to make sure we don't reprint a haddock
+        -- comment before a data declaration after a data
+        -- declaration
+        isAfterStart :: GHC.LEpaComment -> Bool
+        isAfterStart (GHC.L (GHC.EpaSpan (GHC.RealSrcSpan commentSpan _)) _) =
+               GHC.srcSpanStartLine commentSpan >= GHC.srcSpanStartLine declSpan
+        isAfterStart _ = False
+
     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
+        (GHC.L declAnnos (GHC.TyClD _ tycld)) <- pure ldecl
+        declSpan <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl
         case tycld of
             GHC.DataDecl {..} -> pure $ MkDataDecl
-                { dataComments = epAnnComments tcdDExt
-                , dataLoc      = loc
+                { dataComments = getComments declSpan declAnnos
+                , dataLoc      = declSpan
                 , dataDeclName = tcdLName
                 , dataTypeVars = tcdTyVars
                 , dataDefn     = tcdDataDefn
@@ -330,7 +342,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 +362,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 +396,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

@@ -23,6 +23,7 @@
   ) where
 
 --------------------------------------------------------------------------------
+import           Control.Applicative               ((<|>))
 import           Control.Monad                     (forM_, void, when)
 import qualified Data.Aeson                        as A
 import           Data.Foldable                     (toList)
@@ -286,7 +287,7 @@
     -- groups is non-empty by the pattern for this case
     -- imports is non-empty as long as groups is non-empty
     block = Block
       (GHC.srcSpanStartLine . src $ head imports)
       (GHC.srcSpanEndLine   . src $ last imports)
     src = fromMaybe (error "regroupImports: missing location") .
       GHC.srcSpanToRealSrcSpan . GHC.getLocA
@@ -507,19 +508,19 @@
 
 --------------------------------------------------------------------------------
 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 @@
   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,7 @@
 --------------------------------------------------------------------------------
 import           Data.Either                     (partitionEithers)
 import           Data.Foldable                   (toList)
 import           Data.List                       (foldl', foldl1', sortOn)
 import           Data.Maybe                      (fromMaybe)
 import qualified GHC.Hs                          as Hs
 import qualified GHC.Parser.Annotation           as GHC
@@ -160,9 +160,9 @@
 
 --------------------------------------------------------------------------------
 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
 

stylish-haskell.cabal

@@ -19,10 +19,12 @@ Description:
     <https://github.com/haskell/stylish-haskell/blob/master/README.markdown>
 
 Extra-source-files:
-  CHANGELOG,
   README.markdown,
   data/stylish-haskell.yaml
 
+Extra-doc-files:
+  CHANGELOG
+
 Flag ghc-lib
   Default: True
   Manual:  True
@@ -38,9 +40,9 @@ Common depends
     base              >= 4.8    && < 5,
     bytestring        >= 0.9    && < 0.13,
     Cabal             >= 3.14   && < 4.0,
-    containers        >= 0.3    && < 0.7,
+    containers        >= 0.3    && < 0.9,
     directory         >= 1.2.3  && < 1.4,
-    filepath          >= 1.1    && < 1.5,
+    filepath          >= 1.1    && < 1.6,
     file-embed        >= 0.0.10 && < 0.1,
     mtl               >= 2.0    && < 2.4,
     regex-tdfa        >= 1.3    && < 1.4,
@@ -54,20 +56,20 @@ Common depends
       semigroups >= 0.18 && < 0.20
 
   -- Use GHC if the ghc-lib flag is not set
-  -- and we have a new enough GHC. Note that 
-  -- this will only work if the user's 
+  -- and we have a new enough GHC. Note that
+  -- this will only work if the user's
   -- compiler is of the matching major version!
-  if !flag(ghc-lib) && impl(ghc >= 9.8) && impl(ghc < 9.9)
+  if !flag(ghc-lib) && impl(ghc >= 9.8) && impl(ghc < 9.11)
     Build-depends:
-      ghc >= 9.8 && < 9.9,
+      ghc >= 9.10 && < 9.11,
       ghc-boot,
       ghc-boot-th
   else
     Build-depends:
-      ghc-lib-parser >= 9.8 && < 9.9
+      ghc-lib-parser >= 9.10 && < 9.11
 
   Build-depends:
-    ghc-lib-parser-ex >= 9.8 && < 9.9
+    ghc-lib-parser-ex >= 9.10 && < 9.11
 
 Library
   Import:         depends