diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,7 @@ +v0.2 + + * API refactoring to make the tool usable as a library. + v0.1 * Initial Release diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 @@ -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 = 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.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 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -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 diff --git a/src/Refact/Apply.hs b/src/Refact/Apply.hs --- a/src/Refact/Apply.hs +++ b/src/Refact/Apply.hs @@ -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 diff --git a/src/Refact/Utils.hs b/src/Refact/Utils.hs --- a/src/Refact/Utils.hs +++ b/src/Refact/Utils.hs @@ -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) diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -8,6 +8,7 @@ import Options.Applicative import Main hiding (main) +import Refact.Apply import System.IO.Silently import System.IO