apply-refact 0.9.1.0 → 0.9.2.0

raw patch · 8 files changed

+287/−112 lines, 8 filesdep ~basedep ~ghc-exactprintPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, ghc-exactprint

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• apply-refact.cabal +64/−25
• src/Refact/Apply.hs +0/−2
• src/Refact/Fixity.hs +13/−6
• src/Refact/Internal.hs +116/−64
• src/Refact/Options.hs +0/−1
• src/Refact/Run.hs +0/−1
• src/Refact/Utils.hs +90/−13

@@ -1,3 +1,7 @@+v0.9.2.0++  * #110, Support GHC 9.0.1+ v0.9.1.0    * #109, Use the correct DynFlags when parsing refactoring templates

@@ -1,7 +1,7 @@ cabal-version:       2.4  name:                apply-refact-version:             0.9.1.0+version:             0.9.2.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 == 8.10.3, GHC == 8.8.4, GHC == 8.6.5+tested-with:         GHC == 9.0.1, GHC == 8.10.3, GHC == 8.8.4, GHC == 8.6.5   source-repository head@@ -33,7 +33,7 @@   GHC-Options: -Wall   build-depends: base >=4.12 && < 5                , refact >= 0.2-               , ghc-exactprint >= 0.6.3.3+               , ghc-exactprint >= 0.6.4                , ghc >= 8.6                , ghc-boot-th                , containers >= 0.6.0.1 && < 0.7@@ -46,6 +46,19 @@                , unix-compat >= 0.5.2                , directory >= 1.3                , uniplate >= 1.6.13+  default-extensions:  FlexibleContexts+                     , FlexibleInstances+                     , FunctionalDependencies+                     , GADTs+                     , LambdaCase+                     , MultiParamTypeClasses+                     , NamedFieldPuns+                     , PolyKinds+                     , RankNTypes+                     , ScopedTypeVariables+                     , TupleSections+                     , TypeApplications+                     , TypeOperators   hs-source-dirs:      src   default-language:    Haskell2010 @@ -80,6 +93,19 @@                , filepath                , transformers                , uniplate+  default-extensions:  FlexibleContexts+                     , FlexibleInstances+                     , FunctionalDependencies+                     , GADTs+                     , LambdaCase+                     , MultiParamTypeClasses+                     , NamedFieldPuns+                     , PolyKinds+                     , RankNTypes+                     , ScopedTypeVariables+                     , TupleSections+                     , TypeApplications+                     , TypeOperators  Test-Suite test   type:                exitcode-stdio-1.0@@ -93,25 +119,38 @@                  Refact.Options                  Refact.Run                  Refact.Utils-  GHC-Options:         -threaded-  Default-language:    Haskell2010-  Build-depends:       tasty-                     , tasty-golden-                     , tasty-expected-failure-                     , base-               , refact-               , ghc-exactprint-               , ghc-               , ghc-boot-th-               , containers-               , extra-               , syb-               , process-               , directory-               , optparse-applicative-               , filemanip-               , unix-compat-               , filepath-               , silently-               , transformers-               , uniplate+  ghc-options:         -threaded+  default-language:    Haskell2010+  build-depends:  tasty+                , tasty-golden+                , tasty-expected-failure+                , base+                , refact+                , ghc-exactprint+                , ghc+                , ghc-boot-th+                , containers+                , extra+                , syb+                , process+                , directory+                , optparse-applicative+                , filemanip+                , unix-compat+                , filepath+                , silently+                , transformers+                , uniplate+  default-extensions:  FlexibleContexts+                     , FlexibleInstances+                     , FunctionalDependencies+                     , GADTs+                     , LambdaCase+                     , MultiParamTypeClasses+                     , NamedFieldPuns+                     , PolyKinds+                     , RankNTypes+                     , ScopedTypeVariables+                     , TupleSections+                     , TypeApplications+                     , TypeOperators

