Update to support GHC 9.6

.github/workflows/cabal.yml

@@ -9,7 +9,7 @@ jobs:
     strategy:
       matrix:
         os: [ubuntu-latest, macOS-latest]
-        ghc: ["9.0.2", "9.2.7", "9.4.4"]
+        ghc: ["9.2", "9.4", "9.6"]
       fail-fast: false
 
     steps:
@@ -27,7 +27,7 @@ jobs:
         key: "${{ runner.os }}-${{ matrix.ghc }}-v9-${{ hashFiles('stylish-haskell.cabal') }}"
 
     - name: Build
-      run: cabal build --enable-tests
+      run: cabal build 
       id: build
 
     - name: Test

cabal.project

@@ -0,0 +1,3 @@
+packages: .
+
+tests: true

lib/Language/Haskell/Stylish/GHC.hs

@@ -16,6 +16,7 @@ module Language.Haskell.Stylish.GHC
   , showOutputable
 
     -- * Deconstruction
+  , getConDecls
   , epAnnComments
   , deepAnnComments
   ) where
@@ -68,7 +69,12 @@ dropBeforeAndAfter :: Located a -> [RealLocated b] -> [RealLocated b]
 dropBeforeAndAfter loc = dropBeforeLocated (Just loc) . dropAfterLocated (Just loc)
 
 baseDynFlags :: GHC.DynFlags
-baseDynFlags = defaultDynFlags GHCEx.fakeSettings GHCEx.fakeLlvmConfig
+baseDynFlags = defaultDynFlags GHCEx.fakeSettings 
+
+getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs]
+getConDecls [email protected] {} = case GHC.dd_cons d of
+  GHC.NewTypeCon con -> [con]
+  GHC.DataTypeCons _ cons -> cons
 
 showOutputable :: GHC.Outputable a => a -> String
 showOutputable = GHC.showPpr baseDynFlags

lib/Language/Haskell/Stylish/Module.hs

@@ -42,7 +42,6 @@ import qualified GHC.Types.PkgQual            as GHC
 import           GHC.Types.SrcLoc             (GenLocated (..),
                                                RealSrcSpan (..), unLoc)
 import qualified GHC.Types.SrcLoc             as GHC
-import qualified GHC.Unit.Module.Name         as GHC
 
 
 --------------------------------------------------------------------------------
@@ -56,7 +55,7 @@ deriving instance Eq GHC.RawPkgQual
 
 --------------------------------------------------------------------------------
 -- | Concrete module type
-type Module = GHC.Located GHC.HsModule
+type Module = GHC.Located (GHC.HsModule GHC.GhcPs)
 
 importModuleName :: ImportDecl GhcPs -> String
 importModuleName = GHC.moduleNameString . GHC.unLoc . GHC.ideclName
@@ -68,9 +67,8 @@ canMergeImport i0 i1 = and $ fmap (\f -> f i0 i1)
   , (==) `on` ideclPkgQual
   , (==) `on` ideclSource
   , hasMergableQualified `on` ideclQualified
-  , (==) `on` ideclImplicit
   , (==) `on` fmap unLoc . ideclAs
-  , (==) `on` fmap fst . ideclHiding -- same 'hiding' flags
+  , (==) `on` fmap fst . ideclImportList -- same 'hiding' flags
   ]
   where
     hasMergableQualified QualifiedPre QualifiedPost = True
@@ -120,10 +118,10 @@ mergeModuleImport
     :: GHC.LImportDecl GHC.GhcPs -> GHC.LImportDecl GHC.GhcPs
     -> GHC.LImportDecl GHC.GhcPs
 mergeModuleImport (L p0 i0) (L _p1 i1) =
-  L p0 $ i0 { ideclHiding = newImportNames }
+  L p0 $ i0 { ideclImportList = newImportNames }
   where
     newImportNames =
-      case (ideclHiding i0, ideclHiding i1) of
+      case (ideclImportList i0, ideclImportList i1) of
         (Just (b, L p imps0), Just (_, L _ imps1)) -> Just (b, L p (imps0 `merge` imps1))
         (Nothing, Nothing) -> Nothing
         (Just x, Nothing) -> Just x
@@ -137,7 +135,7 @@ queryModule f = everything (++) (mkQ [] f)
 
 moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty String)]
 moduleLanguagePragmas =
-    mapMaybe prag . epAnnComments . GHC.hsmodAnn . GHC.unLoc
+    mapMaybe prag . epAnnComments . GHC.hsmodAnn . GHC.hsmodExt . GHC.unLoc
   where
     prag :: GHC.LEpaComment -> Maybe (GHC.RealSrcSpan, NonEmpty String)
     prag comment = case GHC.ac_tok (GHC.unLoc comment) of

