diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 11f1421b..75851b0d 100644 --- a/.github/workflows/ci.yml +++ b/.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.6", "9.8", "9.10"] steps: - uses: actions/checkout@v4 @@ -22,18 +22,18 @@ jobs: - uses: actions/cache@v3 with: path: ${{ steps.setup.outputs.cabal-store }} - key: ${{ runner.os }}-${{ matrix.ghc }}-v1-${{ hashFiles('*.cabal') }} + key: ${{ runner.os }}-${{ matrix.ghc }}-v2-${{ hashFiles('*.cabal') }} restore-keys: | - ${{ runner.os }}-${{ matrix.ghc }}-v1- + ${{ runner.os }}-${{ matrix.ghc }}-v2- - run: make build - run: make test - - if: startsWith(github.ref, 'refs/tags') && matrix.ghc == '9.6' + - if: startsWith(github.ref, 'refs/tags') && startsWith(matrix.ghc, '9.8') run: make artifact - uses: actions/upload-artifact@v4 - if: startsWith(github.ref, 'refs/tags') && matrix.ghc == '9.6' + if: startsWith(github.ref, 'refs/tags') && startsWith(matrix.ghc, '9.8') with: path: artifacts/* name: artifacts-${{ runner.os }} diff --git a/lib/Language/Haskell/Stylish/GHC.hs b/lib/Language/Haskell/Stylish/GHC.hs index 3a5b3ed6..021c7aa3 100644 --- a/lib/Language/Haskell/Stylish/GHC.hs +++ b/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 d@GHC.HsDataDefn {} = 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] diff --git a/lib/Language/Haskell/Stylish/Ordering.hs b/lib/Language/Haskell/Stylish/Ordering.hs index a215ac21..d8455dae 100644 --- a/lib/Language/Haskell/Stylish/Ordering.hs +++ b/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, "") -------------------------------------------------------------------------------- diff --git a/lib/Language/Haskell/Stylish/Printer.hs b/lib/Language/Haskell/Stylish/Printer.hs index 08c30c98..b6c769ca 100644 --- a/lib/Language/Haskell/Stylish/Printer.hs +++ b/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 diff --git a/lib/Language/Haskell/Stylish/Step/Data.hs b/lib/Language/Haskell/Stylish/Step/Data.hs index 0a99b0aa..d43f25ee 100644 --- a/lib/Language/Haskell/Stylish/Step/Data.hs +++ b/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 diff --git a/lib/Language/Haskell/Stylish/Step/Imports.hs b/lib/Language/Haskell/Stylish/Step/Imports.hs index fc69b2f7..f63b2e1c 100644 --- a/lib/Language/Haskell/Stylish/Step/Imports.hs +++ b/lib/Language/Haskell/Stylish/Step/Imports.hs @@ -23,6 +23,7 @@ module Language.Haskell.Stylish.Step.Imports ) where -------------------------------------------------------------------------------- +import Control.Applicative ((<|>)) import Control.Monad (forM_, void, when) import qualified Data.Aeson as A import Data.Foldable (toList) @@ -507,11 +508,11 @@ printQualified Options{..} padNames stats ldecl = do -------------------------------------------------------------------------------- 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 "(..)" @@ -519,7 +520,7 @@ 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 @@ prepareImportList = 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 diff --git a/lib/Language/Haskell/Stylish/Step/ModuleHeader.hs b/lib/Language/Haskell/Stylish/Step/ModuleHeader.hs index 474a08fc..ff32761f 100644 --- a/lib/Language/Haskell/Stylish/Step/ModuleHeader.hs +++ b/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) diff --git a/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs b/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs index d1c8d4eb..492a292d 100644 --- a/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +++ b/lib/Language/Haskell/Stylish/Step/SimpleAlign.hs @@ -160,9 +160,9 @@ multiWayIfToAlignable _conf _ = [] -------------------------------------------------------------------------------- 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 diff --git a/lib/Language/Haskell/Stylish/Step/Squash.hs b/lib/Language/Haskell/Stylish/Step/Squash.hs index c90b5f34..bcc04d06 100644 --- a/lib/Language/Haskell/Stylish/Step/Squash.hs +++ b/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 diff --git a/lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs b/lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs index 1e815497..e28c869b 100644 --- a/lib/Language/Haskell/Stylish/Step/UnicodeSyntax.hs +++ b/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 diff --git a/stylish-haskell.cabal b/stylish-haskell.cabal index 0edd396b..eb54596b 100644 --- a/stylish-haskell.cabal +++ b/stylish-haskell.cabal @@ -19,10 +19,12 @@ Description: 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