Skip to content

Commit 4f08b1a

Browse files
michaelpjmichaelpj
authored
Update to support GHC 9.6 (#459)
1 parent 13f1db7 commit 4f08b1a

16 files changed

+98
-64
lines changed

‎.github/workflows/cabal.yml

+2-2
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,7 @@ jobs:
99
strategy:
1010
matrix:
1111
os: [ubuntu-latest, macOS-latest]
12-
ghc: ["9.0.2", "9.2.7", "9.4.4"]
12+
ghc: ["9.2", "9.4", "9.6"]
1313
fail-fast: false
1414

1515
steps:
@@ -27,7 +27,7 @@ jobs:
2727
key: "${{ runner.os }}-${{ matrix.ghc }}-v9-${{ hashFiles('stylish-haskell.cabal') }}"
2828

2929
- name: Build
30-
run: cabal build --enable-tests
30+
run: cabal build
3131
id: build
3232

3333
- name: Test

‎cabal.project

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
packages: .
2+
3+
tests: true

‎lib/Language/Haskell/Stylish/GHC.hs

+7-1
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ module Language.Haskell.Stylish.GHC
1616
, showOutputable
1717

1818
-- * Deconstruction
19+
, getConDecls
1920
, epAnnComments
2021
, deepAnnComments
2122
) where
@@ -68,7 +69,12 @@ dropBeforeAndAfter :: Located a -> [RealLocated b] -> [RealLocated b]
6869
dropBeforeAndAfter loc = dropBeforeLocated (Just loc) . dropAfterLocated (Just loc)
6970

7071
baseDynFlags :: GHC.DynFlags
71-
baseDynFlags = defaultDynFlags GHCEx.fakeSettings GHCEx.fakeLlvmConfig
72+
baseDynFlags = defaultDynFlags GHCEx.fakeSettings
73+
74+
getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs]
75+
getConDecls d@GHC.HsDataDefn {} = case GHC.dd_cons d of
76+
GHC.NewTypeCon con -> [con]
77+
GHC.DataTypeCons _ cons -> cons
7278

7379
showOutputable :: GHC.Outputable a => a -> String
7480
showOutputable = GHC.showPpr baseDynFlags

‎lib/Language/Haskell/Stylish/Module.hs

+5-7
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,6 @@ import qualified GHC.Types.PkgQual as GHC
4242
import GHC.Types.SrcLoc (GenLocated (..),
4343
RealSrcSpan (..), unLoc)
4444
import qualified GHC.Types.SrcLoc as GHC
45-
import qualified GHC.Unit.Module.Name as GHC
4645

4746

4847
--------------------------------------------------------------------------------
@@ -56,7 +55,7 @@ deriving instance Eq GHC.RawPkgQual
5655

5756
--------------------------------------------------------------------------------
5857
-- | Concrete module type
59-
type Module = GHC.Located GHC.HsModule
58+
type Module = GHC.Located (GHC.HsModule GHC.GhcPs)
6059

6160
importModuleName :: ImportDecl GhcPs -> String
6261
importModuleName = GHC.moduleNameString . GHC.unLoc . GHC.ideclName
@@ -68,9 +67,8 @@ canMergeImport i0 i1 = and $ fmap (\f -> f i0 i1)
6867
, (==) `on` ideclPkgQual
6968
, (==) `on` ideclSource
7069
, hasMergableQualified `on` ideclQualified
71-
, (==) `on` ideclImplicit
7270
, (==) `on` fmap unLoc . ideclAs
73-
, (==) `on` fmap fst . ideclHiding -- same 'hiding' flags
71+
, (==) `on` fmap fst . ideclImportList -- same 'hiding' flags
7472
]
7573
where
7674
hasMergableQualified QualifiedPre QualifiedPost = True
@@ -120,10 +118,10 @@ mergeModuleImport
120118
:: GHC.LImportDecl GHC.GhcPs -> GHC.LImportDecl GHC.GhcPs
121119
-> GHC.LImportDecl GHC.GhcPs
122120
mergeModuleImport (L p0 i0) (L _p1 i1) =
123-
L p0 $ i0 { ideclHiding = newImportNames }
121+
L p0 $ i0 { ideclImportList = newImportNames }
124122
where
125123
newImportNames =
126-
case (ideclHiding i0, ideclHiding i1) of
124+
case (ideclImportList i0, ideclImportList i1) of
127125
(Just (b, L p imps0), Just (_, L _ imps1)) -> Just (b, L p (imps0 `merge` imps1))
128126
(Nothing, Nothing) -> Nothing
129127
(Just x, Nothing) -> Just x
@@ -137,7 +135,7 @@ queryModule f = everything (++) (mkQ [] f)
137135