lib/Language/Haskell/Stylish/Ordering.hs

@@ -17,7 +17,6 @@ import           Data.Function                (on)
 import           Data.Ord                     (comparing)
 import           GHC.Hs
 import qualified GHC.Hs                       as GHC
-import           GHC.Types.Name.Reader        (RdrName)
 import           GHC.Types.SrcLoc             (unLoc)
 import           GHC.Utils.Outputable         (Outputable)
 import qualified GHC.Utils.Outputable         as GHC
@@ -55,7 +54,7 @@ compareLIE = comparing $ ieKey . unLoc
 
 
 --------------------------------------------------------------------------------
-compareWrappedName :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
+compareWrappedName :: IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering
 compareWrappedName = comparing nameKey
 
 

lib/Language/Haskell/Stylish/Parse.hs

@@ -20,6 +20,7 @@ import qualified GHC.Driver.Session                                 as GHC
 import qualified GHC.LanguageExtensions.Type                        as LangExt
 import qualified GHC.Parser.Header                                  as GHC
 import qualified GHC.Parser.Lexer                                   as GHC
+import qualified GHC.Types.Error                                    as GHC
 import qualified GHC.Types.SrcLoc                                   as GHC
 import qualified GHC.Utils.Error                                    as GHC
 import qualified Language.Haskell.GhclibParserEx.GHC.Driver.Session as GHCEx
@@ -114,7 +115,7 @@ parseModule externalExts0 fp string = do
     -- Actual parse.
     case GHCEx.parseModule input dynFlags1 of
         GHC.POk _ m -> Right m
-        GHC.PFailed ps -> Left . withFileName . GHC.showSDoc dynFlags1 . GHC.pprMessages . snd $
+        GHC.PFailed ps -> Left . withFileName . GHC.showSDoc dynFlags1 . GHC.pprMessages GHC.NoDiagnosticOpts . snd $
             GHC.getPsMessages ps
   where
     withFileName x = maybe "" (<> ": ") fp <> x

lib/Language/Haskell/Stylish/Printer.hs

@@ -50,11 +50,9 @@ import           Prelude                         hiding (lines)
 --------------------------------------------------------------------------------
 import qualified GHC.Hs                          as GHC
 import           GHC.Hs.Extension                (GhcPs)
-import qualified GHC.Types.Basic                 as GHC
 import           GHC.Types.Name.Reader           (RdrName (..))
 import           GHC.Types.SrcLoc                (GenLocated (..))
 import qualified GHC.Types.SrcLoc                as GHC
-import qualified GHC.Unit.Module.Name            as GHC
 import           GHC.Utils.Outputable            (Outputable)
 
 --------------------------------------------------------------------------------

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

@@ -18,6 +18,7 @@ module Language.Haskell.Stylish.Step.Data
 
 --------------------------------------------------------------------------------
 import           Control.Monad                     (forM_, unless, when)
+import           Data.Foldable                     (toList)
 import           Data.List                         (sortBy)
 import           Data.Maybe                        (listToMaybe, maybeToList)
 import qualified GHC.Hs                            as GHC
@@ -139,7 +140,7 @@ putDataDecl cfg@Config {..} decl = do
     let defn = dataDefn decl
         constructorComments = commentGroups
             (GHC.srcSpanToRealSrcSpan . GHC.getLocA)
-            (GHC.dd_cons defn)
+            (getConDecls defn)
             (dataComments decl)
 
         onelineEnum =
@@ -296,7 +297,7 @@ putDeriving Config{..} lclause = do
 putUnbrokenEnum :: Config -> DataDecl -> P ()
 putUnbrokenEnum cfg decl = sep
     (space >> putText "|" >> space)
-    (fmap (putConstructor cfg 0) . GHC.dd_cons . dataDefn $ decl)
+    (fmap (putConstructor cfg 0) . getConDecls . dataDefn $ decl)
 
 putName :: DataDecl -> P ()
 putName decl@MkDataDecl{..} =
@@ -329,7 +330,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 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"
@@ -469,7 +470,7 @@ putNewtypeConstructor cfg lcons = case GHC.unLoc lcons of
 putForAll
     :: GHC.OutputableBndrFlag s 'GHC.Parsed
     => Bool -> [GHC.LHsTyVarBndr s GHC.GhcPs] -> P ()
-putForAll forall ex_tvs = when forall do
+putForAll frall ex_tvs = when frall do
     putText "forall"
     space
     sep space $ putOutputable . GHC.unLoc <$> ex_tvs
@@ -530,7 +531,7 @@ isGADT = any isGADTCons . GHC.dd_cons . dataDefn
       _                  -> False
 
 isNewtype :: DataDecl -> Bool