@@ -1,5 +1,3 @@-{-# LANGUAGE TupleSections #-}- module Refact.Apply   ( applyRefactorings   , applyRefactorings'

@@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-}-module Refact.Fixity (applyFixities) where -import SrcLoc+module Refact.Fixity (applyFixities) where  import Refact.Utils-import BasicTypes (Fixity(..), defaultFixity, compareFixity, negateFixity, FixityDirection(..), SourceText(..))  #if __GLASGOW_HASKELL__ >= 810 import GHC.Hs@@ -15,9 +12,20 @@ import HsExtension hiding (noExt) #endif +#if __GLASGOW_HASKELL__ >= 900+import GHC.Parser.Annotation+import GHC.Types.Basic (Fixity(..), defaultFixity, compareFixity, negateFixity, FixityDirection(..), SourceText(..))+import GHC.Types.Name.Occurrence+import GHC.Types.Name.Reader+import GHC.Types.SrcLoc+#else import ApiAnnotation+import BasicTypes (Fixity(..), defaultFixity, compareFixity, negateFixity, FixityDirection(..), SourceText(..)) import RdrName import OccName+import SrcLoc+#endif+ import Data.Generics hiding (Fixity) import Data.List import Data.Maybe@@ -105,13 +113,12 @@       moveDelta oldAnn oldKey newKey       let res = L loc (NegApp noExt new_e neg_name)           key = mkAnnKey res-          ak  = AnnKey loc (CN "OpApp")+          ak  = AnnKey (srcSpanToAnnSpan loc) (CN "OpApp")       opAnn <- gets (fromMaybe annNone . Map.lookup ak)       negAnns <- gets (fromMaybe annNone . Map.lookup (mkAnnKey e1))       modify $ Map.insert key (annNone { annEntryDelta = annEntryDelta opAnn, annsDP = annsDP negAnns })       modify $ Map.delete (mkAnnKey e1)       return res-   where     loc' = combineLocs neg_arg e2     (nofix_error, associate_right) = compareFixity negateFixity fix2

