apply-refact 0.8.1.0 → 0.8.2.0

raw patch · 17 files changed

+162/−39 lines, 17 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• apply-refact.cabal +1/−1
• src/Refact/Apply.hs +133/−25
• src/Refact/Utils.hs +11/−0
• tests/examples/Default71.hs.expected +1/−1
• tests/examples/Default71.hs.refact +1/−1
• tests/examples/Lambda37.hs +1/−1
• tests/examples/Lambda37.hs.expected +1/−1
• tests/examples/Lambda37.hs.refact +1/−1
• tests/examples/Lambda4.hs.expected +1/−1
• tests/examples/Lambda4.hs.refact +1/−1
• tests/examples/Lambda5.hs.expected +1/−1
• tests/examples/Lambda5.hs.refact +1/−1
• tests/examples/Lambda6.hs.expected +1/−1
• tests/examples/Lambda6.hs.refact +1/−1
• tests/examples/Lambda7.hs.expected +1/−1
• tests/examples/Lambda7.hs.refact +1/−1

@@ -1,3 +1,7 @@+v0.8.2.0++  * #75, support refactoring for Eta reduce+ v0.8.1.0    * #68, support GHC 8.6

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                apply-refact-version:             0.8.1.0+version:             0.8.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:             BSD3

@@ -7,6 +7,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeApplications #-} module Refact.Apply   (     runRefactoring@@ -38,7 +39,7 @@ import Data.Data import Data.Generics.Schemes import Data.Maybe-import Data.List hiding (find)+import Data.List import Data.Ord  #if __GLASGOW_HASKELL__ >= 810@@ -70,7 +71,7 @@ import Refact.Types hiding (SrcSpan) import qualified Refact.Types as R import Refact.Utils (Stmt, Pat, Name, Decl, M, Expr, Type, FunBind-                    , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan)+                    , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan, setSrcSpanFile)  #if __GLASGOW_HASKELL__ >= 810 type Errors = ErrorMessages@@ -88,6 +89,8 @@  decomposeSrcSpan :: a -> a decomposeSrcSpan = id++type SrcSpanLess a = a #endif  -- library access to perform the substitutions@@ -343,30 +346,137 @@  -- Substitute the template into the original AST. #if __GLASGOW_HASKELL__ <= 806-doGenReplacement :: (Data ast, Data a)-              => a-              -> (GHC.Located ast -> Bool)-              -> GHC.Located ast-              -> GHC.Located ast-              -> State (Anns, Bool) (GHC.Located ast)+doGenReplacement+  :: forall ast a. (Data ast, Data a)+  => a+  -> (GHC.Located ast -> Bool)+  -> GHC.Located ast+  -> GHC.Located ast+  -> State (Anns, Bool) (GHC.Located ast) #else-doGenReplacement :: (Data (SrcSpanLess ast), HasSrcSpan ast, Data a)-              => a-              -> (ast -> Bool)-              -> ast-              -> ast-              -> State (Anns, Bool) ast+doGenReplacement+  :: forall ast a. (Data (SrcSpanLess ast), HasSrcSpan ast, Data a)+  => a+  -> (ast -> Bool)+  -> ast+  -> ast+  -> State (Anns, Bool) ast #endif-doGenReplacement m p new old =-  if p old then do-                  s <- get-                  let n = decomposeSrcSpan new-                      o = decomposeSrcSpan old-                      (v, st) = runState (modifyAnnKey m o n) (fst s)-                  modify (const (st, True))-                  return $ composeSrcSpan v-           else return old+doGenReplacement m p new old+  | p old = do+      anns <- gets fst+      let n = decomposeSrcSpan new+          o = decomposeSrcSpan old+          newAnns = execState (modifyAnnKey m o n) anns+      put (newAnns, True)+      pure new+  -- If "f a = body where local" doesn't satisfy the predicate, but "f a = body" does,+  -- run the replacement on "f a = body", and add "local" back afterwards.+  -- This is useful for hints like "Eta reduce" and "Redundant where".+  | 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+  , p (composeSrcSpan oldNoLocal) = do+      anns <- gets fst+      let n = decomposeSrcSpan new+          o = decomposeSrcSpan old+          intAnns = execState (modifyAnnKey m o n) anns+          newFile = srcSpanFile newLocReal+          newLocal = everywhere (mkT $ setSrcSpanFile newFile) oldLocal+          newLocalLoc = getLoc newLocal+          ensureLoc = combineSrcSpans newLocalLoc+          newMG = fun_matches newBind+          L locMG [L locMatch newMatch] = mg_alts newMG+          newGRHSs = m_grhss newMatch+          finalLoc = ensureLoc newLoc+          newWithLocalBinds = setLocalBind newLocal xvald newBind finalLoc+                                           newMG (ensureLoc locMG) newMatch (ensureLoc locMatch) newGRHSs +          -- Ensure the new Anns properly reflects the local binds we added back.+          addLocalBindsToAnns = addAnnWhere+                              . Map.fromList+                              . map (first (expandTemplateLoc . updateFile . expandGRHSLoc))+                              . Map.toList+            where+              addAnnWhere :: Anns -> Anns+              addAnnWhere oldAnns =+                let oldAnns' = Map.toList oldAnns+                    po = \case+                      (AnnKey loc@(RealSrcSpan r) con, _) ->+                        loc == getLoc old && con == CN "Match" && srcSpanFile r /= newFile+                      _ -> False+                    pn = \case+                      (AnnKey loc@(RealSrcSpan r) con, _) ->+                        loc == finalLoc && con == CN "Match" && srcSpanFile r == newFile+                      _ -> False+                in fromMaybe oldAnns $ do+                      oldAnn <- snd <$> find po oldAnns'+                      annWhere <- find ((== G GHC.AnnWhere) . fst) (annsDP oldAnn)+                      newKey <- fst <$> find pn oldAnns'+                      pure $ Map.adjust (\ann -> ann {annsDP = annsDP ann ++ [annWhere]}) newKey oldAnns++              -- Expand the SrcSpan of the "GRHS" entry in the new file to include the local binds+              expandGRHSLoc = \case+                AnnKey loc@(RealSrcSpan r) con+                  | con == CN "GRHS", srcSpanFile r == newFile -> AnnKey (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+                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+                other -> other++          newAnns = addLocalBindsToAnns intAnns+      put (newAnns, True)+      pure $ composeSrcSpan newWithLocalBinds+  | otherwise = pure old++-- | If the input is a FunBind with a single match, e.g., "foo a = body where x = y"+-- return "Just (foo a = body, x = y)". Otherwise return Nothing.+stripLocalBind+  :: LHsDecl GHC.GhcPs+  -> Maybe (LHsDecl GHC.GhcPs, LHsLocalBinds GHC.GhcPs)+stripLocalBind = \case+  L _ (ValD xvald origBind@FunBind{})+    | let origMG = fun_matches origBind+    , L locMG [L locMatch origMatch] <- mg_alts origMG+    , let origGRHSs = m_grhss origMatch+    , [L _ (GRHS _ _ (L loc2 _))] <- grhssGRHSs origGRHSs ->+      let loc1 = getLoc (fun_id origBind)+          newLoc = combineSrcSpans loc1 loc2+          withoutLocalBinds = setLocalBind (noLoc (EmptyLocalBinds noExt)) xvald origBind newLoc origMG locMG+                                           origMatch locMatch origGRHSs+       in Just (withoutLocalBinds, grhssLocalBinds origGRHSs)+  _ -> Nothing++-- | Set the local binds in a HsBind.+setLocalBind+  :: LHsLocalBinds GHC.GhcPs+  -> XValD GhcPs+  -> HsBind GhcPs+  -> SrcSpan+  -> MatchGroup GhcPs (LHsExpr GhcPs)+  -> SrcSpan+  -> Match GhcPs (LHsExpr GhcPs)+  -> SrcSpan+  -> GRHSs GhcPs (LHsExpr GhcPs)+  -> LHsDecl GhcPs+setLocalBind newLocalBinds xvald origBind newLoc origMG locMG origMatch locMatch origGRHSs =+    L newLoc (ValD xvald newBind)+  where+    newGRHSs = origGRHSs{grhssLocalBinds = newLocalBinds}+    newMatch = origMatch{m_grhss = newGRHSs}+    newMG = origMG{mg_alts = L locMG [L locMatch newMatch]}+    newBind = origBind{fun_matches = newMG}+ #if __GLASGOW_HASKELL__ <= 806 replaceWorker :: (Annotate a, Data mod)               => Anns@@ -428,8 +538,6 @@         -- Failed to find a replacment so don't make any changes         _ -> (as, m) replaceWorker as m _ _ _  = (as, m)--  -- Find the largest expression with a given SrcSpan findGen :: forall ast a . (Data ast, Data a) => String -> a -> SrcSpan -> GHC.Located ast