-isNewtype = (== GHC.NewType) . GHC.dd_ND . dataDefn
+isNewtype = (== GHC.NewType) . GHC.dataDefnConsNewOrData . GHC.dd_cons . dataDefn
 
 isInfix :: DataDecl -> Bool
 isInfix = (== GHC.Infix) . dataFixity

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

@@ -44,8 +44,8 @@ import qualified GHC.Types.Name.Reader             as GHC
 import qualified GHC.Types.PkgQual                 as GHC
 import qualified GHC.Types.SourceText              as GHC
 import qualified GHC.Types.SrcLoc                  as GHC
-import qualified GHC.Unit.Module.Name              as GHC
-import qualified GHC.Unit.Types                    as GHC
+--import qualified GHC.Unit.Module.Name              as GHC
+--import qualified GHC.Unit.Types                    as GHC
 import qualified Text.Regex.TDFA                   as Regex
 import           Text.Regex.TDFA                   (Regex)
 import           Text.Regex.TDFA.ReadRegex         (parseRegex)
@@ -367,7 +367,7 @@ printQualified Options{..} padNames stats ldecl = do
             -- Only print spaces if something follows.
             let somethingFollows =
                     isJust (GHC.ideclAs decl) || isHiding decl ||
-                    not (null $ GHC.ideclHiding decl)
+                    not (null $ GHC.ideclImportList decl)
             when (padNames && somethingFollows) $ putText $ replicate
                 (isLongestImport stats - importModuleNameLength decl)
                 ' '
@@ -396,7 +396,7 @@ printQualified Options{..} padNames stats ldecl = do
 
     pure ()
 
-    case snd <$> GHC.ideclHiding decl of
+    case snd <$> GHC.ideclImportList decl of
         Nothing -> pure ()
         Just limports | null (GHC.unLoc limports) -> case emptyListAlign of
             RightAfter -> modifyCurrentLine trimRight >> space >> putText "()"
@@ -536,9 +536,9 @@ printImport _ (GHC.IEDocNamed _ _) =
 
 
 --------------------------------------------------------------------------------
-printIeWrappedName :: GHC.LIEWrappedName GHC.RdrName -> P ()
+printIeWrappedName :: GHC.LIEWrappedName GHC.GhcPs -> P ()
 printIeWrappedName lie = case GHC.unLoc lie of
-    GHC.IEName      n -> putRdrName n
+    GHC.IEName    _ n -> putRdrName n
     GHC.IEPattern _ n -> putText "pattern" >> space >> putRdrName n
     GHC.IEType    _ n -> putText "type" >> space >> putRdrName n
 
@@ -603,7 +603,9 @@ isQualified :: GHC.ImportDecl GHC.GhcPs -> Bool
 isQualified = (/=) GHC.NotQualified . GHC.ideclQualified
 
 isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool
-isHiding = maybe False fst . GHC.ideclHiding
+isHiding d = case GHC.ideclImportList d of
+  Just (GHC.EverythingBut, _) -> True
+  _ -> False
 
 isSource :: GHC.ImportDecl GHC.GhcPs -> Bool
 isSource = (==) GHC.IsBoot . GHC.ideclSource

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

@@ -18,7 +18,6 @@ import           Data.Maybe                            (fromMaybe, isJust,
                                                         listToMaybe)
 import qualified GHC.Hs                                as GHC
 import qualified GHC.Types.SrcLoc                      as GHC
-import qualified GHC.Unit.Module.Name                  as GHC
 
 
 --------------------------------------------------------------------------------
@@ -80,16 +79,16 @@ printModuleHeader maxCols conf ls lmodul =
                 GHC.srcSpanEndLine <$> GHC.srcSpanToRealSrcSpan loc)
 
         keywordLine kw = listToMaybe $ do
-            GHC.EpAnn {..} <- pure $ GHC.hsmodAnn modul
-            GHC.AddEpAnn kw' (GHC.EpaSpan s) <- GHC.am_main anns
+            GHC.EpAnn {..} <- pure $ GHC.hsmodAnn $ GHC.hsmodExt modul
+            GHC.AddEpAnn kw' (GHC.EpaSpan s _) <- GHC.am_main anns
             guard $ kw == kw'
             pure $ GHC.srcSpanEndLine s
 
         moduleLine = keywordLine GHC.AnnModule
         whereLine = keywordLine GHC.AnnWhere
 
         commentOnLine l = listToMaybe $ do
-            comment <- epAnnComments $ GHC.hsmodAnn modul
+            comment <- epAnnComments $ GHC.hsmodAnn $ GHC.hsmodExt modul
             guard $ GHC.srcSpanStartLine (GHC.anchor $ GHC.getLoc comment) == l
             pure comment
 

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

