apply-refact 0.5.0.0 → 0.6.0.0
raw patch · 3 files changed
+26/−27 lines, 3 filesdep ~ghcdep ~ghc-exactprint
Dependency ranges changed: ghc, ghc-exactprint
Files
- apply-refact.cabal +7/−7
- src/Refact/Apply.hs +6/−6
- src/Refact/Fixity.hs +13/−14
apply-refact.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: apply-refact-version: 0.5.0.0+version: 0.6.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: BSD3@@ -32,8 +32,8 @@ GHC-Options: -Wall build-depends: base >=4.8 && < 5 , refact >= 0.2- , ghc-exactprint >= 0.5.6.1- , ghc >= 8.4.0 && < 8.6+ , ghc-exactprint >= 0.5.7.0+ , ghc >= 8.6.0 && < 8.8 , containers , syb , mtl@@ -59,8 +59,8 @@ ghc-options: -Wall -fno-warn-unused-do-bind build-depends: base >= 4.8 && < 5 , refact >= 0.2- , ghc-exactprint >= 0.5.6.1- , ghc >= 8.4.0 && < 8.6+ , ghc-exactprint >= 0.5.7.0+ , ghc >= 8.6.0 && < 8.8 , containers , syb , mtl@@ -92,8 +92,8 @@ , tasty-expected-failure , base < 5 , refact >= 0.2- , ghc-exactprint >= 0.5.6.1- , ghc >= 8.4.0 && < 8.6+ , ghc-exactprint >= 0.5.7.0+ , ghc >= 8.6.0 && < 8.8 , containers , syb , mtl
src/Refact/Apply.hs view
@@ -197,7 +197,7 @@ parseBind dyn fname s = case parseDecl dyn fname s of -- Safe as we add no annotations to the ValD- Right (as, GHC.L l (GHC.ValD b)) -> Right (as, GHC.L l b)+ Right (as, GHC.L l (GHC.ValD _ b)) -> Right (as, GHC.L l b) Right (_, GHC.L l _) -> Left (l, "Not a HsBind") Left e -> Left e parseMatch :: Parser (GHC.LMatch GHC.GhcPs (GHC.LHsExpr GHC.GhcPs))@@ -222,22 +222,22 @@ ) stmtSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Stmt -> M Stmt-stmtSub m subs old@(GHC.L _ (BodyStmt (GHC.L _ (HsVar (L _ name))) _ _ _) ) =+stmtSub m subs old@(GHC.L _ (BodyStmt _ (GHC.L _ (HsVar _ (L _ name))) _ _) ) = resolveRdrName m (findStmt m) old subs name stmtSub _ _ e = return e patSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Pat -> M Pat-patSub m subs old@(GHC.L _ (VarPat (L _ name))) =+patSub m subs old@(GHC.L _ (VarPat _ (L _ name))) = resolveRdrName m (findPat m) old subs name patSub _ _ e = return e typeSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Type -> M Type-typeSub m subs old@(GHC.L _ (HsTyVar _ (L _ name))) =+typeSub m subs old@(GHC.L _ (HsTyVar _ _ (L _ name))) = resolveRdrName m (findType m) old subs name typeSub _ _ e = return e exprSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Expr -> M Expr-exprSub m subs old@(GHC.L _ (HsVar (L _ name))) =+exprSub m subs old@(GHC.L _ (HsVar _ (L _ name))) = resolveRdrName m (findExpr m) old subs name exprSub _ _ e = return e @@ -256,7 +256,7 @@ subst :: FunBind -> Name -> M FunBind subst (GHC.FunRhs n b s) new = do let fakeExpr :: Located (GHC.Pat GhcPs)- fakeExpr = GHC.L (getLoc new) (GHC.VarPat new)+ fakeExpr = GHC.L (getLoc new) (GHC.VarPat noExt new) -- Low level version as we need to combine the annotation information -- from the template RdrName and the original VarPat. modify (\r -> replaceAnnKey r (mkAnnKey n) (mkAnnKey fakeExpr) (mkAnnKey new) (mkAnnKey fakeExpr))
src/Refact/Fixity.hs view
@@ -11,7 +11,6 @@ import RdrName import HsExtension import OccName-import PlaceHolder import Data.Generics hiding (Fixity) import Data.Maybe import Language.Haskell.GHC.ExactPrint.Types hiding (GhcPs, GhcTc, GhcRn)@@ -27,13 +26,13 @@ in (as', m') --error (showAnnData as 0 m ++ showAnnData as' 0 m') expFix :: LHsExpr GhcPs -> M (LHsExpr GhcPs)-expFix (L loc (OpApp l op _ r)) =+expFix (L loc (OpApp _ l op r)) = mkOpAppRn baseFixities loc l op (findFixity baseFixities op) r expFix e = return e getIdent :: Expr -> String-getIdent (unLoc -> HsVar (L _ n)) = occNameString . rdrNameOcc $ n+getIdent (unLoc -> HsVar _ (L _ n)) = occNameString . rdrNameOcc $ n getIdent _ = error "Must be HsVar" @@ -55,30 +54,30 @@ -> M (LHsExpr GhcPs) -- (e11 `op1` e12) `op2` e2-mkOpAppRn fs loc e1@(L _ (OpApp e11 op1 p e12)) op2 fix2 e2+mkOpAppRn fs loc e1@(L _ (OpApp x1 e11 op1 e12)) op2 fix2 e2 | nofix_error- = return $ L loc (OpApp e1 op2 p e2)+ = return $ L loc (OpApp noExt e1 op2 e2) | associate_right = do new_e <- mkOpAppRn fs loc' e12 op2 fix2 e2 moveDelta (mkAnnKey e12) (mkAnnKey new_e)- return $ L loc (OpApp e11 op1 p new_e)+ return $ L loc (OpApp x1 e11 op1 new_e) where- fix1 = findFixity fs op1 loc'= combineLocs e12 e2+ fix1 = findFixity fs op1 (nofix_error, associate_right) = compareFixity fix1 fix2 --------------------------- -- (- neg_arg) `op` e2-mkOpAppRn fs loc e1@(L _ (NegApp neg_arg neg_name)) op2 fix2 e2+mkOpAppRn fs loc e1@(L _ (NegApp _ neg_arg neg_name)) op2 fix2 e2 | nofix_error- = return (L loc (OpApp e1 op2 PlaceHolder e2))+ = return (L loc (OpApp noExt e1 op2 e2)) | associate_right = do new_e <- mkOpAppRn fs loc' neg_arg op2 fix2 e2 moveDelta (mkAnnKey neg_arg) (mkAnnKey new_e)- let res = L loc (NegApp new_e neg_name)+ let res = L loc (NegApp noExt new_e neg_name) key = mkAnnKey res ak = AnnKey loc (CN "OpApp") opAnn <- gets (fromMaybe annNone . Map.lookup ak)@@ -92,16 +91,16 @@ --------------------------- -- e1 `op` - neg_arg-mkOpAppRn _ loc e1 op1 fix1 e2@(L _ (NegApp _ _)) -- NegApp can occur on the right+mkOpAppRn _ loc e1 op1 fix1 e2@(L _ (NegApp {})) -- NegApp can occur on the right | not associate_right -- We *want* right association- = return $ L loc (OpApp e1 op1 PlaceHolder e2)+ = return $ L loc (OpApp noExt e1 op1 e2) where (_, associate_right) = compareFixity fix1 negateFixity --------------------------- -- Default case-mkOpAppRn _ loc e1 op _ e2 -- Default case, no rearrangment- = return $ L loc (OpApp e1 op PlaceHolder e2)+mkOpAppRn _ loc e1 op _fix e2 -- Default case, no rearrangment+ = return $ L loc (OpApp noExt e1 op e2) findFixity :: [(String, Fixity)] -> Expr -> Fixity findFixity fs r = askFix fs (getIdent r)