@@ -23,6 +23,7 @@                     , modifyAnnKey                     , replaceAnnKey                     , toGhcSrcSpan+                    , setSrcSpanFile                     , findParent                      ) where@@ -32,6 +33,7 @@  import Data.Data +import FastString (FastString) import SrcLoc import qualified SrcLoc as GHC import qualified RdrName as GHC@@ -172,3 +174,12 @@ toGhcSrcSpan file R.SrcSpan{..} = mkSrcSpan (f startLine startCol) (f endLine endCol)   where     f = mkSrcLoc (GHC.mkFastString file)++setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan+setSrcSpanFile file 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

@@ -1,1 +1,1 @@-fooer input = mapMaybe Just $ input+fooer = catMaybes . map Just

@@ -1,1 +1,1 @@-[("tests/examples/Default71.hs:1:1-42: Warning: Eta reduce\nFound:\n  fooer input = catMaybes . map Just $ input\nPerhaps:\n  fooer = catMaybes . map Just\n",[]),("tests/examples/Default71.hs:1:15-34: Warning: Use mapMaybe\nFound:\n  catMaybes . map Just\nPerhaps:\n  mapMaybe Just\n",[Replace {rtype = Expr, pos = SrcSpan {startLine = 1, startCol = 15, endLine = 1, endCol = 35}, subts = [("f",SrcSpan {startLine = 1, startCol = 31, endLine = 1, endCol = 35})], orig = "mapMaybe f"}])]+[("tests/examples/Default71.hs:1:1-42: Warning: Eta reduce\nFound:\n  fooer input = catMaybes . map Just $ input\nPerhaps:\n  fooer = catMaybes . map Just\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 43}, subts = [("body",SrcSpan {startLine = 1, startCol = 15, endLine = 1, endCol = 35})], orig = "fooer = body"}]),("tests/examples/Default71.hs:1:15-34: Warning: Use mapMaybe\nFound:\n  catMaybes . map Just\nPerhaps:\n  mapMaybe Just\n",[Replace {rtype = Expr, pos = SrcSpan {startLine = 1, startCol = 15, endLine = 1, endCol = 35}, subts = [("f",SrcSpan {startLine = 1, startCol = 31, endLine = 1, endCol = 35})], orig = "mapMaybe f"}])]

@@ -1,1 +1,1 @@-foo a b c = bar (flux ++ quux) c where flux = a+foo d a c b = bar (flux ++ quux) c b where flux = d

@@ -1,1 +1,1 @@-foo a b c = bar (flux ++ quux) c where flux = a+foo d a = bar (flux ++ quux) where flux = d

@@ -1,1 +1,1 @@-[("tests/examples/Lambda37.hs:1:1-32: Warning: Eta reduce\nFound:\n  foo a b c = bar (flux ++ quux) c\nPerhaps:\n  foo a b = bar (flux ++ quux)\n",[])]+[("tests/examples/Lambda37.hs:1:1-36: Warning: Eta reduce\nFound:\n  foo d a c b = bar (flux ++ quux) c b\nPerhaps:\n  foo d a = bar (flux ++ quux)\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 37}, subts = [("body",SrcSpan {startLine = 1, startCol = 15, endLine = 1, endCol = 33}),("a",SrcSpan {startLine = 1, startCol = 5, endLine = 1, endCol = 6}),("b",SrcSpan {startLine = 1, startCol = 7, endLine = 1, endCol = 8})], orig = "foo a b = body"}])]

@@ -1,1 +1,1 @@-fun x y z = f x y z+fun = f

@@ -1,1 +1,1 @@-[("tests/examples/Lambda4.hs:1:1-19: Warning: Eta reduce\nFound:\n  fun x y z = f x y z\nPerhaps:\n  fun = f\n",[])]+[("tests/examples/Lambda4.hs:1:1-19: Warning: Eta reduce\nFound:\n  fun x y z = f x y z\nPerhaps:\n  fun = f\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 20}, subts = [("body",SrcSpan {startLine = 1, startCol = 13, endLine = 1, endCol = 14})], orig = "fun = body"}])]

@@ -1,1 +1,1 @@-fun x y z = f x x y z+fun x = f x x

@@ -1,1 +1,1 @@-[("tests/examples/Lambda5.hs:1:1-21: Warning: Eta reduce\nFound:\n  fun x y z = f x x y z\nPerhaps:\n  fun x = f x x\n",[])]+[("tests/examples/Lambda5.hs:1:1-21: Warning: Eta reduce\nFound:\n  fun x y z = f x x y z\nPerhaps:\n  fun x = f x x\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 22}, subts = [("body",SrcSpan {startLine = 1, startCol = 13, endLine = 1, endCol = 18}),("a",SrcSpan {startLine = 1, startCol = 5, endLine = 1, endCol = 6})], orig = "fun a = body"}])]

@@ -1,1 +1,1 @@-fun x y z = f g z+fun x y = f g

@@ -1,1 +1,1 @@-[("tests/examples/Lambda6.hs:1:1-17: Warning: Eta reduce\nFound:\n  fun x y z = f g z\nPerhaps:\n  fun x y = f g\n",[])]+[("tests/examples/Lambda6.hs:1:1-17: Warning: Eta reduce\nFound:\n  fun x y z = f g z\nPerhaps:\n  fun x y = f g\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 18}, subts = [("body",SrcSpan {startLine = 1, startCol = 13, endLine = 1, endCol = 16}),("a",SrcSpan {startLine = 1, startCol = 5, endLine = 1, endCol = 6}),("b",SrcSpan {startLine = 1, startCol = 7, endLine = 1, endCol = 8})], orig = "fun a b = body"}])]

@@ -1,1 +1,1 @@-fun mr = y mr+fun = y

@@ -1,1 +1,1 @@-[("tests/examples/Lambda7.hs:1:1-13: Warning: Eta reduce\nFound:\n  fun mr = y mr\nPerhaps:\n  fun = y\n",[])]+[("tests/examples/Lambda7.hs:1:1-13: Warning: Eta reduce\nFound:\n  fun mr = y mr\nPerhaps:\n  fun = y\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 14}, subts = [("body",SrcSpan {startLine = 1, startCol = 10, endLine = 1, endCol = 11})], orig = "fun = body"}])]