@@ -1,13 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ViewPatterns #-} module Refact.Internal   ( apply   , runRefactoring@@ -43,49 +38,68 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Tuple.Extra+import Debug.Trace++import qualified GHC hiding (parseModule)++#if __GLASGOW_HASKELL__ >= 900+import GHC.Data.Bag+import GHC.Data.StringBuffer (stringToStringBuffer)+import GHC.Driver.Session hiding (initDynFlags)+import GHC.Driver.Types (handleSourceError)+import GHC.Parser.Header (getOptions)+import qualified GHC.Types.Name as GHC+import qualified GHC.Types.Name.Reader as GHC+import GHC.Types.SrcLoc hiding (spans)+import GHC.Utils.Error+import GHC.Utils.Outputable hiding ((<>))+import GHC.Utils.Panic (handleGhcException)+#else import DynFlags hiding (initDynFlags)-import FastString (unpackFS) import HeaderInfo (getOptions) import HscTypes (handleSourceError)-import GHC.IO.Exception (IOErrorType(..))-import GHC.LanguageExtensions.Type (Extension(..))-import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.Annotate-import Language.Haskell.GHC.ExactPrint.Delta-import Language.Haskell.GHC.ExactPrint.Parsers-import Language.Haskell.GHC.ExactPrint.Print-import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, GhcTc, GhcRn)-import Language.Haskell.GHC.ExactPrint.Utils+import qualified Name as GHC+import Outputable hiding ((<>)) import Panic (handleGhcException)+import qualified RdrName as GHC+import SrcLoc hiding (spans) import StringBuffer (stringToStringBuffer)-import System.IO.Error (mkIOError)-import System.IO.Extra-import System.IO.Unsafe (unsafePerformIO)--import Debug.Trace+#endif  #if __GLASGOW_HASKELL__ >= 810 import GHC.Hs.Expr as GHC hiding (Stmt) import GHC.Hs.ImpExp import GHC.Hs hiding (Pat, Stmt)-import ErrUtils-import Bag-#else+#elif __GLASGOW_HASKELL__ <= 808 import HsExpr as GHC hiding (Stmt) import HsImpExp import HsSyn hiding (Pat, Stmt, noExt) #endif -import Outputable hiding ((<>))-import SrcLoc hiding (spans)-import qualified GHC hiding (parseModule)-import qualified Name as GHC-import qualified RdrName as GHC+#if __GLASGOW_HASKELL__ == 810+import Bag+import ErrUtils+#endif +import GHC.IO.Exception (IOErrorType(..))+import GHC.LanguageExtensions.Type (Extension(..))+import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Annotate+import Language.Haskell.GHC.ExactPrint.Delta+import Language.Haskell.GHC.ExactPrint.Parsers+import Language.Haskell.GHC.ExactPrint.Print+import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, GhcTc, GhcRn)+import Language.Haskell.GHC.ExactPrint.Utils hiding (rs)+import System.IO.Error (mkIOError)+import System.IO.Extra+import System.IO.Unsafe (unsafePerformIO)+ import Refact.Types hiding (SrcSpan) import qualified Refact.Types as R import Refact.Utils (Stmt, Pat, Name, Decl, M, Module, Expr, Type, FunBind, AnnKeyMap-                    , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan, toGhcSrcSpan', setSrcSpanFile)+                    , pattern RealSrcSpan'+                    , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan, toGhcSrcSpan'+                    , annSpanToSrcSpan, srcSpanToAnnSpan, setSrcSpanFile, setAnnSpanFile, getAnnSpan)  #if __GLASGOW_HASKELL__ >= 810 type Errors = ErrorMessages@@ -97,7 +111,7 @@ onError _ = error . show #endif -#if __GLASGOW_HASKELL__ <= 806+#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900 composeSrcSpan :: a -> a composeSrcSpan = id @@ -129,8 +143,9 @@   toGhcSS <-     maybe       ( case getLoc m0 of-          UnhelpfulSpan s -> fail $ "Module has UnhelpfulSpan: " ++ unpackFS s-          RealSrcSpan s -> pure $ toGhcSrcSpan' (srcSpanFile s)+          UnhelpfulSpan s -> fail $ "Module has UnhelpfulSpan: " ++ show s+          RealSrcSpan' s ->+            pure $ toGhcSrcSpan' (srcSpanFile s)       )       (pure . toGhcSrcSpan)       mbfile@@ -294,18 +309,19 @@           , annPriorComments = map (first change) annPriorComments }       changeComment (AnnComment d, dp) = (AnnComment (change d), dp)       changeComment e = e-      change old@Comment{..}= if ss2pos commentIdentifier == ss2pos pos+      change old@Comment{..}= if ss2pos (annSpanToSrcSpan commentIdentifier) == ss2pos pos                                           then old { commentContents = newComment}                                           else old   Delete{rtype, pos} -> pure (as, f m, keyMap)     where+      annSpan = srcSpanToAnnSpan pos       f = case rtype of-        Stmt -> doDeleteStmt ((/= pos) . getLoc)-        Import -> doDeleteImport ((/= pos) . getLoc)+        Stmt -> doDeleteStmt ((/= annSpan) . getAnnSpan)+        Import -> doDeleteImport ((/= annSpan) . getAnnSpan)         _ -> id    InsertComment{..} -> do-    exprkey <- mkAnnKey <$> findOrError @(HsDecl GhcPs) m pos+    exprkey <- mkAnnKey <$> findOrError @(HsDecl GhcPs) m (srcSpanToAnnSpan pos)     pure (insertComment exprkey newComment as, m, keyMap)    RemoveAsKeyword{..} -> pure (as, removeAsKeyword m, keyMap)@@ -313,7 +329,7 @@       removeAsKeyword = transformBi go       go :: LImportDecl GHC.GhcPs -> LImportDecl GHC.GhcPs       go imp@(GHC.L l i)-        | l == pos = GHC.L l (i { ideclAs = Nothing })+        | srcSpanToAnnSpan l == srcSpanToAnnSpan pos = GHC.L l (i { ideclAs = Nothing })         | otherwise =  imp  droppedComments :: Anns -> Module -> AnnKeyMap -> Bool@@ -326,8 +342,8 @@      keySpan (AnnKey ss _) = ss -    allSpans :: Set SrcSpan-    allSpans = Set.fromList (universeBi m)+    allSpans :: Set AnnSpan+    allSpans = Set.fromList . fmap srcSpanToAnnSpan $ universeBi m  -- Specialised parsers mkErr :: GHC.DynFlags -> SrcSpan -> String -> Errors@@ -340,7 +356,11 @@ parseModuleName :: SrcSpan -> Parser (GHC.Located GHC.ModuleName) parseModuleName ss _ _ s =   let newMN =  GHC.L ss (GHC.mkModuleName s)-      newAnns = relativiseApiAnns newMN (Map.empty, Map.empty)+#if __GLASGOW_HASKELL__ >= 900+      newAnns = relativiseApiAnns newMN (GHC.ApiAnns mempty Nothing mempty mempty)+#else+      newAnns = relativiseApiAnns newMN mempty+#endif   in pure (newAnns, newMN) parseBind :: Parser (GHC.LHsBind GHC.GhcPs) parseBind dyn fname s =@@ -417,7 +437,7 @@ -- g is usually modifyAnnKey -- f is usually a function which checks the locations are equal resolveRdrName' :: (a -> b -> M a)  -- How to combine the value to insert and the replaced value-               -> (SrcSpan -> M b)    -- How to find the new value, when given the location it is in+               -> (AnnSpan -> M b)  -- How to find the new value, when given the location it is in                -> a                 -- The old thing which we are going to possibly replace                -> [(String, SrcSpan)] -- Substs                -> GHC.RdrName       -- The name of the position in the template@@ -427,29 +447,37 @@   case name of     -- Todo: this should replace anns as well?     GHC.Unqual (GHC.occNameString . GHC.occName -> oname)-      | Just ss <- lookup oname subs -> f ss >>= g old+      | Just ss <- lookup oname subs -> f (srcSpanToAnnSpan ss) >>= g old     _ -> pure old  resolveRdrName :: (Data old, Data a)                => a-               -> (SrcSpan -> M (Located old))+               -> (AnnSpan -> M (Located old))                -> Located old                -> [(String, SrcSpan)]                -> GHC.RdrName                -> M (Located old) resolveRdrName m = resolveRdrName' (modifyAnnKey m) +badAnnSpan :: AnnSpan+badAnnSpan =+#if __GLASGOW_HASKELL__ >= 900+  badRealSrcSpan+#else+  GHC.noSrcSpan+#endif+ insertComment :: AnnKey -> String               -> Map.Map AnnKey Annotation               -> Map.Map AnnKey Annotation insertComment k s as =-  let comment = Comment s GHC.noSrcSpan Nothing in+  let comment = Comment s badAnnSpan Nothing in   Map.adjust (\a@Ann{..} -> a { annPriorComments = annPriorComments ++ [(comment, DP (1,0))]                           , annEntryDelta = DP (1,0) }) k as   -- Substitute the template into the original AST.-#if __GLASGOW_HASKELL__ <= 806+#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900 doGenReplacement   :: forall ast a. (Data ast, Data a)   => a@@ -480,7 +508,7 @@   | Just Refl <- eqT @(SrcSpanLess ast) @(HsDecl GHC.GhcPs)   , L _ (ValD xvald newBind@FunBind{}) <- decomposeSrcSpan new   , Just (oldNoLocal, oldLocal) <- stripLocalBind (decomposeSrcSpan old)-  , newLoc@(RealSrcSpan newLocReal) <- getLoc new+  , newLoc@(RealSrcSpan' newLocReal) <- getLoc new   , p (composeSrcSpan oldNoLocal) = do       (anns, keyMap) <- gets fst       let n = decomposeSrcSpan new@@ -507,17 +535,27 @@               addAnnWhere oldAnns =                 let oldAnns' = Map.toList oldAnns                     po = \case+#if __GLASGOW_HASKELL__ >= 900+                      (AnnKey loc con, _) ->+                        loc == getAnnSpan old && con == CN "Match" && srcSpanFile loc /= newFile+#else                       (AnnKey loc@(RealSrcSpan r) con, _) ->                         loc == getLoc old && con == CN "Match" && srcSpanFile r /= newFile                       _ -> False+#endif                     pn = \case+#if __GLASGOW_HASKELL__ >= 900+                      (AnnKey loc con, _) ->+                        loc == srcSpanToAnnSpan finalLoc && con == CN "Match" && srcSpanFile loc == newFile+#else                       (AnnKey loc@(RealSrcSpan r) con, _) ->                         loc == finalLoc && con == CN "Match" && srcSpanFile r == newFile                       _ -> False+#endif                 in fromMaybe oldAnns $ do                       oldAnn <- snd <$> find po oldAnns'                       annWhere <- find ((== G GHC.AnnWhere) . fst) (annsDP oldAnn)-                      let newSortKey = fmap (setSrcSpanFile newFile) <$> annSortKey oldAnn+                      let newSortKey = fmap (setAnnSpanFile newFile) <$> annSortKey oldAnn                       newKey <- fst <$> find pn oldAnns'                       pure $ Map.adjust                         (\ann -> ann {annsDP = annsDP ann ++ [annWhere], annSortKey = newSortKey})@@ -526,20 +564,26 @@                -- Expand the SrcSpan of the "GRHS" entry in the new file to include the local binds               expandGRHSLoc = \case+#if __GLASGOW_HASKELL__ >= 900+                AnnKey r@(annSpanToSrcSpan -> loc) con+#else                 AnnKey loc@(RealSrcSpan r) con-                  | con == CN "GRHS", srcSpanFile r == newFile -> AnnKey (ensureLoc loc) con+#endif+                  | con == CN "GRHS", srcSpanFile r == newFile ->+                    AnnKey (srcSpanToAnnSpan $ ensureLoc loc) con                 other -> other                -- If an Anns entry corresponds to the local binds, update its file to point to the new file.               updateFile = \case                 AnnKey loc con-                  | loc `isSubspanOf` getLoc oldLocal -> AnnKey (setSrcSpanFile newFile loc) con+                  | annSpanToSrcSpan loc `isSubspanOf` getLoc oldLocal ->+                    AnnKey (setAnnSpanFile newFile loc) con                 other -> other                -- For each SrcSpan in the new file that is the entire newLoc, set it to finalLoc               expandTemplateLoc = \case                 AnnKey loc con-                  | loc == newLoc -> AnnKey finalLoc con+                  | loc == srcSpanToAnnSpan newLoc -> AnnKey (srcSpanToAnnSpan finalLoc) con                 other -> other            newAnns = addLocalBindsToAnns intAnns@@ -585,7 +629,7 @@     newMG = origMG{mg_alts = L locMG [L locMatch newMatch]}     newBind = origBind{fun_matches = newMG} -#if __GLASGOW_HASKELL__ <= 806+#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900 replaceWorker :: (Annotate a, Data mod)               => Anns               -> mod@@ -605,7 +649,7 @@               -> IO (Anns, mod, AnnKeyMap) #endif replaceWorker as m keyMap parser seed Replace{..} = do-  let replExprLocation = pos+  let replExprLocation = srcSpanToAnnSpan pos       uniqueName = "template" ++ show seed    (relat, template) <- do@@ -617,13 +661,21 @@       (substTransform m subts template)       (mergeAnns as relat, keyMap)   let lst = listToMaybe . reverse . GHC.occNameString . GHC.rdrNameOcc+#if __GLASGOW_HASKELL__ >= 900+      adjacent (srcSpanEnd -> RealSrcLoc loc1 _) (srcSpanStart -> RealSrcLoc loc2 _) = loc1 == loc2+#else       adjacent (srcSpanEnd -> RealSrcLoc loc1) (srcSpanStart -> RealSrcLoc loc2) = loc1 == loc2+#endif       adjacent _ _ = False        -- Return @True@ if the start position of the two spans are on the same line, and differ       -- by the given number of columns.       diffStartCols :: Int -> SrcSpan -> SrcSpan -> Bool+#if __GLASGOW_HASKELL__ >= 900+      diffStartCols x (srcSpanStart -> RealSrcLoc loc1 _) (srcSpanStart -> RealSrcLoc loc2 _) =+#else       diffStartCols x (srcSpanStart -> RealSrcLoc loc1) (srcSpanStart -> RealSrcLoc loc2) =+#endif         srcLocLine loc1 == srcLocLine loc2 && srcLocCol loc1 - srcLocCol loc2 == x       diffStartCols _ _ _ = False @@ -664,7 +716,7 @@             doBlocks' =               map                 ( \case-                    L loc (HsDo _ MDoExpr _) -> (loc, 3)+                    L loc (HsDo _ MDoExpr{} _) -> (loc, 3)                     L loc _ -> (loc, 2)                 )                 doBlocks@@ -674,7 +726,7 @@             then ann { annEntryDelta = DP (0, 1) }             else ann -      replacementPred (GHC.L l _) = l == replExprLocation+      replacementPred = (== replExprLocation) . getAnnSpan       transformation = transformBiM (doGenReplacement m (replacementPred . decomposeSrcSpan) newExpr)   runStateT (transformation m) ((newAnns, newKeyMap), False) >>= \case     (finalM, ((ensureDoSpace . ensureAppSpace -> finalAs, finalKeyMap), True)) ->@@ -686,7 +738,7 @@ data NotFound = NotFound   { nfExpected :: String   , nfActual :: Maybe String-  , nfLoc :: SrcSpan+  , nfLoc :: AnnSpan   }  renderNotFound :: NotFound -> String@@ -697,7 +749,7 @@   ++ "  Location: " ++ showSDocUnsafe (ppr nfLoc)  -- Find a given type with a given SrcSpan-findInModule :: forall a modu. (Data a, Data modu) => modu -> SrcSpan -> Either NotFound (GHC.Located a)+findInModule :: forall a modu. (Data a, Data modu) => modu -> AnnSpan -> Either NotFound (GHC.Located a) findInModule m ss = case doTrans m of   Just a -> Right a   Nothing ->@@ -717,14 +769,12 @@     showType :: forall b. Typeable b => Maybe (GHC.Located b) -> Maybe String     showType = fmap $ \_ -> show (typeRep (Proxy @b)) -findLargestExpression :: SrcSpan -> GHC.Located a -> Maybe (GHC.Located a)-findLargestExpression ss e@(GHC.L l _)-  | l == ss = Just e-  | otherwise = Nothing+findLargestExpression :: forall a. Data a => AnnSpan -> GHC.Located a -> Maybe (GHC.Located a)+findLargestExpression as e@(getAnnSpan -> l) = if l == as then Just e else Nothing  findOrError   :: forall a modu m. (Data a, Data modu, MonadIO m)-  => modu -> SrcSpan -> m (GHC.Located a)+  => modu -> AnnSpan -> m (GHC.Located a) findOrError m = either f pure . findInModule m   where     f nf = liftIO . throwIO $ mkIOError InappropriateType (renderNotFound nf) Nothing Nothing@@ -774,7 +824,7 @@   eflags <- liftIO $ addExtensionsToFlags es ds fp initFlags   case eflags of     -- TODO: report error properly.-    Left err -> pure . Left $ mkErr initFlags (UnhelpfulSpan mempty) err+    Left err -> pure . Left $ mkErr initFlags GHC.noSrcSpan err     Right flags -> do       liftIO $ writeIORef' dynFlagsRef (Just flags)       res <- parseModuleApiAnnsWithCppInternal defaultCppOptions flags fp@@ -812,6 +862,7 @@ readExtension :: String -> Maybe Extension readExtension s = flagSpecFlag <$> find ((== s) . flagSpecName) xFlags +#if __GLASGOW_HASKELL__ < 900 -- | Copied from "Language.Haskell.GhclibParserEx.GHC.Driver.Session", in order to -- support GHC 8.6 impliedXFlags :: [(Extension, Bool, Extension)]@@ -875,6 +926,7 @@     , (StandaloneKindSignatures, False, CUSKs) #endif   ]+#endif  -- TODO: This is added to avoid a breaking change. We should remove it and -- directly pass the `DynFlags` as arguments, before the 0.10 release.