138136
moduleLanguagePragmas :: Module -> [(RealSrcSpan, NonEmpty String)]
139137
moduleLanguagePragmas =
140-
mapMaybe prag . epAnnComments . GHC.hsmodAnn . GHC.unLoc
138+
mapMaybe prag . epAnnComments . GHC.hsmodAnn . GHC.hsmodExt . GHC.unLoc
141139
where
142140
prag :: GHC.LEpaComment -> Maybe (GHC.RealSrcSpan, NonEmpty String)
143141
prag comment = case GHC.ac_tok (GHC.unLoc comment) of

‎lib/Language/Haskell/Stylish/Ordering.hs

+1-2
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,6 @@ import Data.Function (on)
1717
import Data.Ord (comparing)
1818
import GHC.Hs
1919
import qualified GHC.Hs as GHC
20-
import GHC.Types.Name.Reader (RdrName)
2120
import GHC.Types.SrcLoc (unLoc)
2221
import GHC.Utils.Outputable (Outputable)
2322
import qualified GHC.Utils.Outputable as GHC
@@ -55,7 +54,7 @@ compareLIE = comparing $ ieKey . unLoc
5554

5655

5756
--------------------------------------------------------------------------------
58-
compareWrappedName :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering
57+
compareWrappedName :: IEWrappedName GhcPs -> IEWrappedName GhcPs -> Ordering
5958
compareWrappedName = comparing nameKey
6059

6160

‎lib/Language/Haskell/Stylish/Parse.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,7 @@ import qualified GHC.Driver.Session as GHC
2020
import qualified GHC.LanguageExtensions.Type as LangExt
2121
import qualified GHC.Parser.Header as GHC
2222
import qualified GHC.Parser.Lexer as GHC
23+
import qualified GHC.Types.Error as GHC
2324
import qualified GHC.Types.SrcLoc as GHC
2425
import qualified GHC.Utils.Error as GHC
2526
import qualified Language.Haskell.GhclibParserEx.GHC.Driver.Session as GHCEx
@@ -114,7 +115,7 @@ parseModule externalExts0 fp string = do
114115
-- Actual parse.
115116
case GHCEx.parseModule input dynFlags1 of
116117
GHC.POk _ m -> Right m
117-
GHC.PFailed ps -> Left . withFileName . GHC.showSDoc dynFlags1 . GHC.pprMessages . snd $
118+
GHC.PFailed ps -> Left . withFileName . GHC.showSDoc dynFlags1 . GHC.pprMessages GHC.NoDiagnosticOpts . snd $
118119
GHC.getPsMessages ps
119120
where
120121
withFileName x = maybe "" (<> ": ") fp <> x

‎lib/Language/Haskell/Stylish/Printer.hs

-2
Original file line numberDiff line numberDiff line change
@@ -50,11 +50,9 @@ import Prelude hiding (lines)
5050
--------------------------------------------------------------------------------
5151
import qualified GHC.Hs as GHC
5252
import GHC.Hs.Extension (GhcPs)
53-
import qualified GHC.Types.Basic as GHC
5453
import GHC.Types.Name.Reader (RdrName (..))
5554
import GHC.Types.SrcLoc (GenLocated (..))
5655
import qualified GHC.Types.SrcLoc as GHC
57-
import qualified GHC.Unit.Module.Name as GHC
5856
import GHC.Utils.Outputable (Outputable)
5957

6058
--------------------------------------------------------------------------------

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

+6-5
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ module Language.Haskell.Stylish.Step.Data
1818

1919
--------------------------------------------------------------------------------
2020
import Control.Monad (forM_, unless, when)
21+
import Data.Foldable (toList)
2122
import Data.List (sortBy)
2223
import Data.Maybe (listToMaybe, maybeToList)
2324
import qualified GHC.Hs as GHC
@@ -139,7 +140,7 @@ putDataDecl cfg@Config {..} decl = do
139140
let defn = dataDefn decl
140141
constructorComments = commentGroups
141142
(GHC.srcSpanToRealSrcSpan . GHC.getLocA)
142-
(GHC.dd_cons defn)
143+
(getConDecls defn)
143144
(dataComments decl)
144145

