apply-refact 0.2.0.0 → 0.3.0.0
raw patch · 5 files changed
+57/−45 lines, 5 filesdep ~basedep ~ghcdep ~ghc-exactprint
Dependency ranges changed: base, ghc, ghc-exactprint, optparse-applicative
Files
- apply-refact.cabal +10/−10
- src/Refact/Apply.hs +31/−21
- src/Refact/Fixity.hs +3/−3
- src/Refact/Utils.hs +13/−11
- tests/examples/Monad10.hs +0/−0
apply-refact.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: apply-refact-version: 0.2.0.0+version: 0.3.0.0 synopsis: Perform refactorings specified by the refact library. description: Perform refactorings specified by the refact library. license: BSD3@@ -18,7 +18,7 @@ , tests/examples/*.hs.refact , tests/examples/*.hs.expected cabal-version: >=1.10-tested-with: GHC == 7.10.2+tested-with: GHC == 8.0.1 source-repository head@@ -30,10 +30,10 @@ , Refact.Apply , Refact.Fixity GHC-Options: -Wall- build-depends: base >=4.7 && <4.9+ build-depends: base >=4.8 && <4.10 , refact >= 0.2- , ghc-exactprint >= 0.5- , ghc+ , ghc-exactprint >= 0.5.2+ , ghc == 8.0.1 , containers , syb , mtl@@ -51,10 +51,10 @@ hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall -fno-warn-unused-do-bind- build-depends: base >= 4.7 && < 4.9+ build-depends: base >= 4.8 && < 4.10 , refact >= 0.2- , ghc-exactprint >= 0.4.1- , ghc+ , ghc-exactprint >= 0.5.2+ , ghc == 8.0.1 , containers , syb , mtl@@ -80,8 +80,8 @@ , tasty-expected-failure , base < 5 , refact >= 0.2- , ghc-exactprint >= 0.4.1- , ghc+ , ghc-exactprint >= 0.5.2+ , ghc == 8.0.1 , containers , syb , mtl
src/Refact/Apply.hs view
@@ -53,7 +53,7 @@ import Refact.Fixity import Refact.Types hiding (SrcSpan) import qualified Refact.Types as R-import Refact.Utils (Stmt, Pat, Name, Decl, M, Expr, Type+import Refact.Utils (Stmt, Pat, Name, Decl, M, Expr, Type, FunBind , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan) -- library access to perform the substitutions@@ -203,50 +203,63 @@ parseMatch dyn fname s = case parseBind dyn fname s of Right (as, GHC.L l GHC.FunBind{fun_matches}) ->- case GHC.mg_alts fun_matches of+ case unLoc (GHC.mg_alts fun_matches) of [x] -> Right (as, x) _ -> Left (l, "Not a single match") Right (_, GHC.L l _) -> Left (l, "Not a funbind") Left e -> Left e -- Substitute variables into templates+-- Finds places in the templates where we need to insert variables. substTransform :: (Data a, Data b) => b -> [(String, GHC.SrcSpan)] -> a -> M a-substTransform m ss = everywhereM (mkM (exprSub m ss)- `extM` typeSub m ss+substTransform m ss = everywhereM (mkM (typeSub m ss)+ `extM` identSub m ss `extM` patSub m ss `extM` stmtSub m ss- `extM` identSub m ss+ `extM` exprSub m ss ) stmtSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Stmt -> M Stmt-stmtSub m subs old@(GHC.L _ (BodyStmt (GHC.L _ (HsVar 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 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 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 name)) =+exprSub m subs old@(GHC.L _ (HsVar (L _ name))) = resolveRdrName m (findExpr m) old subs name exprSub _ _ e = return e -identSub :: Data a => a -> [(String, GHC.SrcSpan)] -> Name -> M Name-identSub m subs old@(GHC.L _ name) =++-- Used for Monad10, Monad11 tests.+-- The issue being that in one case the information is attached to a VarPat+-- but we need to move the annotations onto the actual name+identSub :: Data a => a -> [(String, GHC.SrcSpan)] -> FunBind -> M FunBind+identSub m subs old@(GHC.FunBindMatch (GHC.L _ name) _) = resolveRdrName' subst (findName m) old subs name where- subst :: Name -> (Name, Pat) -> M Name- subst (mkAnnKey -> oldkey) (n, p)- = n <$ modify (\r -> replaceAnnKey r oldkey (mkAnnKey p) (mkAnnKey n) (mkAnnKey p))+ subst :: FunBind -> Name -> M FunBind+ subst (GHC.FunBindMatch n b) new = do+ let fakeExpr = GHC.L (getLoc new) (GHC.VarPat new)+ modify (\r -> replaceAnnKey r (mkAnnKey n) (mkAnnKey fakeExpr) (mkAnnKey new) (mkAnnKey fakeExpr))+ return $ GHC.FunBindMatch new b+ subst o _ = return o+identSub _ _ e = return e +++-- g is usually modifyAnnKey+-- f is usually a function which checks the locations are equal resolveRdrName' :: (a -> b -> M a) -> (SrcSpan -> b) -> a -> [(String, GHC.SrcSpan)] -> GHC.RdrName -> M a@@ -334,14 +347,11 @@ findStmt :: Data a => a -> SrcSpan -> Stmt findStmt = findGen "stmt" -findName :: Data a => a -> SrcSpan -> (Name, Pat)-findName m ss =- case findPat m ss of- p@(GHC.L l (VarPat n)) -> (GHC.L l n, p)- GHC.L l _ -> error $ "Not var pat: " ++ showGhc l-+findName :: Data a => a -> SrcSpan -> Name+findName = findGen "name" -findLargestExpression :: SrcSpan -> GHC.Located ast -> Maybe (GHC.Located ast)+findLargestExpression :: SrcSpan -> GHC.Located ast+ -> Maybe (GHC.Located ast) findLargestExpression ss e@(GHC.L l _) = if l == ss then Just e
src/Refact/Fixity.hs view
@@ -26,13 +26,13 @@ in (as', m') --error (showAnnData as 0 m ++ showAnnData as' 0 m') expFix :: LHsExpr RdrName -> M (LHsExpr RdrName)-expFix (L loc (OpApp l op _ r)) = do+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 n) = occNameString . rdrNameOcc $ n+getIdent (unLoc -> HsVar (L _ n)) = occNameString . rdrNameOcc $ n getIdent _ = error "Must be HsVar" @@ -161,5 +161,5 @@ -- Internal: help function for the above definitions. fixity :: FixityDirection -> Int -> [String] -> [(String, Fixity)]-fixity a p = map (,Fixity p a)+fixity a p = map (,Fixity "" p a)
src/Refact/Utils.hs view
@@ -14,6 +14,7 @@ , Pat , Type , Import+ , FunBind -- * Monad , M -- * Utility@@ -45,7 +46,6 @@ import qualified Refact.Types as R-import Refact.Types hiding (SrcSpan) import Data.Generics.Schemes import Unsafe.Coerce@@ -71,6 +71,7 @@ type Import = LImportDecl GHC.RdrName +type FunBind = MatchFixity GHC.RdrName -- | Replaces an old expression with a new expression replace :: AnnKey -> AnnKey -> AnnKey -> AnnKey -> Anns -> Maybe Anns@@ -109,15 +110,15 @@ -- | A parent in this case is an element which has the same SrcSpan-findParent :: Data a => GHC.SrcSpan -> a -> Maybe AnnKey-findParent ss = something (findParentWorker ss)+findParent :: Data a => GHC.SrcSpan -> Anns -> a -> Maybe AnnKey+findParent ss as = something (findParentWorker ss as) -findParentWorker :: forall a . (Typeable a, Data a)- => GHC.SrcSpan -> a -> Maybe AnnKey-findParentWorker oldSS a+findParentWorker :: forall a . (Data a)+ => GHC.SrcSpan -> Anns -> a -> Maybe AnnKey+findParentWorker oldSS as a | con == typeRepTyCon (typeRep (Proxy :: Proxy (GHC.Located GHC.RdrName))) && x == typeRep (Proxy :: Proxy GHC.SrcSpan)- = if ss == oldSS+ = if ss == oldSS && isJust (Map.lookup (AnnKey ss cn) as) then Just $ AnnKey ss cn else Nothing | otherwise = Nothing@@ -134,9 +135,10 @@ -- For example, this function will ensure the correct relative position and -- make sure that any trailing semi colons or commas are transferred. modifyAnnKey :: (Data old, Data new, Data mod) => mod -> Located old -> Located new -> M (Located new)-modifyAnnKey m e1 e2 = e2 <$ modify (\m' -> replaceAnnKey m' (mkAnnKey e1) (mkAnnKey e2) (mkAnnKey e2) parentKey)- where- parentKey = fromMaybe (mkAnnKey e2) (findParent (getLoc e2) m)+modifyAnnKey m e1 e2 = do+ as <- get+ let parentKey = fromMaybe (mkAnnKey e2) (findParent (getLoc e2) as m)+ e2 <$ modify (\m' -> replaceAnnKey m' (mkAnnKey e1) (mkAnnKey e2) (mkAnnKey e2) parentKey) -- | Lower level version of @modifyAnnKey@@@ -150,4 +152,4 @@ toGhcSrcSpan :: FilePath -> R.SrcSpan -> SrcSpan toGhcSrcSpan file R.SrcSpan{..} = mkSrcSpan (f startLine startCol) (f endLine endCol) where- f x y = mkSrcLoc (GHC.mkFastString file) x y+ f = mkSrcLoc (GHC.mkFastString file)
tests/examples/Monad10.hs view