retrie 0.1.0.1 → 0.1.1.0
raw patch · 7 files changed
+131/−44 lines, 7 filesdep ~basedep ~ghcPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, ghc
API changes (from Hackage documentation)
+ Retrie.GHC: noExtField :: NoExt
Files
- CHANGELOG.md +4/−0
- Retrie/ExactPrint.hs +25/−16
- Retrie/Expr.hs +12/−12
- Retrie/GHC.hs +18/−0
- Retrie/PatternMap/Instances.hs +61/−5
- Retrie/Rewrites/Function.hs +3/−3
- retrie.cabal +8/−8
CHANGELOG.md view
@@ -1,3 +1,7 @@+0.1.1.0 (May 8, 2020)++* Support GHC 8.10.1+ 0.1.0.1 (April 1, 2020) * Don't fail if 'git' or 'hg' commands cannot be found.
Retrie/ExactPrint.hs view
@@ -121,22 +121,22 @@ fixOneExpr _ e = return e fixOnePat :: Monad m => FixityEnv -> LPat GhcPs -> TransformT m (LPat GhcPs)-#if __GLASGOW_HASKELL__ < 808-fixOnePat env (L l2 (ConPatIn op2 (InfixCon ap1@(L l1 (ConPatIn op1 (InfixCon x y))) z)))+#if __GLASGOW_HASKELL__ == 808+fixOnePat env (dL -> L l2 (ConPatIn op2 (InfixCon (dL -> ap1@(L l1 (ConPatIn op1 (InfixCon x y)))) z))) | associatesRight (lookupOpRdrName op1 env) (lookupOpRdrName op2 env) = do let ap2' = L l2 (ConPatIn op2 (InfixCon y z)) swapEntryDPT ap1 ap2' transferAnnsT isComma ap2' ap1- rhs <- fixOnePat env ap2'- return $ L l1 (ConPatIn op1 (InfixCon x rhs))+ rhs <- fixOnePat env (composeSrcSpan ap2')+ return $ cL l1 (ConPatIn op1 (InfixCon x rhs)) #else-fixOnePat env (dL -> L l2 (ConPatIn op2 (InfixCon (dL -> ap1@(L l1 (ConPatIn op1 (InfixCon x y)))) z)))+fixOnePat env (L l2 (ConPatIn op2 (InfixCon ap1@(L l1 (ConPatIn op1 (InfixCon x y))) z))) | associatesRight (lookupOpRdrName op1 env) (lookupOpRdrName op2 env) = do let ap2' = L l2 (ConPatIn op2 (InfixCon y z)) swapEntryDPT ap1 ap2' transferAnnsT isComma ap2' ap1- rhs <- fixOnePat env (composeSrcSpan ap2')- return $ cL l1 (ConPatIn op1 (InfixCon x rhs))+ rhs <- fixOnePat env ap2'+ return $ L l1 (ConPatIn op1 (InfixCon x rhs)) #endif fixOnePat _ e = return e @@ -173,11 +173,11 @@ fixOneEntryExpr e = return e fixOneEntryPat :: Monad m => LPat GhcPs -> TransformT m (LPat GhcPs)-#if __GLASGOW_HASKELL__ < 808-fixOneEntryPat p@(L _ (ConPatIn _ (InfixCon x _))) = fixOneEntry p x-#else+#if __GLASGOW_HASKELL__ == 808 fixOneEntryPat p@(ConPatIn _ (InfixCon x _)) = composeSrcSpan <$> fixOneEntry (dL p) (dL x)+#else+fixOneEntryPat p@(L _ (ConPatIn _ (InfixCon x _))) = fixOneEntry p x #endif fixOneEntryPat p = return p @@ -206,7 +206,13 @@ parseContentNoFixity fp str = do r <- Parsers.parseModuleFromString fp str case r of- Left msg -> fail $ show msg+ Left msg -> do+#if __GLASGOW_HASKELL__ < 810+ fail $ show msg+#else+ join $ Parsers.withDynFlags $ \dflags -> printBagOfErrors dflags msg+ fail "parse failed"+#endif Right (anns, m) -> return $ unsafeMkA m anns 0 parseContent :: FixityEnv -> FilePath -> String -> IO AnnotatedModule@@ -250,13 +256,16 @@ parseType = parseHelper "parseType" Parsers.parseType parseHelper :: FilePath -> Parsers.Parser a -> String -> IO (Annotated a)-parseHelper fp parser str = do- r <- Parsers.withDynFlags p- case r of+parseHelper fp parser str = join $ Parsers.withDynFlags $ \dflags ->+ case parser dflags fp str of+#if __GLASGOW_HASKELL__ < 810 Left (_, msg) -> throwIO $ ErrorCall msg+#else+ Left errBag -> do+ printBagOfErrors dflags errBag+ throwIO $ ErrorCall "parse failed"+#endif Right (anns, x) -> return $ unsafeMkA x anns 0- where- p dflags = parser dflags fp str -------------------------------------------------------------------------------
Retrie/Expr.hs view
@@ -52,7 +52,7 @@ #if __GLASGOW_HASKELL__ < 806 lv@(L _ v') <- cloneT (noLoc (HsVar r)) #else- lv@(L _ v') <- cloneT (noLoc (HsVar noExt r))+ lv@(L _ v') <- cloneT (noLoc (HsVar noExtField r)) #endif case v' of #if __GLASGOW_HASKELL__ < 806@@ -92,7 +92,7 @@ #if __GLASGOW_HASKELL__ < 806 mkMatchGroup Generated [mkMatch LambdaExpr vs e (noLoc EmptyLocalBinds)] #else- mkMatchGroup Generated [mkMatch LambdaExpr vs e (noLoc (EmptyLocalBinds noExt))]+ mkMatchGroup Generated [mkMatch LambdaExpr vs e (noLoc (EmptyLocalBinds noExtField))] #endif m' <- case unLoc $ mg_alts mg of [m] -> setAnnsFor m [(G AnnLam, DP (0,0)),(G AnnRarrow, DP (0,1))]@@ -100,7 +100,7 @@ #if __GLASGOW_HASKELL__ < 806 cloneT $ noLoc $ HsLam mg { mg_alts = noLoc [m'] } #else- cloneT $ noLoc $ HsLam noExt mg { mg_alts = noLoc [m'] }+ cloneT $ noLoc $ HsLam noExtField mg { mg_alts = noLoc [m'] } #endif mkLet :: Monad m => HsLocalBinds GhcPs -> LHsExpr GhcPs -> TransformT m (LHsExpr GhcPs)@@ -110,7 +110,7 @@ #if __GLASGOW_HASKELL__ < 806 le <- mkLoc $ HsLet llbs e #else- le <- mkLoc $ HsLet noExt llbs e+ le <- mkLoc $ HsLet noExtField llbs e #endif setAnnsFor le [(G AnnLet, DP (0,0)), (G AnnIn, DP (1,1))] @@ -120,7 +120,7 @@ #if __GLASGOW_HASKELL__ < 806 f' <- mkLoc (HsApp f a) #else- f' <- mkLoc (HsApp noExt f a)+ f' <- mkLoc (HsApp noExtField f a) #endif mkApps f' as @@ -133,7 +133,7 @@ mkLoc (HsAppsTy ts') #else mkHsAppsTy [] = error "mkHsAppsTy: empty list"-mkHsAppsTy (t:ts) = foldM (\t1 t2 -> mkLoc (HsAppTy noExt t1 t2)) t ts+mkHsAppsTy (t:ts) = foldM (\t1 t2 -> mkLoc (HsAppTy noExtField t1 t2)) t ts #endif mkTyVar :: Monad m => Located RdrName -> TransformT m (LHsType GhcPs)@@ -141,7 +141,7 @@ #if __GLASGOW_HASKELL__ < 806 tv <- mkLoc (HsTyVar NotPromoted nm) #else- tv <- mkLoc (HsTyVar noExt NotPromoted nm)+ tv <- mkLoc (HsTyVar noExtField NotPromoted nm) #endif _ <- setAnnsFor nm [(G AnnVal, DP (0,0))] swapEntryDPT tv nm@@ -228,9 +228,9 @@ go (ListPat _ ps) = do ps' <- mapM patToExpr ps lift $ do- el <- mkLoc $ ExplicitList noExt Nothing ps'+ el <- mkLoc $ ExplicitList noExtField Nothing ps' setAnnsFor el [(G AnnOpenS, DP (0,0)), (G AnnCloseS, DP (0,0))]- go (ParPat _ p') = lift . mkParen (HsPar noExt) =<< patToExpr p'+ go (ParPat _ p') = lift . mkParen (HsPar noExtField) =<< patToExpr p' go (VarPat _ i) = lift $ mkLocatedHsVar i go SigPat{} = error "patToExpr SigPat" go XPat{} = error "patToExpr XPat"@@ -249,7 +249,7 @@ <*> pure PlaceHolder <*> patToExpr y #else- lift . mkLoc =<< OpApp <$> pure noExt+ lift . mkLoc =<< OpApp <$> pure noExtField <*> patToExpr x <*> lift (mkLocatedHsVar con) <*> patToExpr y@@ -290,7 +290,7 @@ #if __GLASGOW_HASKELL__ < 806 mkParen HsPar le #else- mkParen (HsPar noExt) le+ mkParen (HsPar noExtField) le #endif | otherwise = return le where@@ -334,7 +334,7 @@ #if __GLASGOW_HASKELL__ < 806 | needed ty = mkParen HsParTy lty #else- | needed ty = mkParen (HsParTy noExt) lty+ | needed ty = mkParen (HsParTy noExtField) lty #endif | otherwise = return lty where
Retrie/GHC.hs view
@@ -12,8 +12,14 @@ , module BasicTypes , module FastString , module FastStringEnv+#if __GLASGOW_HASKELL__ < 810 , module HsExpr , module HsSyn+#else+ , module ErrUtils+ , module GHC.Hs.Expr+ , module GHC.Hs+#endif , module Module , module Name , module OccName@@ -29,12 +35,18 @@ import BasicTypes import FastString import FastStringEnv+#if __GLASGOW_HASKELL__ < 810 import HsExpr #if __GLASGOW_HASKELL__ < 806 import HsSyn hiding (HasDefault(..)) #else import HsSyn #endif+#else+import ErrUtils+import GHC.Hs.Expr+import GHC.Hs+#endif import Module import Name import OccName@@ -130,3 +142,9 @@ , riLHS :: LHsExpr GhcPs , riRHS :: LHsExpr GhcPs }++#if __GLASGOW_HASKELL__ < 806+#elif __GLASGOW_HASKELL__ < 810+noExtField :: NoExt+noExtField = noExt+#endif
Retrie/PatternMap/Instances.hs view
@@ -356,7 +356,7 @@ #if __GLASGOW_HASKELL__ < 806 go (HsApp l (noLoc (HsPar r))) #else- go (HsApp noExt l (noLoc (HsPar noExt r)))+ go (HsApp noExtField l (noLoc (HsPar noExtField r))) #endif dollarFork _ _ _ = m @@ -457,15 +457,17 @@ go HsSpliceE{} = missingSyntax "HsSpliceE" go HsProc{} = missingSyntax "HsProc" go HsStatic{} = missingSyntax "HsStatic"+#if __GLASGOW_HASKELL__ < 810 go HsArrApp{} = missingSyntax "HsArrApp" go HsArrForm{} = missingSyntax "HsArrForm"- go HsTick{} = missingSyntax "HsTick"- go HsBinTick{} = missingSyntax "HsBinTick"- go HsTickPragma{} = missingSyntax "HsTickPragma" go EWildPat{} = missingSyntax "EWildPat" go EAsPat{} = missingSyntax "EAsPat" go EViewPat{} = missingSyntax "EViewPat" go ELazyPat{} = missingSyntax "ELazyPat"+#endif+ go HsTick{} = missingSyntax "HsTick"+ go HsBinTick{} = missingSyntax "HsBinTick"+ go HsTickPragma{} = missingSyntax "HsTickPragma" go HsWrap{} = missingSyntax "HsWrap" go HsUnboundVar{} = missingSyntax "HsUnboundVar" go HsRecFld{} = missingSyntax "HsRecFld"@@ -710,7 +712,12 @@ emptyCDMapWrapper = CDMap mEmpty mEmpty instance PatternMap CDMap where+#if __GLASGOW_HASKELL__ < 810 type Key CDMap = HsConDetails (LPat GhcPs) (HsRecFields GhcPs (LPat GhcPs))+#else+ -- We must manually expand 'LPat' to avoid UndecidableInstances in GHC 8.10++ type Key CDMap = HsConDetails (Located (Pat GhcPs)) (HsRecFields GhcPs (Located (Pat GhcPs)))+#endif mEmpty :: CDMap a mEmpty = CDEmpty@@ -763,7 +770,12 @@ emptyPatMapWrapper = PatMap mEmpty mEmpty mEmpty mEmpty mEmpty mEmpty instance PatternMap PatMap where+#if __GLASGOW_HASKELL__ < 810 type Key PatMap = LPat GhcPs+#else+ -- We must manually expand 'LPat' to avoid UndecidableInstances in GHC 8.10++ type Key PatMap = Located (Pat GhcPs)+#endif mEmpty :: PatMap a mEmpty = PatEmpty@@ -1187,7 +1199,11 @@ #if __GLASGOW_HASKELL__ < 806 , tyHsAppsTy :: ListMap AppTyMap a #endif+#if __GLASGOW_HASKELL__ < 810 , tyHsForAllTy :: ForAllTyMap a -- See Note [Telescope]+#else+ , tyHsForAllTy :: ForallVisMap (ForAllTyMap a) -- See Note [Telescope]+#endif , tyHsFunTy :: TyMap (TyMap a) , tyHsListTy :: TyMap a , tyHsParTy :: TyMap a@@ -1271,7 +1287,12 @@ m { tyHsTupleTy = mAlter env vs ts (toA (mAlter env vs tys f)) (tyHsTupleTy m) } #else go (HsAppTy _ ty1 ty2) = m { tyHsAppTy = mAlter env vs ty1 (toA (mAlter env vs ty2 f)) (tyHsAppTy m) }+#if __GLASGOW_HASKELL__ < 810 go (HsForAllTy _ bndrs ty') = m { tyHsForAllTy = mAlter env vs (bndrs, ty') f (tyHsForAllTy m) }+#else+ go (HsForAllTy _ vis bndrs ty') =+ m { tyHsForAllTy = mAlter env vs vis (toA (mAlter env vs (bndrs, ty') f)) (tyHsForAllTy m) }+#endif go (HsFunTy _ ty1 ty2) = m { tyHsFunTy = mAlter env vs ty1 (toA (mAlter env vs ty2 f)) (tyHsFunTy m) } go (HsListTy _ ty') = m { tyHsListTy = mAlter env vs ty' f (tyHsListTy m) } go (HsParTy _ ty') = m { tyHsParTy = mAlter env vs ty' f (tyHsParTy m) }@@ -1316,7 +1337,12 @@ go (HsTyVar _ v) = mapFor tyHsTyVar >=> mMatch env (unLoc v) #else go (HsAppTy _ ty1 ty2) = mapFor tyHsAppTy >=> mMatch env ty1 >=> mMatch env ty2+#if __GLASGOW_HASKELL__ < 810 go (HsForAllTy _ bndrs ty') = mapFor tyHsForAllTy >=> mMatch env (bndrs, ty')+#else+ go (HsForAllTy _ vis bndrs ty') =+ mapFor tyHsForAllTy >=> mMatch env vis >=> mMatch env (bndrs, ty')+#endif go (HsFunTy _ ty1 ty2) = mapFor tyHsFunTy >=> mMatch env ty1 >=> mMatch env ty2 go (HsListTy _ ty') = mapFor tyHsListTy >=> mMatch env ty' go (HsParTy _ ty') = mapFor tyHsParTy >=> mMatch env ty'@@ -1474,7 +1500,6 @@ mMatch env HsConstraintTuple = mapFor tsConstraint >=> mMatch env () mMatch env HsBoxedOrConstraintTuple = mapFor tsBoxedOrConstraint >=> mMatch env () - ------------------------------------------------------------------------ -- Note [Telescope]@@ -1543,3 +1568,34 @@ #endif let env' = extendMatchEnv env [v] in mapFor fatKinded >=> mMatch env k >=> mMatch env' (rest, ty)++#if __GLASGOW_HASKELL__ < 810+#else+data ForallVisMap a = ForallVisMap+ { favVis :: MaybeMap a+ , favInvis :: MaybeMap a+ }+ deriving (Functor)++instance PatternMap ForallVisMap where+ type Key ForallVisMap = ForallVisFlag++ mEmpty :: ForallVisMap a+ mEmpty = ForallVisMap mEmpty mEmpty++ mUnion :: ForallVisMap a -> ForallVisMap a -> ForallVisMap a+ mUnion m1 m2 = ForallVisMap+ { favVis = unionOn favVis m1 m2+ , favInvis = unionOn favInvis m1 m2+ }++ mAlter :: AlphaEnv -> Quantifiers -> Key ForallVisMap -> A a -> ForallVisMap a -> ForallVisMap a+ mAlter env vs ForallVis f m =+ m { favVis = mAlter env vs () f (favVis m) }+ mAlter env vs ForallInvis f m =+ m { favInvis = mAlter env vs () f (favInvis m) }++ mMatch :: MatchEnv -> Key ForallVisMap -> (Substitution, ForallVisMap a) -> [(Substitution, a)]+ mMatch env ForallVis = mapFor favVis >=> mMatch env ()+ mMatch env ForallInvis = mapFor favInvis >=> mMatch env ()+#endif
Retrie/Rewrites/Function.hs view
@@ -123,13 +123,13 @@ right op [r] = mkLoc (SectionR op r) right _ _ = fail "backtickRules - right: impossible!" #else- both op [l, r] = mkLoc (OpApp noExt l op r)+ both op [l, r] = mkLoc (OpApp noExtField l op r) both _ _ = fail "backtickRules - both: impossible!" - left op [l] = mkLoc (SectionL noExt l op)+ left op [l] = mkLoc (SectionL noExtField l op) left _ _ = fail "backtickRules - left: impossible!" - right op [r] = mkLoc (SectionR noExt op r)+ right op [r] = mkLoc (SectionR noExtField op r) right _ _ = fail "backtickRules - right: impossible!" #endif qs <- makeFunctionQuery e imps dir grhss both (ps, [])
retrie.cabal view
@@ -4,7 +4,7 @@ -- LICENSE file in the root directory of this source tree. -- name: retrie-version: 0.1.0.1+version: 0.1.1.0 synopsis: A powerful, easy-to-use codemodding tool for Haskell. homepage: https://github.com/facebookincubator/retrie bug-reports: https://github.com/facebookincubator/retrie/issues@@ -23,7 +23,7 @@ README.md tests/inputs/*.custom tests/inputs/*.test-tested-with: GHC ==8.8.2 || ==8.6.5 || ==8.4.4+tested-with: GHC ==8.10.1 || ==8.8.2 || ==8.6.5 || ==8.4.4 description: Retrie is a tool for codemodding Haskell. Key goals include:@@ -75,13 +75,13 @@ build-depends: ansi-terminal >= 0.10.3 && < 0.11, async >= 2.2.2 && < 2.3,- base >= 4.11 && < 4.14,+ base >= 4.11 && < 4.15, bytestring >= 0.10.8 && < 0.11, containers >= 0.5.11 && < 0.7, data-default >= 0.7.1 && < 0.8, directory >= 1.3.1 && < 1.4, filepath >= 1.4.2 && < 1.5,- ghc >= 8.4 && < 8.10,+ ghc >= 8.4 && < 8.12, ghc-exactprint >= 0.6.2 && < 0.7, haskell-src-exts >= 1.23.0 && < 1.24, mtl >= 2.2.2 && < 2.3,@@ -102,7 +102,7 @@ GHC-Options: -Wall build-depends: retrie,- base >= 4.11 && < 4.14,+ base >= 4.11 && < 4.15, data-default default-language: Haskell2010 @@ -114,7 +114,7 @@ GHC-Options: -Wall build-depends: retrie,- base >= 4.11 && < 4.14+ base >= 4.11 && < 4.15 default-language: Haskell2010 test-suite test@@ -139,13 +139,13 @@ build-depends: retrie, HUnit,- base >= 4.11 && < 4.14,+ base >= 4.11 && < 4.15, containers, data-default, deepseq, directory, filepath,- ghc >= 8.4 && < 8.10,+ ghc >= 8.4 && < 8.12, ghc-paths, mtl, optparse-applicative,