packages feed

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 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