@@ -1,7 +1,6 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} 

@@ -1,5 +1,4 @@ {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}  module Refact.Run (refactMain, runPipe) where 

@@ -1,9 +1,7 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables  #-}-{-# LANGUAGE GADTs  #-}-{-# LANGUAGE RankNTypes  #-}+{-# LANGUAGE ViewPatterns #-}  module Refact.Utils ( -- * Synonyms                       Module@@ -16,6 +14,8 @@                     , Import                     , FunBind                     , AnnKeyMap+                    , pattern RealSrcLoc'+                    , pattern RealSrcSpan'                     -- * Monad                     , M                     -- * Utility@@ -23,9 +23,14 @@                     , mergeAnns                     , modifyAnnKey                     , replaceAnnKey+                    , getAnnSpan                     , toGhcSrcSpan                     , toGhcSrcSpan'+                    , annSpanToSrcSpan+                    , srcSpanToAnnSpan+                    , setAnnSpanFile                     , setSrcSpanFile+                    , setRealSrcSpanFile                     , findParent                     ) where @@ -36,12 +41,22 @@ import Data.Data import Data.Map.Strict (Map) +#if __GLASGOW_HASKELL__ >= 900+import GHC.Data.FastString (FastString)+import qualified GHC.Data.FastString as GHC+import qualified GHC.Parser.Annotation as GHC+import qualified GHC.Types.Name.Reader as GHC+import GHC.Types.SrcLoc+import qualified GHC.Types.SrcLoc as GHC+#else import FastString (FastString)+import qualified FastString as GHC import SrcLoc import qualified SrcLoc as GHC import qualified RdrName as GHC import qualified ApiAnnotation as GHC-import qualified FastString    as GHC+#endif+ import qualified GHC hiding (parseModule)  #if __GLASGOW_HASKELL__ >= 810@@ -70,7 +85,11 @@  type AnnKeyMap = Map AnnKey [AnnKey] +#if __GLASGOW_HASKELL__ >= 900+type Module = (GHC.Located GHC.HsModule)+#else type Module = (GHC.Located (GHC.HsModule GHC.GhcPs))+#endif  type Expr = GHC.Located (GHC.HsExpr GHC.GhcPs) @@ -86,8 +105,32 @@  type Import = LImportDecl GHC.GhcPs +#if __GLASGOW_HASKELL__ >= 900+type FunBind = HsMatchContext GHC.GhcPs+#else type FunBind = HsMatchContext GHC.RdrName+#endif +pattern RealSrcLoc' :: RealSrcLoc -> SrcLoc+#if __GLASGOW_HASKELL__ >= 900+pattern RealSrcLoc' r <- RealSrcLoc r _ where+  RealSrcLoc' r = RealSrcLoc r Nothing+#else+pattern RealSrcLoc' r <- RealSrcLoc r where+  RealSrcLoc' r = RealSrcLoc r+#endif+{-# COMPLETE RealSrcLoc', UnhelpfulLoc #-}++pattern RealSrcSpan' :: RealSrcSpan -> SrcSpan+#if __GLASGOW_HASKELL__ >= 900+pattern RealSrcSpan' r <- RealSrcSpan r _ where+  RealSrcSpan' r = RealSrcSpan r Nothing+#else+pattern RealSrcSpan' r <- RealSrcSpan r where+  RealSrcSpan' r = RealSrcSpan r+#endif+{-# COMPLETE RealSrcSpan', UnhelpfulSpan #-}+ -- | Replaces an old expression with a new expression -- -- Note that usually, new, inp and parent are all the same.@@ -135,14 +178,14 @@   -- | A parent in this case is an element which has the same SrcSpan-findParent :: Data a => GHC.SrcSpan -> Anns -> a -> Maybe AnnKey+findParent :: Data a => AnnSpan -> Anns -> a -> Maybe AnnKey findParent ss as = something (findParentWorker ss as)  -- Note that a parent must also have an annotation. findParentWorker :: forall a . (Data a)-           => GHC.SrcSpan -> Anns -> a -> Maybe AnnKey+           => AnnSpan -> Anns -> a -> Maybe AnnKey findParentWorker oldSS as a-  | con == typeRepTyCon (typeRep (Proxy :: Proxy (GHC.Located GHC.RdrName))) && x == typeRep (Proxy :: Proxy GHC.SrcSpan)+  | con == typeRepTyCon (typeRep (Proxy :: Proxy (GHC.Located GHC.RdrName))) && x == typeRep (Proxy :: Proxy AnnSpan)       = if ss == oldSS             && isJust (Map.lookup (AnnKey ss cn) as)           then Just $ AnnKey ss cn@@ -150,11 +193,29 @@   | otherwise = Nothing   where     (con, ~[x, _]) = splitTyConApp (typeOf a)-    ss :: GHC.SrcSpan+    ss :: AnnSpan     ss = gmapQi 0 unsafeCoerce a     cn = gmapQi 1 (CN . show . toConstr) a +getAnnSpan :: forall a. Located a -> AnnSpan+getAnnSpan = srcSpanToAnnSpan . getLoc +srcSpanToAnnSpan :: SrcSpan -> AnnSpan+srcSpanToAnnSpan =+#if __GLASGOW_HASKELL__ >= 900+  \case GHC.RealSrcSpan l _ -> l; _ -> badRealSrcSpan+#else+  id+#endif++annSpanToSrcSpan :: AnnSpan -> SrcSpan+annSpanToSrcSpan =+#if __GLASGOW_HASKELL__ >= 900+  flip GHC.RealSrcSpan Nothing+#else+  id+#endif+ -- | Perform the necessary adjustments to annotations when replacing -- one Located thing with another Located thing. --@@ -165,7 +226,7 @@   => mod -> Located old -> Located new -> M (Located new) modifyAnnKey m e1 e2 = do   as <- gets fst-  let parentKey = fromMaybe (mkAnnKey e2) (findParent (getLoc e2) as m)+  let parentKey = fromMaybe (mkAnnKey e2) (findParent (getAnnSpan e2) as m)   e2 <$ modify           ( bimap               ( recoverBackquotes e1 e2@@ -179,7 +240,7 @@ -- -- See tests/examples/Backquotes.hs for an example. recoverBackquotes :: Located old -> Located new -> Anns -> Anns-recoverBackquotes (L old _) (L new _) anns+recoverBackquotes (getAnnSpan -> old) (getAnnSpan -> new) anns   | Just annOld <- Map.lookup (AnnKey old (CN "Unqual")) anns   , ( (G GHC.AnnBackquote, DP (i, j))     : rest@( (G GHC.AnnVal, _)@@ -210,9 +271,25 @@  setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan setSrcSpanFile file s-  | RealSrcLoc start <- srcSpanStart s-  , RealSrcLoc end <- srcSpanEnd s+  | RealSrcLoc' start <- srcSpanStart s+  , RealSrcLoc' end <- srcSpanEnd s   = let start' = mkSrcLoc file (srcLocLine start) (srcLocCol start)         end' = mkSrcLoc file (srcLocLine end) (srcLocCol end)      in mkSrcSpan start' end' setSrcSpanFile _ s = s++setRealSrcSpanFile :: FastString -> RealSrcSpan -> RealSrcSpan+setRealSrcSpanFile file s = mkRealSrcSpan start' end'+  where+    start = realSrcSpanStart s+    end = realSrcSpanEnd s+    start' = mkRealSrcLoc file (srcLocLine start) (srcLocCol start)+    end' = mkRealSrcLoc file (srcLocLine end) (srcLocCol end)++setAnnSpanFile :: FastString -> AnnSpan -> AnnSpan+setAnnSpanFile =+#if __GLASGOW_HASKELL__ >= 900+  setRealSrcSpanFile+#else+  setSrcSpanFile+#endif