145146
onelineEnum =
@@ -296,7 +297,7 @@ putDeriving Config{..} lclause = do
296297
putUnbrokenEnum :: Config -> DataDecl -> P ()
297298
putUnbrokenEnum cfg decl = sep
298299
(space >> putText "|" >> space)
299-
(fmap (putConstructor cfg 0) . GHC.dd_cons . dataDefn $ decl)
300+
(fmap (putConstructor cfg 0) . getConDecls . dataDefn $ decl)
300301

301302
putName :: DataDecl -> P ()
302303
putName decl@MkDataDecl{..} =
@@ -329,7 +330,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
329330
GHC.ConDeclGADT {..} -> do
330331
-- Put argument to constructor first:
331332
case con_g_args of
332-
GHC.PrefixConGADT _ -> sep (comma >> space) $ fmap putRdrName con_names
333+
GHC.PrefixConGADT _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names
333334
GHC.RecConGADT _ _ -> error . mconcat $
334335
[ "Language.Haskell.Stylish.Step.Data.putConstructor: "
335336
, "encountered a GADT with record constructors, not supported yet"
@@ -469,7 +470,7 @@ putNewtypeConstructor cfg lcons = case GHC.unLoc lcons of
469470
putForAll
470471
:: GHC.OutputableBndrFlag s 'GHC.Parsed
471472
=> Bool -> [GHC.LHsTyVarBndr s GHC.GhcPs] -> P ()
472-
putForAll forall ex_tvs = when forall do
473+
putForAll frall ex_tvs = when frall do
473474
putText "forall"
474475
space
475476
sep space $ putOutputable . GHC.unLoc <$> ex_tvs
@@ -530,7 +531,7 @@ isGADT = any isGADTCons . GHC.dd_cons . dataDefn
530531
_ -> False
531532

532533
isNewtype :: DataDecl -> Bool
533-
isNewtype = (== GHC.NewType) . GHC.dd_ND . dataDefn
534+
isNewtype = (== GHC.NewType) . GHC.dataDefnConsNewOrData . GHC.dd_cons . dataDefn
534535

535536
isInfix :: DataDecl -> Bool
536537
isInfix = (== GHC.Infix) . dataFixity

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

+9-7
Original file line numberDiff line numberDiff line change
@@ -44,8 +44,8 @@ import qualified GHC.Types.Name.Reader as GHC
4444
import qualified GHC.Types.PkgQual as GHC
4545
import qualified GHC.Types.SourceText as GHC
4646
import qualified GHC.Types.SrcLoc as GHC
47-
import qualified GHC.Unit.Module.Name as GHC
48-
import qualified GHC.Unit.Types as GHC
47+
--import qualified GHC.Unit.Module.Name as GHC
48+
--import qualified GHC.Unit.Types as GHC
4949
import qualified Text.Regex.TDFA as Regex
5050
import Text.Regex.TDFA (Regex)
5151
import Text.Regex.TDFA.ReadRegex (parseRegex)
@@ -367,7 +367,7 @@ printQualified Options{..} padNames stats ldecl = do
367367
-- Only print spaces if something follows.
368368
let somethingFollows =
369369
isJust (GHC.ideclAs decl) || isHiding decl ||
370-
not (null $ GHC.ideclHiding decl)
370+
not (null $ GHC.ideclImportList decl)
371371
when (padNames && somethingFollows) $ putText $ replicate
372372
(isLongestImport stats - importModuleNameLength decl)
373373
' '
@@ -396,7 +396,7 @@ printQualified Options{..} padNames stats ldecl = do
396396

397397
pure ()
398398

399-
case snd <$> GHC.ideclHiding decl of
399+
case snd <$> GHC.ideclImportList decl of
400400
Nothing -> pure ()
401401
Just limports | null (GHC.unLoc limports) -> case emptyListAlign of
402402
RightAfter -> modifyCurrentLine trimRight >> space >> putText "()"
@@ -536,9 +536,9 @@ printImport _ (GHC.IEDocNamed _ _) =
536536

537537

538538
--------------------------------------------------------------------------------
539-
printIeWrappedName :: GHC.LIEWrappedName GHC.RdrName -> P ()
539+
printIeWrappedName :: GHC.LIEWrappedName GHC.GhcPs -> P ()
540540
printIeWrappedName lie = case GHC.unLoc lie of
541-
GHC.IEName n -> putRdrName n
541+
GHC.IEName _ n -> putRdrName n
542542
GHC.IEPattern _ n -> putText "pattern" >> space >> putRdrName n
543543
GHC.IEType _ n -> putText "type" >> space >> putRdrName n
544544

@@ -603,7 +603,9 @@ isQualified :: GHC.ImportDecl GHC.GhcPs -> Bool
603603
isQualified = (/=) GHC.NotQualified . GHC.ideclQualified
604604

605605
isHiding :: GHC.ImportDecl GHC.GhcPs -> Bool
606-
isHiding = maybe False fst . GHC.ideclHiding
606+
isHiding d = case GHC.ideclImportList d of
607+
Just (GHC.EverythingBut, _) -> True
608+
_ -> False
607609

608610
isSource :: GHC.ImportDecl GHC.GhcPs -> Bool
609611
isSource = (==) GHC.IsBoot . GHC.ideclSource

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

+3-4
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ import Data.Maybe (fromMaybe, isJust,
1818
listToMaybe)
1919
import qualified GHC.Hs as GHC
2020
import qualified GHC.Types.SrcLoc as GHC
21-
import qualified GHC.Unit.Module.Name as GHC
2221

2322

2423
--------------------------------------------------------------------------------
@@ -80,16 +79,16 @@ printModuleHeader maxCols conf ls lmodul =
8079
GHC.srcSpanEndLine <$> GHC.srcSpanToRealSrcSpan loc)
8180

