Skip to content

Commit 4f08b1a

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

File tree

16 files changed

+98
-64
lines changed

16 files changed

+98
-64
lines changed

‎.github/workflows/cabal.yml‎

Lines changed: 2 additions & 2 deletions
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‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
packages: .
2+
3+
tests: true

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

Lines changed: 7 additions & 1 deletion
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‎

Lines changed: 5 additions & 7 deletions
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‎

Lines changed: 1 addition & 2 deletions
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‎

Lines changed: 2 additions & 1 deletion
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‎

Lines changed: 0 additions & 2 deletions
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‎

Lines changed: 6 additions & 5 deletions
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‎

Lines changed: 9 additions & 7 deletions
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‎

Lines changed: 3 additions & 4 deletions
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

0 commit comments

Comments
 (0)