apply-refact 0.10.0.0 → 0.11.0.0
raw patch · 5 files changed
+106/−217 lines, 5 filesdep ~basedep ~ghcdep ~ghc-exactprint
Dependency ranges changed: base, ghc, ghc-exactprint
Files
- CHANGELOG +3/−0
- README.md +1/−1
- apply-refact.cabal +9/−5
- src/Refact/Compat.hs +47/−189
- src/Refact/Internal.hs +46/−22
CHANGELOG view
@@ -1,3 +1,6 @@+v0.11.0.0+ * support GHC 9.4+ v0.10.0.0 * support GHC 9.2; drop support for GHC <= 9.0 (@alanz)
README.md view
@@ -2,7 +2,7 @@ [`refact`](https://hackage.haskell.org/package/refact) package. It is currently integrated into [HLint](https://github.com/ndmitchell/hlint) to enable the automatic application of suggestions. -apply-refact 0.10.x supports GHC 9.2, and 0.9.x supports GHC 8.6 through 9.0.+apply-refact 0.11.x supports GHC 9.4 and 9.2, 0.10.x supports GHC 9.2 and 0.9.x supports GHC 8.6 through 9.0. # Install
apply-refact.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name: apply-refact-version: 0.10.0.0+version: 0.11.0.0 synopsis: Perform refactorings specified by the refact library. description: Perform refactorings specified by the refact library. It is primarily used with HLint's --refactor flag. license: BSD-3-Clause@@ -18,7 +18,7 @@ , tests/examples/*.hs , tests/examples/*.hs.refact , tests/examples/*.hs.expected-tested-with: GHC == 9.2.1+tested-with: GHC==9.4.2, GHC==9.2.5 source-repository head@@ -32,11 +32,10 @@ , Refact.Internal , Refact.Compat GHC-Options: -Wall- build-depends: base >=4.16 && < 5+ build-depends: base >=4.15 && < 5 , refact >= 0.2- , ghc-exactprint >= 1.5.0- , ghc >= 9.2 , ghc-boot-th+ , ghc-exactprint ^>= 1.6.0 || ^>= 1.5.0 , ghc-paths , containers >= 0.6.0.1 && < 0.7 , extra >= 1.7.3@@ -47,6 +46,11 @@ , uniplate >= 1.6.13 , unix-compat >= 0.5.2 , directory >= 1.3+ if (impl(ghc >= 9.4) && impl(ghc < 9.5))+ build-depends: ghc ^>= 9.4+ if (impl(ghc >= 9.2) && impl(ghc < 9.3))+ build-depends: ghc ^>= 9.2+ default-extensions: FlexibleContexts , FlexibleInstances , FunctionalDependencies
src/Refact/Compat.hs view
@@ -43,11 +43,7 @@ StmtLR (..), -- * HsSyn / GHC.Hs-#if __GLASGOW_HASKELL__ >= 810 module GHC.Hs,-#else- module HsSyn,-#endif -- * Name / OccName / GHC.Types.Name nameOccName,@@ -97,127 +93,92 @@ setSrcSpanFile, srcSpanToAnnSpan, AnnSpan,++#if MIN_VERSION_ghc(9,4,0)+ -- * GHC 9.4 stuff+ initParserOpts,+#endif ) where -#if __GLASGOW_HASKELL__ >= 900-import GHC.Data.Bag (unitBag, bagToList )+import Control.Monad.Trans.State.Strict (StateT)+import Data.Data (Data)+import qualified GHC+import GHC.Data.Bag (unitBag, bagToList) import GHC.Data.FastString (FastString, mkFastString)+#if MIN_VERSION_ghc(9,4,0)+import qualified GHC.Data.Strict as Strict+#endif import GHC.Data.StringBuffer (stringToStringBuffer)+#if MIN_VERSION_ghc(9,4,0)+import GHC.Driver.Config.Parser+import GHC.Driver.Errors.Types (ErrorMessages, ghcUnknownMessage)+#endif import GHC.Driver.Session hiding (initDynFlags)-import GHC.Parser.Annotation+import GHC.Hs hiding (Pat, Stmt) import GHC.Parser.Header (getOptions)+#if MIN_VERSION_ghc(9,4,0)+import GHC.Types.Error (getMessages)+#endif import GHC.Types.Fixity ( Fixity(..) )-import GHC.Utils.Error hiding (mkErr) import GHC.Types.Name (nameOccName, occName, occNameString) import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc) import GHC.Types.SrcLoc hiding (spans) import GHC.Types.SourceText-import GHC.Utils.Panic (pprPanic)-import GHC.Utils.Outputable- ( ppr,- showSDocUnsafe,- text,- vcat,- )-import GHC.Utils.Panic (handleGhcException)+#if MIN_VERSION_ghc(9,4,0)+import GHC.Utils.Error #else-import ApiAnnotation-#if __GLASGOW_HASKELL__ == 810-import Bag (unitBag)-#endif-import BasicTypes (Fixity (..), SourceText (..))-import ErrUtils- ( ErrorMessages,- pprErrMsgBagWithLoc,-#if __GLASGOW_HASKELL__ == 810- mkPlainErrMsg,+import GHC.Utils.Error hiding (mkErr) #endif- )-import DynFlags hiding (initDynFlags)-import FastString (FastString, mkFastString)-import GHC.LanguageExtensions.Type (Extension (..))-import HeaderInfo (getOptions)-import Name (nameOccName)-import OccName (occName, occNameString)-import Outputable+import GHC.Utils.Outputable ( ppr, showSDocUnsafe,-#if __GLASGOW_HASKELL__ == 810- pprPanic, text, vcat,-#endif )-import Panic (handleGhcException)-import RdrName (RdrName (..), rdrNameOcc)-import SrcLoc hiding (spans)-import StringBuffer (stringToStringBuffer)-#endif--#if __GLASGOW_HASKELL__ >= 810-import GHC.Hs hiding (Pat, Stmt)-#elif __GLASGOW_HASKELL__ <= 808-import HsSyn hiding (Pat, Stmt)-#endif--import Control.Monad.Trans.State.Strict (StateT)-import Data.Data (Data)-import qualified GHC+import GHC.Utils.Panic+ ( handleGhcException+ , pprPanic+ ) import Language.Haskell.GHC.ExactPrint.Parsers (Parser) import Language.Haskell.GHC.ExactPrint.Utils import Refact.Types (Refactoring) -#if __GLASGOW_HASKELL__ <= 806-type MonadFail' = Monad-#else type MonadFail' = MonadFail-#endif -#if __GLASGOW_HASKELL__ >= 900 type Module = Located HsModule-#else-type Module = Located (HsModule GhcPs)-#endif -#if __GLASGOW_HASKELL__ >= 810 type Errors = ErrorMessages+ onError :: String -> Errors -> a onError s = pprPanic s . vcat . ppp+ ppp :: Errors -> [SDoc]-ppp pst = concatMap unDecorated $ fmap errMsgDiagnostic $ bagToList pst+#if MIN_VERSION_ghc(9,4,0)+ppp pst = concatMap unDecorated $ fmap (diagnosticMessage . errMsgDiagnostic) $ bagToList $ getMessages pst #else-type Errors = (SrcSpan, String)-onError :: String -> Errors -> a-onError _ = error . show+ppp pst = concatMap unDecorated (errMsgDiagnostic <$> bagToList pst) #endif -#if __GLASGOW_HASKELL__ >= 900 type FunBind = HsMatchContext GhcPs-#else-type FunBind = HsMatchContext RdrName-#endif pattern RealSrcLoc' :: RealSrcLoc -> SrcLoc-#if __GLASGOW_HASKELL__ >= 900 pattern RealSrcLoc' r <- RealSrcLoc r _ where- RealSrcLoc' r = RealSrcLoc r Nothing+#if MIN_VERSION_ghc(9,4,0)+ RealSrcLoc' r = RealSrcLoc r Strict.Nothing #else-pattern RealSrcLoc' r <- RealSrcLoc r where- RealSrcLoc' r = RealSrcLoc r+ RealSrcLoc' r = RealSrcLoc r Nothing #endif {-# COMPLETE RealSrcLoc', UnhelpfulLoc #-} pattern RealSrcSpan' :: RealSrcSpan -> SrcSpan-#if __GLASGOW_HASKELL__ >= 900 pattern RealSrcSpan' r <- RealSrcSpan r _ where- RealSrcSpan' r = RealSrcSpan r Nothing+#if MIN_VERSION_ghc(9,4,0)+ RealSrcSpan' r = RealSrcSpan r Strict.Nothing #else-pattern RealSrcSpan' r <- RealSrcSpan r where- RealSrcSpan' r = RealSrcSpan r+ RealSrcSpan' r = RealSrcSpan r Nothing #endif {-# COMPLETE RealSrcSpan', UnhelpfulSpan #-} -#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900 composeSrcSpan :: a -> a composeSrcSpan = id @@ -225,31 +186,22 @@ decomposeSrcSpan = id type SrcSpanLess a = a-#endif type AnnSpan = RealSrcSpan badAnnSpan :: AnnSpan badAnnSpan =-#if __GLASGOW_HASKELL__ >= 900 badRealSrcSpan-#else- noSrcSpan-#endif srcSpanToAnnSpan :: SrcSpan -> AnnSpan srcSpanToAnnSpan =-#if __GLASGOW_HASKELL__ >= 900 \case RealSrcSpan l _ -> l; _ -> badRealSrcSpan-#else- id-#endif annSpanToSrcSpan :: AnnSpan -> SrcSpan annSpanToSrcSpan =-#if __GLASGOW_HASKELL__ >= 900- flip RealSrcSpan Nothing+#if MIN_VERSION_ghc(9,4,0)+ flip RealSrcSpan Strict.Nothing #else- id+ flip RealSrcSpan Nothing #endif setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan@@ -271,29 +223,22 @@ setAnnSpanFile :: FastString -> AnnSpan -> AnnSpan setAnnSpanFile =-#if __GLASGOW_HASKELL__ >= 900 setRealSrcSpanFile-#else- setSrcSpanFile-#endif mkErr :: DynFlags -> SrcSpan -> String -> Errors-#if __GLASGOW_HASKELL__ >= 810-mkErr _df l s = unitBag (mkPlainMsgEnvelope l (text s))+#if MIN_VERSION_ghc(9,4,0)+mkErr _df l s =+ mkMessages $+ unitBag (mkPlainErrorMsgEnvelope l (ghcUnknownMessage $ mkDecoratedError [] [text s])) #else-mkErr = const (,)+mkErr _df l s = unitBag (mkPlainMsgEnvelope l (text s)) #endif parseModuleName :: SrcSpan -> Parser (LocatedA GHC.ModuleName) parseModuleName ss _ _ s = let newMN = GHC.L (GHC.noAnnSrcSpan ss) (GHC.mkModuleName s)-#if __GLASGOW_HASKELL__ >= 900-#else- newAnns = relativiseApiAnns newMN mempty-#endif in pure newMN -#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900 type DoGenReplacement an ast a = (Data ast, Data a) => a ->@@ -301,17 +246,7 @@ LocatedAn an ast -> LocatedAn an ast -> StateT Bool IO (LocatedAn an ast)-#else-type DoGenReplacement ast a =- (Data (SrcSpanLess ast), HasSrcSpan ast, Data a) =>- a ->- (ast -> Bool) ->- ast ->- ast ->- StateT ((Anns, AnnKeyMap), Bool) IO ast-#endif -#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900 type ReplaceWorker a mod = (Data a, Data mod) => mod ->@@ -319,80 +254,3 @@ Int -> Refactoring SrcSpan -> IO mod-#else-type ReplaceWorker a mod =- (Data a, HasSrcSpan a, Data mod, Data (SrcSpanLess a)) =>- Anns ->- mod ->- AnnKeyMap ->- Parser a ->- Int ->- Refactoring SrcSpan ->- IO (Anns, mod, AnnKeyMap)-#endif--#if __GLASGOW_HASKELL__ < 900--- | Copied from "Language.Haskell.GhclibParserEx.GHC.Driver.Session", in order to--- support GHC 8.6-impliedXFlags :: [(Extension, Bool, Extension)]-impliedXFlags--- See Note [Updating flag description in the User's Guide]- = [ (RankNTypes, True, ExplicitForAll)- , (QuantifiedConstraints, True, ExplicitForAll)- , (ScopedTypeVariables, True, ExplicitForAll)- , (LiberalTypeSynonyms, True, ExplicitForAll)- , (ExistentialQuantification, True, ExplicitForAll)- , (FlexibleInstances, True, TypeSynonymInstances)- , (FunctionalDependencies, True, MultiParamTypeClasses)- , (MultiParamTypeClasses, True, ConstrainedClassMethods) -- c.f. #7854- , (TypeFamilyDependencies, True, TypeFamilies)-- , (RebindableSyntax, False, ImplicitPrelude) -- NB: turn off!-- , (DerivingVia, True, DerivingStrategies)-- , (GADTs, True, GADTSyntax)- , (GADTs, True, MonoLocalBinds)- , (TypeFamilies, True, MonoLocalBinds)-- , (TypeFamilies, True, KindSignatures) -- Type families use kind signatures- , (PolyKinds, True, KindSignatures) -- Ditto polymorphic kinds-- -- TypeInType is now just a synonym for a couple of other extensions.- , (TypeInType, True, DataKinds)- , (TypeInType, True, PolyKinds)- , (TypeInType, True, KindSignatures)-- -- AutoDeriveTypeable is not very useful without DeriveDataTypeable- , (AutoDeriveTypeable, True, DeriveDataTypeable)-- -- We turn this on so that we can export associated type- -- type synonyms in subordinates (e.g. MyClass(type AssocType))- , (TypeFamilies, True, ExplicitNamespaces)- , (TypeOperators, True, ExplicitNamespaces)-- , (ImpredicativeTypes, True, RankNTypes)-- -- Record wild-cards implies field disambiguation- -- Otherwise if you write (C {..}) you may well get- -- stuff like " 'a' not in scope ", which is a bit silly- -- if the compiler has just filled in field 'a' of constructor 'C'- , (RecordWildCards, True, DisambiguateRecordFields)-- , (ParallelArrays, True, ParallelListComp)-- , (JavaScriptFFI, True, InterruptibleFFI)-- , (DeriveTraversable, True, DeriveFunctor)- , (DeriveTraversable, True, DeriveFoldable)-- -- Duplicate record fields require field disambiguation- , (DuplicateRecordFields, True, DisambiguateRecordFields)-- , (TemplateHaskell, True, TemplateHaskellQuotes)- , (Strict, True, StrictData)-#if __GLASGOW_HASKELL__ >= 810- , (StandaloneKindSignatures, False, CUSKs)-#endif- ]-#endif
src/Refact/Internal.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}@@ -33,7 +34,6 @@ import Data.List.Extra import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe) import Data.Ord (comparing)-import qualified Data.Set as Set import Data.Tuple.Extra import Debug.Trace import qualified GHC@@ -41,10 +41,24 @@ import GHC.LanguageExtensions.Type (Extension (..)) import qualified GHC.Paths import Language.Haskell.GHC.ExactPrint+ ( ExactPrint,+ exactPrint,+ getEntryDP,+ makeDeltaAst,+ runTransform,+ setEntryDP,+ transferEntryDP,+ transferEntryDP',+ ) import Language.Haskell.GHC.ExactPrint.ExactPrint+ ( EPOptions,+ epRigidity,+ exactPrintWithOptions,+ stringOptions,+ ) import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Types-import Language.Haskell.GHC.ExactPrint.Utils+import Language.Haskell.GHC.ExactPrint.Utils (ss2pos) import Refact.Compat ( AnnSpan, DoGenReplacement,@@ -56,7 +70,6 @@ -- combineSrcSpans, combineSrcSpansA, composeSrcSpan,- decomposeSrcSpan, getOptions, gopt_set, handleGhcException,@@ -68,7 +81,6 @@ parseDynamicFilePragma, parseModuleName, ppr,- rdrNameOcc, setSrcSpanFile, showSDocUnsafe, srcSpanToAnnSpan,@@ -76,8 +88,11 @@ xFlags, xopt_set, xopt_unset,- pattern RealSrcLoc', pattern RealSrcSpan',+#if MIN_VERSION_ghc(9,4,0)+ mkGeneratedHsDocString,+ initParserOpts+#endif ) import Refact.Types hiding (SrcSpan) import qualified Refact.Types as R@@ -319,7 +334,14 @@ modifyComment :: (Data a) => GHC.SrcSpan -> String -> a -> a modifyComment pos newComment = transformBi go where+#if MIN_VERSION_ghc(9,4,0) newTok :: GHC.EpaCommentTok -> GHC.EpaCommentTok+ newTok (GHC.EpaDocComment _) = GHC.EpaDocComment $ mkGeneratedHsDocString newComment+ newTok (GHC.EpaDocOptions _) = GHC.EpaDocOptions newComment+ newTok (GHC.EpaLineComment _) = GHC.EpaLineComment newComment+ newTok (GHC.EpaBlockComment _) = GHC.EpaBlockComment newComment+ newTok GHC.EpaEofComment = GHC.EpaEofComment+#else newTok (GHC.EpaDocCommentNext _) = GHC.EpaDocCommentNext newComment newTok (GHC.EpaDocCommentPrev _) = GHC.EpaDocCommentPrev newComment newTok (GHC.EpaDocCommentNamed _) = GHC.EpaDocCommentNamed newComment@@ -328,6 +350,7 @@ newTok (GHC.EpaLineComment _) = GHC.EpaLineComment newComment newTok (GHC.EpaBlockComment _) = GHC.EpaBlockComment newComment newTok GHC.EpaEofComment = GHC.EpaEofComment+#endif go :: GHC.LEpaComment -> GHC.LEpaComment go old@(GHC.L (GHC.Anchor l o) (GHC.EpaComment t r)) =@@ -336,7 +359,7 @@ else old droppedComments :: [Refactoring GHC.SrcSpan] -> Module -> Module -> Bool-droppedComments rs orig_m m = not (all (`Set.member` current_comments) orig_comments)+droppedComments rs orig_m m = not (all (`elem` current_comments) orig_comments) where mcs = foldl' runModifyComment orig_m rs runModifyComment m' (ModifyComment pos newComment) = modifyComment pos newComment m'@@ -347,7 +370,7 @@ isComment :: GHC.EpaComment -> Bool isComment _ = True orig_comments = all_comments mcs- current_comments = Set.fromList $ all_comments m+ current_comments = all_comments m parseBind :: Parser (GHC.LHsBind GHC.GhcPs) parseBind dyn fname s =@@ -450,10 +473,8 @@ -- Substitute the template into the original AST. doGenReplacement :: forall ast a. DoGenReplacement GHC.AnnListItem ast a-doGenReplacement m p new old+doGenReplacement _ p new old | p old = do- let n = decomposeSrcSpan new- o = decomposeSrcSpan old let (new', _, _) = runTransform $ transferEntryDP old new put True pure new'@@ -465,8 +486,6 @@ Just (oldNoLocal, oldLocal) <- stripLocalBind old, (RealSrcSpan' newLocReal) <- GHC.getLocA new, p (composeSrcSpan oldNoLocal) = do- let n = decomposeSrcSpan new- o = decomposeSrcSpan old let newFile = GHC.srcSpanFile newLocReal newLocal :: GHC.HsLocalBinds GHC.GhcPs newLocal = transformBi (setSrcSpanFile newFile) oldLocal@@ -556,13 +575,9 @@ (substTransform m subts (makeDeltaAst template)) -- (mergeAnns as relat, keyMap) ()- let lst = listToMaybe . reverse . occNameString . rdrNameOcc- adjacent (GHC.srcSpanEnd -> RealSrcLoc' loc1) (GHC.srcSpanStart -> RealSrcLoc' loc2) = loc1 == loc2- adjacent _ _ = False-- -- Add a space if needed, so that we avoid refactoring `y = do(foo bar)` into `y = dofoo bar`.- -- ensureDoSpace :: Anns -> Anns- ensureSpace :: forall t. (Data t) => t -> t+ -- Add a space if needed, so that we avoid refactoring `y = do(foo bar)` into `y = dofoo bar`.+ -- ensureDoSpace :: Anns -> Anns+ let ensureSpace :: forall t. (Data t) => t -> t ensureSpace = everywhere (mkT ensureExprSpace) ensureExprSpace :: Expr -> Expr@@ -640,13 +655,18 @@ ] in Left $ NotFound expected actual ss where- doTrans :: forall an b. (Typeable an, Data b) => modu -> Maybe (GHC.LocatedAn an b)+ doTrans :: forall an' b. (Typeable an', Data b) => modu -> Maybe (GHC.LocatedAn an' b) doTrans = something (mkQ Nothing (findLargestExpression ss)) - showType :: forall an b. Typeable b => Maybe (GHC.LocatedAn an b) -> Maybe String+ showType :: forall an' b. Typeable b => Maybe (GHC.LocatedAn an' b) -> Maybe String showType = fmap $ \_ -> show (typeRep (Proxy @b)) -findLargestExpression :: forall an a. Data a => AnnSpan -> GHC.LocatedAn an a -> Maybe (GHC.LocatedAn an a)+findLargestExpression ::+ forall an a.+ Data a =>+ AnnSpan ->+ GHC.LocatedAn an a ->+ Maybe (GHC.LocatedAn an a) findLargestExpression as e@(getAnnSpanA -> l) = if l == as then Just e else Nothing findOrError ::@@ -675,7 +695,11 @@ IO (Either String GHC.DynFlags) addExtensionsToFlags es ds fp flags = catchErrors $ do (stringToStringBuffer -> buf) <- readFileUTF8' fp+#if MIN_VERSION_ghc(9,4,0)+ let (_, opts) = getOptions (initParserOpts flags) buf fp+#else let opts = getOptions flags buf fp+#endif withExts = flip (foldl' xopt_unset) ds . flip (foldl' xopt_set) es