8281
keywordLine kw = listToMaybe $ do
83-
GHC.EpAnn {..} <- pure $ GHC.hsmodAnn modul
84-
GHC.AddEpAnn kw' (GHC.EpaSpan s) <- GHC.am_main anns
82+
GHC.EpAnn {..} <- pure $ GHC.hsmodAnn $ GHC.hsmodExt modul
83+
GHC.AddEpAnn kw' (GHC.EpaSpan s _) <- GHC.am_main anns
8584
guard $ kw == kw'
8685
pure $ GHC.srcSpanEndLine s
8786

8887
moduleLine = keywordLine GHC.AnnModule
8988
whereLine = keywordLine GHC.AnnWhere
9089

9190
commentOnLine l = listToMaybe $ do
92-
comment <- epAnnComments $ GHC.hsmodAnn modul
91+
comment <- epAnnComments $ GHC.hsmodAnn $ GHC.hsmodExt modul
9392
guard $ GHC.srcSpanStartLine (GHC.anchor $ GHC.getLoc comment) == l
9493
pure comment
9594

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

+6-8
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ import qualified GHC.Types.SrcLoc as GHC
2222
--------------------------------------------------------------------------------
2323
import Language.Haskell.Stylish.Align
2424
import qualified Language.Haskell.Stylish.Editor as Editor
25+
import Language.Haskell.Stylish.GHC
2526
import Language.Haskell.Stylish.Module
2627
import Language.Haskell.Stylish.Step
2728
import Language.Haskell.Stylish.Util
@@ -63,20 +64,16 @@ type Record = [GHC.LocatedA (Hs.ConDeclField Hs.GhcPs)]
6364

6465

6566
--------------------------------------------------------------------------------
66-
records :: GHC.Located Hs.HsModule -> [Record]
67+
records :: Module -> [Record]
6768
records modu = do
6869
let decls = map GHC.unLoc (Hs.hsmodDecls (GHC.unLoc modu))
6970
tyClDecls = [ tyClDecl | Hs.TyClD _ tyClDecl <- decls ]
7071
dataDecls = [ d | d@(Hs.DataDecl _ _ _ _ _) <- tyClDecls ]
7172
dataDefns = map Hs.tcdDataDefn dataDecls
72-
d@Hs.ConDeclH98 {} <- concatMap getConDecls dataDefns
73+
d@Hs.ConDeclH98 {} <- GHC.unLoc <$> concatMap getConDecls dataDefns
7374
case Hs.con_args d of
7475
Hs.RecCon rec -> [GHC.unLoc rec]
7576
_ -> []
76-
where
77-
getConDecls :: Hs.HsDataDefn Hs.GhcPs -> [Hs.ConDecl Hs.GhcPs]
78-
getConDecls d@Hs.HsDataDefn {} = map GHC.unLoc $ Hs.dd_cons d
79-
8077

