Skip to content

Commit ce15c5a

Browse files
jhrcekjhrcek
authored
Upgrade to ghc 9.10 (#480)
1 parent 29e933d commit ce15c5a

File tree

11 files changed

+75
-70
lines changed

11 files changed

+75
-70
lines changed

‎.github/workflows/ci.yml‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4,12 +4,12 @@ on: ['pull_request', 'push']
44

55
jobs:
66
build:
7-
name: Build on ${{ matrix.os }}
7+
name: Build on ${{ matrix.os }} with GHC ${{ matrix.ghc }}
88
runs-on: ${{ matrix.os }}
99
strategy:
1010
matrix:
1111
os: [ubuntu-latest, macOS-latest]
12-
ghc: ["9.4", "9.6", "9.8"]
12+
ghc: ["9.6.6", "9.8", "9.10"]
1313

1414
steps:
1515
- uses: actions/checkout@v4
@@ -22,18 +22,18 @@ jobs:
2222
- uses: actions/cache@v3
2323
with:
2424
path: ${{ steps.setup.outputs.cabal-store }}
25-
key: ${{ runner.os }}-${{ matrix.ghc }}-v1-${{ hashFiles('*.cabal') }}
25+
key: ${{ runner.os }}-${{ matrix.ghc }}-v2-${{ hashFiles('*.cabal') }}
2626
restore-keys: |
27-
${{ runner.os }}-${{ matrix.ghc }}-v1-
27+
${{ runner.os }}-${{ matrix.ghc }}-v2-
2828
2929
- run: make build
3030
- run: make test
3131

32-
- if: startsWith(github.ref, 'refs/tags') && matrix.ghc == '9.6'
32+
- if: startsWith(github.ref, 'refs/tags') && startsWith(matrix.ghc, '9.8')
3333
run: make artifact
3434

3535
- uses: actions/upload-artifact@v4
36-
if: startsWith(github.ref, 'refs/tags') && matrix.ghc == '9.6'
36+
if: startsWith(github.ref, 'refs/tags') && startsWith(matrix.ghc, '9.8')
3737
with:
3838
path: artifacts/*
3939
name: artifacts-${{ runner.os }}

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ dropBeforeAndAfter :: Located a -> [RealLocated b] -> [RealLocated b]
6969
dropBeforeAndAfter loc = dropBeforeLocated (Just loc) . dropAfterLocated (Just loc)
7070

7171
baseDynFlags :: GHC.DynFlags
72-
baseDynFlags = defaultDynFlags GHCEx.fakeSettings
72+
baseDynFlags = defaultDynFlags GHCEx.fakeSettings
7373

7474
getConDecls :: GHC.HsDataDefn GHC.GhcPs -> [GHC.LConDecl GHC.GhcPs]
7575
getConDecls d@GHC.HsDataDefn {} = case GHC.dd_cons d of
@@ -80,7 +80,6 @@ showOutputable :: GHC.Outputable a => a -> String
8080
showOutputable = GHC.showPpr baseDynFlags
8181

8282
epAnnComments :: GHC.EpAnn a -> [GHC.LEpaComment]
83-
epAnnComments GHC.EpAnnNotUsed = []
8483
epAnnComments GHC.EpAnn {..} = priorAndFollowing comments
8584

8685
deepAnnComments :: (Data a, Typeable a) => a -> [GHC.LEpaComment]

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

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -45,12 +45,12 @@ compareLIE = comparing $ ieKey . unLoc
4545
-- constructors first, followed by functions, and then operators.
4646
ieKey :: IE GhcPs -> (Int, String)
4747
ieKey = \case
48-
IEVar _ n -> nameKey n
49-
IEThingAbs _ n -> nameKey n
50-
IEThingAll _ n -> nameKey n
51-
IEThingWith _ n _ _ -> nameKey n
52-
IEModuleContents _ n -> nameKey n
53-
_ -> (2, "")
48+
IEVar _ n _ -> nameKey n
49+
IEThingAbs _ n _ -> nameKey n
50+
IEThingAll _ n _ -> nameKey n
51+
IEThingWith _ n _ _ _ -> nameKey n
52+
IEModuleContents _ n -> nameKey n
53+
_ -> (2, "")
5454

5555

5656
--------------------------------------------------------------------------------

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

Lines changed: 2 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,6 @@ import Control.Monad.Reader (MonadReader, ReaderT (..),
6161
asks, local)
6262
import Control.Monad.State (MonadState, State, get, gets,
6363
modify, put, runState)
64-
import Data.List (foldl')
6564

6665
--------------------------------------------------------------------------------
6766
import Language.Haskell.Stylish.GHC (showOutputable)
@@ -138,7 +137,6 @@ putComment epaComment = case GHC.ac_tok epaComment of
138137
GHC.EpaLineComment s -> putText s
139138
GHC.EpaDocOptions s -> putText s
140139
GHC.EpaBlockComment s -> putText s
141-
GHC.EpaEofComment -> pure ()
142140

143141
putMaybeLineComment :: Maybe GHC.EpaComment -> P ()
144142
putMaybeLineComment = \case
@@ -149,8 +147,7 @@ putMaybeLineComment = \case
149147
putRdrName :: GenLocated GHC.SrcSpanAnnN RdrName -> P ()
150148
putRdrName rdrName = case GHC.unLoc rdrName of
151149
Unqual name -> do
152-
let (pre, post) = nameAnnAdornments $
153-
GHC.epAnnAnnsL $ GHC.ann $ GHC.getLoc rdrName
150+
let (pre, post) = nameAnnAdornment $ GHC.anns $ GHC.getLoc rdrName
154151
putText pre
155152
putText (showOutputable name)
156153
putText post
@@ -161,12 +158,6 @@ putRdrName rdrName = case GHC.unLoc rdrName of
161158
Exact name ->
162159
putText (showOutputable name)
163160

164-
nameAnnAdornments :: [GHC.NameAnn] -> (String, String)
165-
nameAnnAdornments = foldl'
166-
(\(accl, accr) nameAnn ->
167-
let (l, r) = nameAnnAdornment nameAnn in (accl ++ l, r ++ accr))
168-
(mempty, mempty)
169-
170161
nameAnnAdornment :: GHC.NameAnn -> (String, String)
171162
nameAnnAdornment = \case
172163
GHC.NameAnn {..} -> fromAdornment nann_adornment
@@ -239,7 +230,7 @@ putType ltp = case GHC.unLoc ltp of
239230
putOutputable ltp
240231
GHC.HsQualTy {} ->
241232
putOutputable ltp
242-
GHC.HsAppKindTy _ _ _ _ ->
233+
GHC.HsAppKindTy _ _ _ ->
243234
putOutputable ltp
244235
GHC.HsListTy _ _ ->
245236
putOutputable ltp

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

Lines changed: 19 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -93,15 +93,27 @@ step cfg = makeStep "Data" \ls m -> Editor.apply (changes m) ls
9393
changes :: Module -> Editor.Edits
9494
changes = foldMap (formatDataDecl cfg) . dataDecls
9595

96+
getComments :: GHC.RealSrcSpan -> GHC.SrcSpanAnnA -> [GHC.LEpaComment]
97+
getComments declSpan declAnnos=
98+
filter isAfterStart $ epAnnComments declAnnos
99+
where
100+
-- workaround to make sure we don't reprint a haddock
101+
-- comment before a data declaration after a data
102+
-- declaration
103+
isAfterStart :: GHC.LEpaComment -> Bool
104+
isAfterStart (GHC.L (GHC.EpaSpan (GHC.RealSrcSpan commentSpan _)) _) =
105+
GHC.srcSpanStartLine commentSpan >= GHC.srcSpanStartLine declSpan
106+
isAfterStart _ = False
107+
96108
dataDecls :: Module -> [DataDecl]
97109
dataDecls m = do
98110
ldecl <- GHC.hsmodDecls $ GHC.unLoc m
99-
GHC.TyClD _ tycld <- pure $ GHC.unLoc ldecl
100-
loc <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl
111+
(GHC.L declAnnos (GHC.TyClD _ tycld)) <- pure ldecl
112+
declSpan <- maybeToList $ GHC.srcSpanToRealSrcSpan $ GHC.getLocA ldecl
101113
case tycld of
102114
GHC.DataDecl {..} -> pure $ MkDataDecl
103-
{ dataComments = epAnnComments tcdDExt
104-
, dataLoc = loc
115+
{ dataComments = getComments declSpan declAnnos
116+
, dataLoc = declSpan
105117
, dataDeclName = tcdLName
106118
, dataTypeVars = tcdTyVars
107119
, dataDefn = tcdDataDefn
@@ -330,7 +342,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
330342
GHC.ConDeclGADT {..} -> do
331343
-- Put argument to constructor first:
332344
case con_g_args of
333-
GHC.PrefixConGADT _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names
345+
GHC.PrefixConGADT _ _ -> sep (comma >> space) $ fmap putRdrName $ toList con_names
334346
GHC.RecConGADT _ _ -> error . mconcat $
335347
[ "Language.Haskell.Stylish.Step.Data.putConstructor: "
336348
, "encountered a GADT with record constructors, not supported yet"
@@ -350,7 +362,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
350362
GHC.HsOuterExplicit {..} -> hso_bndrs)
351363
forM_ con_mb_cxt $ putContext cfg
352364
case con_g_args of
353-
GHC.PrefixConGADT scaledTys -> forM_ scaledTys $ \scaledTy -> do
365+
GHC.PrefixConGADT _ scaledTys -> forM_ scaledTys $ \scaledTy -> do
354366
putType $ GHC.hsScaledThing scaledTy
355367
space >> putText "->" >> space
356368
GHC.RecConGADT _ _ -> error . mconcat $
@@ -384,7 +396,7 @@ putConstructor cfg consIndent lcons = case GHC.unLoc lcons of
384396
let commented = commentGroups
385397
(GHC.srcSpanToRealSrcSpan . GHC.getLocA)
386398
(GHC.unLoc largs)
387-
(epAnnComments . GHC.ann $ GHC.getLoc largs)
399+
(epAnnComments $ GHC.getLoc largs)
388400

389401
forM_ (flagEnds commented) $ \(CommentGroup {..}, firstCommentGroup, _) -> do
390402

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

Lines changed: 16 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,7 @@ module Language.Haskell.Stylish.Step.Imports
2323
) where
2424

2525
--------------------------------------------------------------------------------
26+
import Control.Applicative ((<|>))
2627
import Control.Monad (forM_, void, when)
2728
import qualified Data.Aeson as A
2829
import Data.Foldable (toList)
@@ -507,19 +508,19 @@ printQualified Options{..} padNames stats ldecl = do
507508

508509
--------------------------------------------------------------------------------
509510
printImport :: Bool -> GHC.IE GHC.GhcPs -> P ()
510-
printImport _ (GHC.IEVar _ name) = do
511+
printImport _ (GHC.IEVar _ name _) = do
511512
printIeWrappedName name
512-
printImport _ (GHC.IEThingAbs _ name) = do
513+
printImport _ (GHC.IEThingAbs _ name _) = do
513514
printIeWrappedName name
514-
printImport separateLists (GHC.IEThingAll _ name) = do
515+
printImport separateLists (GHC.IEThingAll _ name _) = do
515516
printIeWrappedName name
516517
when separateLists space
517518
putText "(..)"
518519
printImport _ (GHC.IEModuleContents _ modu) = do
519520
putText "module"
520521
space
521522
putText . GHC.moduleNameString $ GHC.unLoc modu
522-
printImport separateLists (GHC.IEThingWith _ name wildcard imps) = do
523+
printImport separateLists (GHC.IEThingWith _ name wildcard imps _) = do
523524
printIeWrappedName name
524525
when separateLists space
525526
let ellipsis = case wildcard of
@@ -637,24 +638,24 @@ prepareImportList =
637638
prepareInner :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs
638639
prepareInner = \case
639640
-- Simplify `A ()` to `A`.
640-
GHC.IEThingWith x n GHC.NoIEWildcard [] -> GHC.IEThingAbs x n
641-
GHC.IEThingWith x n w ns ->
642-
GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns)
641+
GHC.IEThingWith x n GHC.NoIEWildcard [] md -> GHC.IEThingAbs x n md
642+
GHC.IEThingWith x n w ns md ->
643+
GHC.IEThingWith x n w (sortBy (compareWrappedName `on` GHC.unLoc) ns) md
643644
ie -> ie
644645

645646
-- Merge two import items, assuming they have the same name.
646647
ieMerge :: GHC.IE GHC.GhcPs -> GHC.IE GHC.GhcPs -> Maybe (GHC.IE GHC.GhcPs)
647-
ieMerge l@(GHC.IEVar _ _) _ = Just l
648-
ieMerge _ r@(GHC.IEVar _ _) = Just r
649-
ieMerge (GHC.IEThingAbs _ _) r = Just r
650-
ieMerge l (GHC.IEThingAbs _ _) = Just l
651-
ieMerge l@(GHC.IEThingAll _ _) _ = Just l
652-
ieMerge _ r@(GHC.IEThingAll _ _) = Just r
653-
ieMerge (GHC.IEThingWith x0 n0 w0 ns0) (GHC.IEThingWith _ _ w1 ns1)
648+
ieMerge l@(GHC.IEVar _ _ _) _ = Just l
649+
ieMerge _ r@(GHC.IEVar _ _ _) = Just r
650+
ieMerge (GHC.IEThingAbs _ _ _) r = Just r
651+
ieMerge l (GHC.IEThingAbs _ _ _) = Just l
652+
ieMerge l@(GHC.IEThingAll _ _ _) _ = Just l
653+
ieMerge _ r@(GHC.IEThingAll _ _ _) = Just r
654+
ieMerge (GHC.IEThingWith x0 n0 w0 ns0 me0) (GHC.IEThingWith _ _ w1 ns1 me1)
654655
| w0 /= w1 = Nothing
655656
| otherwise = Just $
656657
-- TODO: sort the `ns0 ++ ns1`?
657-
GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1)
658+
GHC.IEThingWith x0 n0 w0 (nubOn GHC.lieWrappedName $ ns0 ++ ns1) (me0 <|> me1)
658659
ieMerge _ _ = Nothing
659660

660661

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -83,7 +83,7 @@ printModuleHeader maxCols conf ls lmodul =
8383

8484
keywordLine kw = listToMaybe $ do
8585
GHC.EpAnn {..} <- pure $ GHC.hsmodAnn $ GHC.hsmodExt modul
86-
GHC.AddEpAnn kw' (GHC.EpaSpan s _) <- GHC.am_main anns
86+
GHC.AddEpAnn kw' (GHC.EpaSpan (GHC.RealSrcSpan s _)) <- GHC.am_main anns
8787
guard $ kw == kw'
8888
pure $ GHC.srcSpanEndLine s
8989

@@ -104,7 +104,7 @@ printModuleHeader maxCols conf ls lmodul =
104104
Just lexports -> Just $ doSort $ commentGroups
105105
(GHC.srcSpanToRealSrcSpan . GHC.getLocA)
106106
(GHC.unLoc lexports)
107-
(epAnnComments . GHC.ann $ GHC.getLoc lexports)
107+
(epAnnComments $ GHC.getLoc lexports)
108108

109109
printedModuleHeader = runPrinter_
110110
(PrinterConfig maxCols)

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -160,9 +160,9 @@ multiWayIfToAlignable _conf _ = []
160160

161161
--------------------------------------------------------------------------------
162162
grhsToAlignable
163-
:: GHC.GenLocated (GHC.SrcSpanAnn' a) (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))
163+
:: GHC.GenLocated (GHC.EpAnnCO) (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))
164164
-> Maybe (Alignable GHC.RealSrcSpan)
165-
grhsToAlignable (GHC.L (GHC.SrcSpanAnn _ grhsloc) (Hs.GRHS _ guards@(_ : _) body)) = do
165+
grhsToAlignable (GHC.L (GHC.EpAnn (GHC.EpaSpan grhsloc) _ _ ) (Hs.GRHS _ guards@(_ : _) body)) = do
166166
let guardsLocs = map GHC.getLocA guards
167167
bodyLoc = GHC.getLocA $ body
168168
left = foldl1' GHC.combineSrcSpans guardsLocs

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

Lines changed: 4 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -45,11 +45,10 @@ squashFieldDecl _ = mempty
4545

4646

4747
--------------------------------------------------------------------------------
48-
fieldDeclSeparator :: GHC.EpAnn [GHC.AddEpAnn]-> Maybe GHC.RealSrcSpan
49-
fieldDeclSeparator GHC.EpAnn {..} = listToMaybe $ do
50-
GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan s _) <- anns
48+
fieldDeclSeparator :: [GHC.AddEpAnn]-> Maybe GHC.RealSrcSpan
49+
fieldDeclSeparator anns = listToMaybe $ do
50+
GHC.AddEpAnn GHC.AnnDcolon (GHC.EpaSpan (GHC.RealSrcSpan s _)) <- anns
5151
pure s
52-
fieldDeclSeparator _ = Nothing
5352

5453

5554
--------------------------------------------------------------------------------
@@ -76,7 +75,7 @@ squashMatch lmatch = case GHC.m_grhss match of
7675
--------------------------------------------------------------------------------
7776
matchSeparator :: GHC.EpAnn GHC.GrhsAnn -> Maybe GHC.RealSrcSpan
7877
matchSeparator GHC.EpAnn {..}
79-
| GHC.AddEpAnn _ (GHC.EpaSpan s _) <- GHC.ga_sep anns = Just s
78+
| GHC.AddEpAnn _ (GHC.EpaSpan (GHC.RealSrcSpan s _)) <- GHC.ga_sep anns = Just s
8079
matchSeparator _ = Nothing
8180

8281

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

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -20,19 +20,20 @@ import Language.Haskell.Stylish.Util (everything)
2020
--------------------------------------------------------------------------------
2121
hsTyReplacements :: GHC.HsType GHC.GhcPs -> Editor.Edits
2222
hsTyReplacements (GHC.HsFunTy _ arr _ _)
23-
| GHC.HsUnrestrictedArrow (GHC.L (GHC.TokenLoc epaLoc) GHC.HsNormalTok) <- arr=
23+
| GHC.HsUnrestrictedArrow (GHC.EpUniTok epaLoc GHC.NormalSyntax) <- arr =
2424
Editor.replaceRealSrcSpan (GHC.epaLocationRealSrcSpan epaLoc) "→"
2525
hsTyReplacements (GHC.HsQualTy _ ctx _)
26-
| Just arrow <- GHC.ac_darrow . GHC.anns . GHC.ann $ GHC.getLoc ctx
27-
, (GHC.NormalSyntax, GHC.EpaSpan loc _) <- arrow =
26+
| Just arrow <- GHC.ac_darrow . GHC.anns $ GHC.getLoc ctx
27+
, (GHC.NormalSyntax, GHC.EpaSpan (GHC.RealSrcSpan loc _)) <- arrow =
2828
Editor.replaceRealSrcSpan loc "⇒"
2929
hsTyReplacements _ = mempty
3030

31+
3132
--------------------------------------------------------------------------------
3233
hsSigReplacements :: GHC.Sig GHC.GhcPs -> Editor.Edits
3334
hsSigReplacements (GHC.TypeSig ann _ _)
34-
| GHC.AddEpAnn GHC.AnnDcolon epaLoc <- GHC.asDcolon $ GHC.anns ann
35-
, GHC.EpaSpan loc _ <- epaLoc =
35+
| GHC.AddEpAnn GHC.AnnDcolon epaLoc <- GHC.asDcolon ann
36+
, GHC.EpaSpan (GHC.RealSrcSpan loc _) <- epaLoc =
3637
Editor.replaceRealSrcSpan loc "∷"
3738
hsSigReplacements _ = mempty
3839

0 commit comments

Comments
 (0)