@@ -22,6 +22,7 @@ import qualified GHC.Types.SrcLoc                as GHC
 --------------------------------------------------------------------------------
 import           Language.Haskell.Stylish.Align
 import qualified Language.Haskell.Stylish.Editor as Editor
+import           Language.Haskell.Stylish.GHC
 import           Language.Haskell.Stylish.Module
 import           Language.Haskell.Stylish.Step
 import           Language.Haskell.Stylish.Util
@@ -63,20 +64,16 @@ type Record = [GHC.LocatedA (Hs.ConDeclField Hs.GhcPs)]
 
 
 --------------------------------------------------------------------------------
-records :: GHC.Located Hs.HsModule -> [Record]
+records :: Module -> [Record]
 records modu = do
   let decls           = map GHC.unLoc (Hs.hsmodDecls (GHC.unLoc modu))
       tyClDecls       = [ tyClDecl | Hs.TyClD _ tyClDecl <- decls ]
       dataDecls       = [ d | d@(Hs.DataDecl _ _ _ _ _)  <- tyClDecls ]
       dataDefns       = map Hs.tcdDataDefn dataDecls
-  [email protected] {} <- concatMap getConDecls dataDefns
+  [email protected] {} <- GHC.unLoc <$> concatMap getConDecls dataDefns
   case Hs.con_args d of
       Hs.RecCon rec -> [GHC.unLoc rec]
       _             -> []
- where
-  getConDecls :: Hs.HsDataDefn Hs.GhcPs -> [Hs.ConDecl Hs.GhcPs]
-  getConDecls [email protected] {} = map GHC.unLoc $ Hs.dd_cons d
-
 
 --------------------------------------------------------------------------------
 recordToAlignable :: Config -> Record -> [[Alignable GHC.RealSrcSpan]]
@@ -103,8 +100,9 @@ matchGroupToAlignable
     :: Config
     -> Hs.MatchGroup Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)
     -> [[Alignable GHC.RealSrcSpan]]
-matchGroupToAlignable conf (Hs.MG _ alts _) = cases' ++ patterns'
+matchGroupToAlignable conf mg = cases' ++ patterns'
   where
+    alts = Hs.mg_alts mg
     (cases, patterns) = partitionEithers . fromMaybe [] $ traverse matchToAlignable (GHC.unLoc alts)
     cases' = groupAlign (cCases conf) cases
     patterns' = groupAlign (cTopLevelPatterns conf) patterns
@@ -184,7 +182,7 @@ grhsToAlignable (GHC.L _ _)            = Nothing
 step :: Maybe Int -> Config -> Step
 step maxColumns config = makeStep "Cases" $ \ls module' ->
     let changes
-            :: (GHC.Located Hs.HsModule -> [a])
+            :: (Module -> [a])
             -> (a -> [[Alignable GHC.RealSrcSpan]])
             -> Editor.Edits
         changes search toAlign = mconcat $ do

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

@@ -47,7 +47,7 @@ squashFieldDecl _ = mempty
 --------------------------------------------------------------------------------
 fieldDeclSeparator :: GHC.EpAnn [GHC.AddEpAnn]-> Maybe GHC.RealSrcSpan
 fieldDeclSeparator GHC.EpAnn {..} = listToMaybe $ do
-    GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan s) <- anns
+    GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan s _) <- anns
     pure s
 fieldDeclSeparator _ = Nothing
 
@@ -76,7 +76,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 s _) <- GHC.ga_sep anns = Just s
 matchSeparator _ = Nothing
 
 

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

@@ -24,15 +24,15 @@ hsTyReplacements (GHC.HsFunTy _ 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 =
+    , (GHC.NormalSyntax, GHC.EpaSpan 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.EpaSpan loc _ <- epaLoc =
         Editor.replaceRealSrcSpan loc "∷"
 hsSigReplacements _ = mempty
 

stack.yaml

@@ -1,7 +1,11 @@
-resolver: nightly-2022-11-05
+resolver: nightly-2023-06-23
 
 extra-deps:
-  - ghc-lib-parser-9.4.2.20220822@sha256:566b1ddecee9e526f62dadc98dfc89e0f72f5d0d03ebc628c528f9d51b4a5681,14156
-  - ghc-lib-parser-ex-9.4.0.0@sha256:a55b192642e1efd3fd3a358aff416e88b6b04f33572bd1d7be9e9008648f2523,3493
+  - ghc-lib-parser-9.6.2.20230523
+  - ghc-lib-parser-ex-9.6.0.0
+  - test-framework-0.8.2.0
+  - test-framework-hunit-0.3.0.2
+  - ansi-wl-pprint-0.6.9
 
 save-hackage-creds: false
+compiler: ghc-9.6.1