8178
--------------------------------------------------------------------------------
8279
recordToAlignable :: Config -> Record -> [[Alignable GHC.RealSrcSpan]]
@@ -103,8 +100,9 @@ matchGroupToAlignable
103100
:: Config
104101
-> Hs.MatchGroup Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)
105102
-> [[Alignable GHC.RealSrcSpan]]
106-
matchGroupToAlignable conf (Hs.MG _ alts _) = cases' ++ patterns'
103+
matchGroupToAlignable conf mg = cases' ++ patterns'
107104
where
105+
alts = Hs.mg_alts mg
108106
(cases, patterns) = partitionEithers . fromMaybe [] $ traverse matchToAlignable (GHC.unLoc alts)
109107
cases' = groupAlign (cCases conf) cases
110108
patterns' = groupAlign (cTopLevelPatterns conf) patterns
@@ -184,7 +182,7 @@ grhsToAlignable (GHC.L _ _) = Nothing
184182
step :: Maybe Int -> Config -> Step
185183
step maxColumns config = makeStep "Cases" $ \ls module' ->
186184
let changes
187-
:: (GHC.Located Hs.HsModule -> [a])
185+
:: (Module -> [a])
188186
-> (a -> [[Alignable GHC.RealSrcSpan]])
189187
-> Editor.Edits
190188
changes search toAlign = mconcat $ do

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

+2-2
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ squashFieldDecl _ = mempty
4747
--------------------------------------------------------------------------------
4848
fieldDeclSeparator :: GHC.EpAnn [GHC.AddEpAnn]-> Maybe GHC.RealSrcSpan
4949
fieldDeclSeparator GHC.EpAnn {..} = listToMaybe $ do
50-
GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan s) <- anns
50+
GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan s _) <- anns
5151
pure s
5252
fieldDeclSeparator _ = Nothing
5353

@@ -76,7 +76,7 @@ squashMatch lmatch = case GHC.m_grhss match of
7676
--------------------------------------------------------------------------------
7777
matchSeparator :: GHC.EpAnn GHC.GrhsAnn -> Maybe GHC.RealSrcSpan
7878
matchSeparator GHC.EpAnn {..}
79-
| GHC.AddEpAnn _ (GHC.EpaSpan s) <- GHC.ga_sep anns = Just s
79+
| GHC.AddEpAnn _ (GHC.EpaSpan s _) <- GHC.ga_sep anns = Just s
8080
matchSeparator _ = Nothing
8181

8282

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

+2-2
Original file line numberDiff line numberDiff line change
@@ -24,15 +24,15 @@ hsTyReplacements (GHC.HsFunTy _ arr _ _)
2424
Editor.replaceRealSrcSpan (GHC.epaLocationRealSrcSpan epaLoc) "→"
2525
hsTyReplacements (GHC.HsQualTy _ ctx _)
2626
| Just arrow <- GHC.ac_darrow . GHC.anns . GHC.ann $ GHC.getLoc ctx
27-
, (GHC.NormalSyntax, GHC.EpaSpan loc) <- arrow =
27+
, (GHC.NormalSyntax, GHC.EpaSpan loc _) <- arrow =
2828
Editor.replaceRealSrcSpan loc "⇒"
2929
hsTyReplacements _ = mempty
3030

3131
--------------------------------------------------------------------------------
3232
hsSigReplacements :: GHC.Sig GHC.GhcPs -> Editor.Edits
3333
hsSigReplacements (GHC.TypeSig ann _ _)
3434
| GHC.AddEpAnn GHC.AnnDcolon epaLoc <- GHC.asDcolon $ GHC.anns ann
35-
, GHC.EpaSpan loc <- epaLoc =
35+
, GHC.EpaSpan loc _ <- epaLoc =
3636
Editor.replaceRealSrcSpan loc "∷"
3737
hsSigReplacements _ = mempty
3838

‎stack.yaml

+7-3
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,11 @@
1-
resolver: nightly-2022-11-05
1+
resolver: nightly-2023-06-23
22

33
extra-deps:
4-
- ghc-lib-parser-9.4.2.20220822@sha256:566b1ddecee9e526f62dadc98dfc89e0f72f5d0d03ebc628c528f9d51b4a5681,14156
5-
- ghc-lib-parser-ex-9.4.0.0@sha256:a55b192642e1efd3fd3a358aff416e88b6b04f33572bd1d7be9e9008648f2523,3493
4+
- ghc-lib-parser-9.6.2.20230523
5+
- ghc-lib-parser-ex-9.6.0.0
6+
- test-framework-0.8.2.0
7+
- test-framework-hunit-0.3.0.2
8+
- ansi-wl-pprint-0.6.9
69

710
save-hackage-creds: false
11+
compiler: ghc-9.6.1

0 commit comments

Comments
 (0)