From 1df3eef1d7ebfe44a87e54977b1435d2f8eec825 Mon Sep 17 00:00:00 2001 From: Shayne Fletcher Date: Thu, 21 Dec 2023 14:47:29 -0500 Subject: [PATCH] [ghc-api]: upgrade to ghc-9.8 --- .github/workflows/ci.yml | 6 +++--- hlint.cabal | 10 +++++----- src/CmdLine.hs | 3 ++- src/Config/Yaml.hs | 5 +++-- src/GHC/All.hs | 8 +++++--- src/GHC/Util/FreeVars.hs | 6 +++--- src/GHC/Util/HsExpr.hs | 6 +++--- src/Hint/Export.hs | 4 ++-- src/Hint/Extensions.hs | 5 +++-- src/Hint/Lambda.hs | 2 +- src/Hint/List.hs | 17 +++++++++-------- src/Hint/ListRec.hs | 2 +- src/Hint/Monad.hs | 2 +- src/Hint/Naming.hs | 2 +- src/Hint/Negation.hs | 2 +- src/Hint/NumLiteral.hs | 15 +++++++++------ src/Hint/Unsafe.hs | 6 ++++-- src/Refact.hs | 3 ++- src/Summary.hs | 5 +++-- stack.yaml | 8 ++++---- 20 files changed, 65 insertions(+), 52 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 9b9670264..6a402f808 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -12,12 +12,12 @@ jobs: fail-fast: false matrix: os: [ubuntu-latest] - ghc: ['9.6', '9.4', '9.2'] + ghc: ['9.8', '9.6', '9.4'] include: - os: windows-latest - ghc: '9.6' + ghc: '9.8' - os: macOS-latest - ghc: '9.6' + ghc: '9.8' steps: - run: git config --global core.autocrlf false diff --git a/hlint.cabal b/hlint.cabal index 5b9a75c8b..92867eecf 100644 --- a/hlint.cabal +++ b/hlint.cabal @@ -36,7 +36,7 @@ extra-source-files: extra-doc-files: README.md CHANGES.txt -tested-with: GHC==9.6, GHC==9.4, GHC==9.2 +tested-with: GHC==9.8, GHC==9.6, GHC==9.4 source-repository head type: git @@ -81,16 +81,16 @@ library deriving-aeson >= 0.2, filepattern >= 0.1.1 - if !flag(ghc-lib) && impl(ghc >= 9.6.1) && impl(ghc < 9.7.0) + if !flag(ghc-lib) && impl(ghc >= 9.8.1) && impl(ghc < 9.9.0) build-depends: - ghc == 9.6.*, + ghc == 9.8.*, ghc-boot-th, ghc-boot else build-depends: - ghc-lib-parser == 9.6.* + ghc-lib-parser == 9.8.* build-depends: - ghc-lib-parser-ex >= 9.6.0.2 && < 9.6.1 + ghc-lib-parser-ex >= 9.8.0.0 && < 9.8.1 if flag(gpl) build-depends: hscolour >= 1.21 diff --git a/src/CmdLine.hs b/src/CmdLine.hs index 036c5cf31..b07d8523d 100644 --- a/src/CmdLine.hs +++ b/src/CmdLine.hs @@ -12,6 +12,7 @@ import Control.Monad.Extra import Control.Exception.Extra import Data.ByteString qualified as BS import Data.Char +import Data.List.NonEmpty qualified as NE import Data.List.Extra import Data.Maybe import Data.Functor @@ -184,7 +185,7 @@ mode = cmdArgsMode $ modes ] &= program "hlint" &= verbosity &= summary ("HLint v" ++ showVersion version ++ ", (C) Neil Mitchell 2006-2023") where - nam xs = nam_ xs &= name [head xs] + nam xs = nam_ xs &= name [NE.head $ NE.fromList xs] nam_ xs = def &= explicit &= name xs -- | Where should we find the configuration files? diff --git a/src/Config/Yaml.hs b/src/Config/Yaml.hs index 71e23229d..423150fe8 100644 --- a/src/Config/Yaml.hs +++ b/src/Config/Yaml.hs @@ -29,6 +29,7 @@ import GHC.Types.Error hiding (Severity) import Config.Type import Data.Either.Extra import Data.Maybe +import Data.List.NonEmpty qualified as NE import Data.List.Extra import Data.Tuple.Extra import Control.Monad.Extra @@ -163,7 +164,7 @@ parseFail (Val focus path) msg = fail $ -- aim to show a smallish but relevant context dotDot (fromMaybe (encode focus) $ listToMaybe $ dropWhile (\x -> BS.length x > 250) $ map encode contexts) where - (steps, contexts) = unzip $ reverse path + (steps, contexts) = Prelude.unzip $ reverse path dotDot x = let (a,b) = BS.splitAt 250 x in BS.unpack a ++ (if BS.null b then "" else "...") parseArray :: Val -> Parser [Val] @@ -235,7 +236,7 @@ parseGHC parser v = do case parser defaultParseFlags{enabledExtensions=configExtensions, disabledExtensions=[]} x of POk _ x -> pure x PFailed ps -> - let errMsg = head . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages ps) + let errMsg = NE.head . NE.fromList . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages ps) msg = showSDoc baseDynFlags $ pprLocMsgEnvelopeDefault errMsg in parseFail v $ "Failed to parse " ++ msg ++ ", when parsing:\n " ++ x diff --git a/src/GHC/All.hs b/src/GHC/All.hs index 7c81cbaa7..a9c584588 100644 --- a/src/GHC/All.hs +++ b/src/GHC/All.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ViewPatterns #-} @@ -14,6 +15,7 @@ import Control.Monad.Trans.Except import Control.Monad.IO.Class import Util import Data.Char +import Data.List.NonEmpty qualified as NE import Data.List.Extra import Timing import Language.Preprocessor.Cpphs @@ -192,12 +194,12 @@ parseModuleEx flags file str = timedIO "Parse" file $ runExceptT $ do POk s a -> do let errs = bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s) if not $ null errs then - except $ parseFailureErr dynFlags str file str errs + except $ parseFailureErr dynFlags str file str $ NE.fromList errs else do let fixes = fixitiesFromModule a ++ ghcFixitiesFromParseFlags flags pure $ ModuleEx (applyFixities fixes a) PFailed s -> - except $ parseFailureErr dynFlags str file str $ bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s) + except $ parseFailureErr dynFlags str file str $ NE.fromList . bagToList . getMessages $ GhcPsMessage <$> snd (getPsMessages s) where -- If parsing pragmas fails, synthesize a parse error from the -- error message. @@ -206,7 +208,7 @@ parseModuleEx flags file str = timedIO "Parse" file $ runExceptT $ do in ParseError (mkSrcSpan loc loc) msg src parseFailureErr dynFlags ppstr file str errs = - let errMsg = head errs + let errMsg = NE.head errs loc = errMsgSpan errMsg doc = pprLocMsgEnvelopeDefault errMsg in ghcFailOpParseModuleEx ppstr file str (loc, doc) diff --git a/src/GHC/Util/FreeVars.hs b/src/GHC/Util/FreeVars.hs index 8c6f2396b..de546d6a4 100644 --- a/src/GHC/Util/FreeVars.hs +++ b/src/GHC/Util/FreeVars.hs @@ -122,8 +122,8 @@ instance FreeVars (LocatedA (HsExpr GhcPs)) where freeVars (L _ (RecordCon _ _ (HsRecFields flds _))) = Set.unions $ map freeVars flds -- Record construction. freeVars (L _ (RecordUpd _ e flds)) = case flds of - Left fs -> Set.unions $ freeVars e : map freeVars fs - Right ps -> Set.unions $ freeVars e : map freeVars ps + RegularRecUpdFields _ fs -> Set.unions $ freeVars e : map freeVars fs + OverloadedRecUpdFields _ ps -> Set.unions $ freeVars e : map freeVars ps freeVars (L _ (HsMultiIf _ grhss)) = free (allVars grhss) -- Multi-way if. freeVars (L _ (HsTypedBracket _ e)) = freeVars e freeVars (L _ (HsUntypedBracket _ (ExpBr _ e))) = freeVars e @@ -174,7 +174,7 @@ instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldOcc GhcPs)) ( freeVars o@(L _ (HsFieldBind _ _ x _)) = freeVars x instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where - freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ rdrNameAmbiguousFieldOcc $ unLoc x -- a pun + freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ ambiguousFieldOccRdrName $ unLoc x -- a pun freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where diff --git a/src/GHC/Util/HsExpr.hs b/src/GHC/Util/HsExpr.hs index 5a87a6452..e9396bc09 100644 --- a/src/GHC/Util/HsExpr.hs +++ b/src/GHC/Util/HsExpr.hs @@ -58,7 +58,7 @@ dotApps (x : xs) = dotApp x (dotApps xs) -- | @lambda [p0, p1..pn] body@ makes @\p1 p1 .. pn -> body@ lambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -lambda vs body = noLocA $ HsLam noExtField (MG Generated (noLocA [noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))])) +lambda vs body = noLocA $ HsLam noExtField (MG (Generated DoPmc) (noLocA [noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))])) -- | 'paren e' wraps 'e' in parens if 'e' is non-atomic. paren :: LHsExpr GhcPs -> LHsExpr GhcPs @@ -242,7 +242,7 @@ niceLambdaR ss e = let grhs = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs) grhss = GRHSs {grhssExt = emptyComments, grhssGRHSs=[grhs], grhssLocalBinds=EmptyLocalBinds noExtField} match = noLocA $ Match {m_ext=EpAnnNotUsed, m_ctxt=LambdaExpr, m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs) - matchGroup = MG {mg_ext=Generated, mg_alts=noLocA [match]} + matchGroup = MG {mg_ext=Generated DoPmc, mg_alts=noLocA [match]} in (noLocA $ HsLam noExtField matchGroup, const []) @@ -252,7 +252,7 @@ replaceBranches :: LHsExpr GhcPs -> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr replaceBranches (L l (HsIf _ a b c)) = ([b, c], \[b, c] -> L l (HsIf EpAnnNotUsed a b c)) replaceBranches (L s (HsCase _ a (MG FromSource (L l bs)))) = - (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG Generated . L l . g bs) + (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG (Generated DoPmc). L l . g bs) where f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs] f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- xs] diff --git a/src/Hint/Export.hs b/src/Hint/Export.hs index 5f08dfc89..bc029cbae 100644 --- a/src/Hint/Export.hs +++ b/src/Hint/Export.hs @@ -23,7 +23,7 @@ import GHC.Types.Name.Reader exportHint :: ModuHint exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports = exports}) ) | Nothing <- exports = - let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents EpAnnNotUsed name)] )} in + let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents (Nothing, EpAnnNotUsed) name)] )} in [(ignore "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note "an explicit list is usually better"]}] | Just (L _ xs) <- exports , mods <- [x | x <- xs, isMod x] @@ -32,7 +32,7 @@ exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports = ex , exports' <- [x | x <- xs, not (matchesModName modName x)] , modName `elem` names = let dots = mkRdrUnqual (mkVarOcc " ... ") - r = o{ hsmodExports = Just (noLocA (noLocA (IEVar noExtField (noLocA (IEName noExtField (noLocA dots)))) : exports') )} + r = o{ hsmodExports = Just (noLocA (noLocA (IEVar Nothing (noLocA (IEName noExtField (noLocA dots)))) : exports') )} in [ignore "Use explicit module export list" (L s o) (noLoc r) []] where diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs index f1cec6cc1..2690ffb11 100644 --- a/src/Hint/Extensions.hs +++ b/src/Hint/Extensions.hs @@ -274,6 +274,7 @@ import Refact.Types import Data.Set qualified as Set import Data.Map qualified as Map +import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Types.SourceText import GHC.Hs @@ -492,8 +493,8 @@ used MultiWayIf = hasS isMultiIf used NumericUnderscores = hasS f where f :: OverLitVal -> Bool - f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` t - f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` t + f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` unpackFS t + f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` unpackFS t f _ = False used LambdaCase = hasS isLCase diff --git a/src/Hint/Lambda.hs b/src/Hint/Lambda.hs index c0f9270d2..73b9e10b3 100644 --- a/src/Hint/Lambda.hs +++ b/src/Hint/Lambda.hs @@ -170,7 +170,7 @@ lambdaBind where reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs) reform ps b = L (combineSrcSpans (locA loc1) (locA loc2)) $ ValD noExtField $ - origBind {fun_matches = MG Generated (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField])} + origBind {fun_matches = MG (Generated DoPmc) (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField])} mkSubtsAndTpl newPats newBody = (sub, tpl) where diff --git a/src/Hint/List.hs b/src/Hint/List.hs index f58f74393..fd213e3df 100644 --- a/src/Hint/List.hs +++ b/src/Hint/List.hs @@ -44,6 +44,7 @@ module Hint.List(listHint) where import Control.Applicative import Data.Generics.Uniplate.DataOnly +import Data.List.NonEmpty qualified as NE import Data.List.Extra import Data.Maybe import Prelude @@ -103,9 +104,9 @@ listComp _ = [] listCompCheckGuards :: LHsExpr GhcPs -> HsDoFlavour -> [ExprLStmt GhcPs] -> [Idea] listCompCheckGuards o ctx stmts = - let revs = reverse stmts - e@(L _ LastStmt{}) = head revs -- In a ListComp, this is always last. - xs = reverse (tail revs) in + let revs = NE.reverse $ NE.fromList stmts + e@(L _ LastStmt{}) = NE.head revs -- In a ListComp, this is always last. + xs = reverse (NE.tail revs) in list_comp_aux e xs where list_comp_aux e xs @@ -128,10 +129,10 @@ listCompCheckMap :: listCompCheckMap o mp f ctx stmts | varToStr mp == "map" = [suggest "Move map inside list comprehension" (reLoc o) (reLoc o2) (suggestExpr o o2)] where - revs = reverse stmts - L _ (LastStmt _ body b s) = head revs -- In a ListComp, this is always last. + revs = NE.reverse $ NE.fromList stmts + L _ (LastStmt _ body b s) = NE.head revs -- In a ListComp, this is always last. last = noLocA $ LastStmt noExtField (noLocA $ HsApp EpAnnNotUsed (paren f) (paren body)) b s - o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (tail revs) ++ [last]) + o2 =noLocA $ HsDo EpAnnNotUsed ctx (noLocA $ reverse (NE.tail revs) ++ [last]) listCompCheckMap _ _ _ _ _ = [] suggestExpr :: LHsExpr GhcPs -> LHsExpr GhcPs -> [Refactoring R.SrcSpan] @@ -162,7 +163,7 @@ listExp :: Bool -> Bool -> LHsExpr GhcPs -> [Idea] listExp overloadedListsOn b (fromParen -> x) = if null res then concatMap (listExp overloadedListsOn $ isAppend x) $ children x - else [head res] + else [NE.head $ NE.fromList res] where res = [suggest name (reLoc x) (reLoc x2) [r] | (name, f) <- checks overloadedListsOn @@ -170,7 +171,7 @@ listExp overloadedListsOn b (fromParen -> x) = , let r = Replace Expr (toSSA x) subts temp ] listPat :: LPat GhcPs -> [Idea] -listPat x = if null res then concatMap listPat $ children x else [head res] +listPat x = if null res then concatMap listPat $ children x else [NE.head $ NE.fromList res] where res = [suggest name (reLoc x) (reLoc x2) [r] | (name, f) <- pchecks , Just (x2, subts, temp) <- [f x] diff --git a/src/Hint/ListRec.hs b/src/Hint/ListRec.hs index f3de15526..dd499921d 100644 --- a/src/Hint/ListRec.hs +++ b/src/Hint/ListRec.hs @@ -176,7 +176,7 @@ findCase x = do gRHS e = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs. gRHSSs e = GRHSs emptyComments [gRHS e] emptyLocalBinds -- Guarded rhs set. match e = Match{m_ext=EpAnnNotUsed,m_pats=ps12, m_grhss=gRHSSs e, ..} -- Match. - matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated, ..} -- Match group. + matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated DoPmc, ..} -- Match group. funBind e = FunBind {fun_matches=matchGroup e, ..} :: HsBindLR GhcPs GhcPs -- Fun bind. pure (ListCase ps b1 (x, xs, b2), noLocA . ValD noExtField . funBind) diff --git a/src/Hint/Monad.hs b/src/Hint/Monad.hs index 911ca4ad5..9aa365e5e 100644 --- a/src/Hint/Monad.hs +++ b/src/Hint/Monad.hs @@ -372,7 +372,7 @@ monadLet xs = mapMaybe mkLet xs grhs = noLocA (GRHS EpAnnNotUsed [] rhs) grhss = GRHSs emptyComments [grhs] (EmptyLocalBinds noExtField) match = noLocA $ Match EpAnnNotUsed (FunRhs p Prefix NoSrcStrict) [] grhss - fb = noLocA $ FunBind noExtField p (MG Generated (noLocA [match])) + fb = noLocA $ FunBind noExtField p (MG (Generated DoPmc) (noLocA [match])) binds = unitBag fb valBinds = ValBinds NoAnnSortKey binds [] localBinds = HsValBinds EpAnnNotUsed valBinds diff --git a/src/Hint/Naming.hs b/src/Hint/Naming.hs index fccfc295a..0d4f313ad 100644 --- a/src/Hint/Naming.hs +++ b/src/Hint/Naming.hs @@ -102,7 +102,7 @@ shortenLGRHS (L locGRHS (GRHS ttg0 guards (L locExpr _))) = L locGRHS (GRHS ttg0 guards (L locExpr dots)) where dots :: HsExpr GhcPs - dots = HsLit EpAnnNotUsed (HsString (SourceText "...") (mkFastString "...")) + dots = HsLit EpAnnNotUsed (HsString (SourceText (fsLit "...")) (fsLit "...")) getNames :: LHsDecl GhcPs -> [String] getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl) diff --git a/src/Hint/Negation.hs b/src/Hint/Negation.hs index 6ef5031e3..880858263 100644 --- a/src/Hint/Negation.hs +++ b/src/Hint/Negation.hs @@ -45,7 +45,7 @@ negationParensHint _ _ x = negatedOp :: LHsExpr GhcPs -> [Idea] negatedOp e = case e of - L b1 (NegApp a1 inner@(L _ (OpApp {})) a2) -> + L b1 (NegApp a1 inner@(L _ OpApp {}) a2) -> pure $ rawIdea Suggestion diff --git a/src/Hint/NumLiteral.hs b/src/Hint/NumLiteral.hs index c740f76ac..05bc0e0d9 100644 --- a/src/Hint/NumLiteral.hs +++ b/src/Hint/NumLiteral.hs @@ -22,6 +22,7 @@ module Hint.NumLiteral (numLiteralHint) where import GHC.Hs +import GHC.Data.FastString import GHC.LanguageExtensions.Type (Extension (..)) import GHC.Types.SrcLoc import GHC.Types.SourceText @@ -49,18 +50,20 @@ numLiteralHint _ modu = suggestUnderscore :: LHsExpr GhcPs -> [Idea] suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _))))) = - [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ] + [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt', srcTxt' /= underscoredSrcTxt ] where - underscoredSrcTxt = addUnderscore srcTxt + srcTxt' = unpackFS srcTxt + underscoredSrcTxt = addUnderscore srcTxt' y :: LocatedAn an (HsExpr GhcPs) - y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral intLit{il_text = SourceText underscoredSrcTxt}} + y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral intLit{il_text = SourceText (fsLit underscoredSrcTxt)}} r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL (SourceText srcTxt) _ _ _ _))))) = - [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ] + [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt', srcTxt' /= underscoredSrcTxt ] where - underscoredSrcTxt = addUnderscore srcTxt + srcTxt' = unpackFS srcTxt + underscoredSrcTxt = addUnderscore srcTxt' y :: LocatedAn an (HsExpr GhcPs) - y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional fracLit{fl_text = SourceText underscoredSrcTxt}} + y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional fracLit{fl_text = SourceText (fsLit underscoredSrcTxt)}} r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore _ = mempty diff --git a/src/Hint/Unsafe.hs b/src/Hint/Unsafe.hs index 642b65e89..9e0ccd801 100644 --- a/src/Hint/Unsafe.hs +++ b/src/Hint/Unsafe.hs @@ -60,13 +60,15 @@ unsafeHint _ (ModuleEx (L _ m)) = \ld@(L loc d) -> -- 'x' is not marked 'NOINLINE'. , x `notElem` noinline] where + noInline :: FastString + noInline = fsLit "{-# NOINLINE" gen :: OccName -> LHsDecl GhcPs gen x = noLocA $ SigD noExtField (InlineSig EpAnnNotUsed (noLocA (mkRdrUnqual x)) - (InlinePragma (SourceText "{-# NOINLINE") (NoInline (SourceText "{-# NOINLINE")) Nothing NeverActive FunLike)) + (InlinePragma (SourceText noInline) (NoInline (SourceText noInline)) Nothing NeverActive FunLike)) noinline :: [OccName] noinline = [q | L _(SigD _ (InlineSig _ (L _ (Unqual q)) - (InlinePragma _ (NoInline (SourceText "{-# NOINLINE")) Nothing NeverActive FunLike)) + (InlinePragma _ (NoInline (SourceText noInline)) Nothing NeverActive FunLike)) ) <- hsmodDecls m] isUnsafeDecl :: HsDecl GhcPs -> Bool diff --git a/src/Refact.hs b/src/Refact.hs index 5eaf97a57..998291489 100644 --- a/src/Refact.hs +++ b/src/Refact.hs @@ -10,6 +10,7 @@ module Refact import Control.Exception.Extra import Control.Monad +import Data.List.NonEmpty qualified as NE import Data.Maybe import Data.Version.Extra import GHC.LanguageExtensions.Type @@ -58,7 +59,7 @@ refactorPath rpath = do mexc <- findExecutable excPath case mexc of Just exc -> do - ver <- readVersion . tail <$> readProcess exc ["--version"] "" + ver <- readVersion . NE.tail . NE.fromList <$> readProcess exc ["--version"] "" pure $ if ver >= minRefactorVersion then Right exc else Left $ "Your version of refactor is too old, please install apply-refact " diff --git a/src/Summary.hs b/src/Summary.hs index 39db8f1f5..21d10dd30 100644 --- a/src/Summary.hs +++ b/src/Summary.hs @@ -9,6 +9,7 @@ module Summary (generateMdSummary, generateJsonSummary, generateExhaustiveConfig import Data.Map qualified as Map import Control.Monad.Extra import System.FilePath +import Data.List.NonEmpty qualified as NE import Data.List.Extra import System.Directory @@ -121,7 +122,7 @@ genExhaustiveConfig severity Summary{..} = unlines $ ++ ["", "# All LHS/RHS hints"] ++ (mkLine <$> sortDedup (hintRuleName <$> sLhsRhsRules)) where - sortDedup = fmap head . group . sort + sortDedup = fmap (NE.head . NE.fromList) . group . sort mkLine name = "- " <> show severity <> ": {name: " <> jsonToString name <> "}" genSummaryMd :: Summary -> String @@ -161,7 +162,7 @@ showBuiltin BuiltinHint{..} = row1 where row1 = row $ [ "" ++ hName ++ "", ""] - ++ showExample (head hExamples) + ++ showExample (NE.head (NE.fromList hExamples)) ++ ["Does not support refactoring." | not hRefactoring] ++ [""] ++ [ "" ++ show hSeverity ++ "" diff --git a/stack.yaml b/stack.yaml index 6be28defc..b6aaeff4b 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,12 +1,12 @@ -# For hlint/ghc-9.6.*, the minimum build compiler is ghc-9.2.2 (ghc-9.2.1 was a broken release). 9.2.2 exhibits the "'ffitarget_x86.h' file not found" problem on macOS. in this case, build with invoke `C_INCLUDE_PATH="$(xcrun --show-sdk-path)"/usr/include/ffi stack build`. -resolver: nightly-2023-04-02 # ghc-9.4.4 +# For hlint/ghc-9.8.*, the minimum build compiler is ghc-9.4.1. +resolver: lts-21.6 # ghc-9.4.5 packages: - . extra-deps: - - ghc-lib-parser-9.6.2.20230523 - - ghc-lib-parser-ex-9.6.0.2 + - ghc-lib-parser-9.8.1.20231009 + - ghc-lib-parser-ex-9.8.0.0 # To test hlint against experimental builds of ghc-lib-parser-ex, # modify extra-deps like this: # - archive: /users/shayne/project/ghc-lib-parser-ex/ghc-lib-parser-ex-8.10.0.18.tar.gz