diff --git a/apply-refact.cabal b/apply-refact.cabal --- a/apply-refact.cabal +++ b/apply-refact.cabal @@ -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 diff --git a/src/Refact/Apply.hs b/src/Refact/Apply.hs --- a/src/Refact/Apply.hs +++ b/src/Refact/Apply.hs @@ -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)) diff --git a/src/Refact/Fixity.hs b/src/Refact/Fixity.hs --- a/src/Refact/Fixity.hs +++ b/src/Refact/Fixity.hs @@ -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)