apply-refact 0.1.0.0 → 0.2.0.0
raw patch · 7 files changed
+131/−69 lines, 7 filesdep +temporarydep −temporary-rcPVP ok
version bump matches the API change (PVP)
Dependencies added: temporary
Dependencies removed: temporary-rc
API changes (from Hackage documentation)
+ Refact.Apply: Loud :: Verbosity
+ Refact.Apply: Normal :: Verbosity
+ Refact.Apply: Silent :: Verbosity
+ Refact.Apply: applyRefactorings :: Maybe (Int, Int) -> [(String, [Refactoring SrcSpan])] -> FilePath -> IO String
+ Refact.Apply: data Verbosity
+ Refact.Apply: instance GHC.Classes.Eq Refact.Apply.Verbosity
+ Refact.Apply: instance GHC.Classes.Ord Refact.Apply.Verbosity
+ Refact.Apply: instance GHC.Show.Show Refact.Apply.Verbosity
+ Refact.Apply: refactOptions :: PrintOptions Identity String
+ Refact.Apply: removeOverlap :: Verbosity -> [(String, [Refactoring SrcSpan])] -> [(String, [Refactoring SrcSpan])]
+ Refact.Apply: rigidLayout :: DeltaOptions
Files
- CHANGELOG +4/−0
- README.md +15/−1
- apply-refact.cabal +7/−3
- src/Main.hs +0/−54
- src/Refact/Apply.hs +103/−11
- src/Refact/Utils.hs +1/−0
- tests/Test.hs +1/−0
CHANGELOG view
@@ -1,3 +1,7 @@+v0.2++ * API refactoring to make the tool usable as a library.+ v0.1 * Initial Release
README.md view
@@ -2,6 +2,20 @@ [`refact`](https://hackage.haskell.org/package/refact) package. It is currently integrated into `hlint` to enable the automatic application of suggestions. +# install++```shell+stack --resolver=nightly install apply-refact+```++executable name is `refactor`++#### Hlint Integration example++```shell+hlint src/Main.hs --refactor --refactor-options="--inplace"+```+ # Example Usage <img src="http://i.imgur.com/7YXoVft.gif">@@ -11,7 +25,7 @@ foo = (x) -# hlint.refact -- produced by hlint+# hlint.refact -- produced by hlint --serialise [("test.hs:1:7: Warning: Redundant bracket\nFound:\n (x)\nWhy not:\n x\n",[Replace {rtype = Expr, pos = SrcSpan {startLine = 1, startCol = 7, endLine = 1, endCol = 10}, subts = [("x",SrcSpan {startLine = 1, startCol = 8, endLine =
apply-refact.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: apply-refact-version: 0.1.0.0+version: 0.2.0.0 synopsis: Perform refactorings specified by the refact library. description: Perform refactorings specified by the refact library. license: BSD3@@ -38,6 +38,10 @@ , syb , mtl , process+ , transformers+ , temporary+ , filemanip+ , unix-compat , directory hs-source-dirs: src default-language: Haskell2010@@ -60,7 +64,7 @@ , filemanip , unix-compat , filepath- , temporary-rc+ , temporary , transformers Test-Suite test@@ -88,5 +92,5 @@ , unix-compat , filepath , silently- , temporary-rc+ , temporary , transformers
src/Main.hs view
@@ -13,9 +13,7 @@ import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Print-import Language.Haskell.GHC.ExactPrint.Delta import Language.Haskell.GHC.ExactPrint.Parsers (parseModuleWithOptions)-import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Utils @@ -30,7 +28,6 @@ import Data.Maybe import Control.Monad.Trans.Maybe import Data.List hiding (find)-import Data.Ord import System.IO import System.IO.Temp@@ -51,7 +48,6 @@ import Text.Read import Data.Char -data Verbosity = Silent | Normal | Loud deriving (Eq, Show, Ord) parseVerbosity :: Monad m => String -> m Verbosity parseVerbosity s =@@ -184,12 +180,7 @@ -- Pipe -refactOptions :: PrintOptions Identity String-refactOptions = stringOptions { epRigidity = RigidLayout } -rigidLayout :: DeltaOptions-rigidLayout = deltaOptions RigidLayout- runPipe :: Options -> FilePath -> IO () runPipe Options{..} file = do let verb = optionsVerbosity@@ -228,51 +219,6 @@ Just f -> do when (verb == Loud) (traceM $ "Writing result to " ++ f) writeFile f output---- Filters out overlapping ideas, picking the first idea in a set of overlapping ideas.--- If two ideas start in the exact same place, pick the largest edit.-removeOverlap :: Verbosity -> [(String, [Refactoring R.SrcSpan])] -> [(String, [Refactoring R.SrcSpan])]-removeOverlap verb = dropOverlapping . sortBy f . summarize- where- -- We want to consider all Refactorings of a single idea as a unit, so compute a summary- -- SrcSpan that encompasses all the Refactorings within each idea.- summarize :: [(String, [Refactoring R.SrcSpan])] -> [(String, (R.SrcSpan, [Refactoring R.SrcSpan]))]- summarize ideas = [ (s, (foldr1 summary (map pos rs), rs)) | (s, rs) <- ideas, not (null rs) ]-- summary (R.SrcSpan sl1 sc1 el1 ec1)- (R.SrcSpan sl2 sc2 el2 ec2) =- let (sl, sc) = case compare sl1 sl2 of- LT -> (sl1, sc1)- EQ -> (sl1, min sc1 sc2)- GT -> (sl2, sc2)- (el, ec) = case compare el1 el2 of- LT -> (el2, ec2)- EQ -> (el2, max ec1 ec2)- GT -> (el1, ec1)- in R.SrcSpan sl sc el ec-- -- Order by span start. If starting in same place, order by size.- f (_,(s1,_)) (_,(s2,_)) =- comparing startLine s1 s2 <> -- s1 first if it starts on earlier line- comparing startCol s1 s2 <> -- or on earlier column- comparing endLine s2 s1 <> -- they start in same place, s2 comes- comparing endCol s2 s1 -- first if it ends later- -- else, completely same span, so s1 will be first-- dropOverlapping [] = []- dropOverlapping (p:ps) = go p ps- go (s,(_,rs)) [] = [(s,rs)]- go p@(s,(_,rs)) (x:xs)- | p `overlaps` x = (if verb > Silent- then trace ("Ignoring " ++ show (snd (snd x)) ++ " due to overlap.")- else id) go p xs- | otherwise = (s,rs) : go x xs- -- for overlaps, we know s1 always starts <= s2, due to our sort- overlaps (_,(s1,_)) (_,(s2,_)) =- case compare (startLine s2) (endLine s1) of- LT -> True- EQ -> startCol s2 <= endCol s1- GT -> False data LoopOption = LoopOption { desc :: String
src/Refact/Apply.hs view
@@ -3,29 +3,43 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NoMonomorphismRestriction #-}-module Refact.Apply (runRefactoring) where+module Refact.Apply+ (+ runRefactoring+ , applyRefactorings + -- * Support for runPipe in the main process+ , Verbosity(..)+ , rigidLayout+ , removeOverlap+ , refactOptions+ ) where+ import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Annotate+import Language.Haskell.GHC.ExactPrint.Delta+import Language.Haskell.GHC.ExactPrint.Parsers+import Language.Haskell.GHC.ExactPrint.Print import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Utils +import Data.Maybe+import Data.List hiding (find)+import Data.Ord++import Control.Monad+import Control.Monad.State+import Control.Monad.Identity import Data.Data import Data.Generics.Schemes import HsExpr as GHC hiding (Stmt)-import qualified HsBinds as GHC-import qualified HsDecls as GHC import HsImpExp-import qualified Module as GHC import HsSyn hiding (Pat, Stmt) import SrcLoc-import qualified SrcLoc as GHC-import qualified RdrName as GHC+import qualified GHC hiding (parseModule) import qualified OccName as GHC-import Data.Generics-import Control.Monad.State+import Data.Generics hiding (GT) import qualified Data.Map as Map @@ -33,13 +47,91 @@ import Control.Arrow -import Data.Maybe+import Debug.Trace +import Data.Monoid+import Refact.Fixity import Refact.Types hiding (SrcSpan) import qualified Refact.Types as R import Refact.Utils (Stmt, Pat, Name, Decl, M, Expr, Type- , modifyAnnKey, replaceAnnKey, Import)+ , modifyAnnKey, replaceAnnKey, Import, toGhcSrcSpan) +-- library access to perform the substitutions++refactOptions :: PrintOptions Identity String+refactOptions = stringOptions { epRigidity = RigidLayout }++rigidLayout :: DeltaOptions+rigidLayout = deltaOptions RigidLayout++-- | Apply a set of refactorings as supplied by hlint+applyRefactorings :: Maybe (Int, Int) -> [(String, [Refactoring R.SrcSpan])] -> FilePath -> IO String+applyRefactorings optionsPos inp file = do+ (as, m) <- either (error . show) (uncurry applyFixities)+ <$> parseModuleWithOptions rigidLayout file+ let noOverlapInp = removeOverlap Silent inp+ refacts = (fmap . fmap . fmap) (toGhcSrcSpan file) <$> noOverlapInp++ posFilter (_, rs) =+ case optionsPos of+ Nothing -> True+ Just p -> any (flip spans p . pos) rs+ filtRefacts = filter posFilter refacts++ -- need a check here to avoid overlap+ (ares, res) <- return . flip evalState 0 $+ foldM (uncurry runRefactoring) (as, m) (concatMap snd filtRefacts)+ let output = runIdentity $ exactPrintWithOptions refactOptions res ares+ return output++data Verbosity = Silent | Normal | Loud deriving (Eq, Show, Ord)++-- Filters out overlapping ideas, picking the first idea in a set of overlapping ideas.+-- If two ideas start in the exact same place, pick the largest edit.+removeOverlap :: Verbosity -> [(String, [Refactoring R.SrcSpan])] -> [(String, [Refactoring R.SrcSpan])]+removeOverlap verb = dropOverlapping . sortBy f . summarize+ where+ -- We want to consider all Refactorings of a single idea as a unit, so compute a summary+ -- SrcSpan that encompasses all the Refactorings within each idea.+ summarize :: [(String, [Refactoring R.SrcSpan])] -> [(String, (R.SrcSpan, [Refactoring R.SrcSpan]))]+ summarize ideas = [ (s, (foldr1 summary (map pos rs), rs)) | (s, rs) <- ideas, not (null rs) ]++ summary (R.SrcSpan sl1 sc1 el1 ec1)+ (R.SrcSpan sl2 sc2 el2 ec2) =+ let (sl, sc) = case compare sl1 sl2 of+ LT -> (sl1, sc1)+ EQ -> (sl1, min sc1 sc2)+ GT -> (sl2, sc2)+ (el, ec) = case compare el1 el2 of+ LT -> (el2, ec2)+ EQ -> (el2, max ec1 ec2)+ GT -> (el1, ec1)+ in R.SrcSpan sl sc el ec++ -- Order by span start. If starting in same place, order by size.+ f (_,(s1,_)) (_,(s2,_)) =+ comparing startLine s1 s2 <> -- s1 first if it starts on earlier line+ comparing startCol s1 s2 <> -- or on earlier column+ comparing endLine s2 s1 <> -- they start in same place, s2 comes+ comparing endCol s2 s1 -- first if it ends later+ -- else, completely same span, so s1 will be first++ dropOverlapping [] = []+ dropOverlapping (p:ps) = go p ps+ go (s,(_,rs)) [] = [(s,rs)]+ go p@(s,(_,rs)) (x:xs)+ | p `overlaps` x = (if verb > Silent+ then trace ("Ignoring " ++ show (snd (snd x)) ++ " due to overlap.")+ else id) go p xs+ | otherwise = (s,rs) : go x xs+ -- for overlaps, we know s1 always starts <= s2, due to our sort+ overlaps (_,(s1,_)) (_,(s2,_)) =+ case compare (startLine s2) (endLine s1) of+ LT -> True+ EQ -> startCol s2 <= endCol s1+ GT -> False++-- --------------------------------------------------------------------- -- Perform the substitutions
src/Refact/Utils.hs view
@@ -145,6 +145,7 @@ replaceAnnKey a old new inp deltainfo = fromMaybe a (replace old new inp deltainfo a) + -- | Convert a @Refact.Types.SrcSpan@ to a @SrcLoc.SrcSpan@ toGhcSrcSpan :: FilePath -> R.SrcSpan -> SrcSpan toGhcSrcSpan file R.SrcSpan{..} = mkSrcSpan (f startLine startCol) (f endLine endCol)
tests/Test.hs view
@@ -8,6 +8,7 @@ import Options.Applicative import Main hiding (main)+import Refact.Apply import System.IO.Silently import System.IO