Can use apply-refact without worrying about stdio

This commit is contained in:
Alan Zimmerman 2015-12-15 15:57:39 +02:00
parent 3ce3b5212c
commit 8425de6ffa
4 changed files with 48 additions and 19 deletions

View File

@ -5,6 +5,7 @@ module Haskell.Ide.ApplyRefactPlugin where
import Control.Exception
import Control.Monad.IO.Class
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Vinyl
import Haskell.Ide.Engine.MonadFunctions
import Haskell.Ide.Engine.PluginDescriptor
@ -12,6 +13,10 @@ import Haskell.Ide.Engine.PluginUtils
import Haskell.Ide.Engine.SemanticTypes
import qualified Language.Haskell.GhcMod as GM (defaultOptions)
import Language.Haskell.HLint
import Language.Haskell.HLint3
import Refact.Apply
import qualified Refact.Types as R
import Refact.Types hiding (SrcSpan)
import System.Directory
import System.Exit
import System.FilePath.Posix
@ -46,6 +51,7 @@ applyOneCmd = CmdSync $ \_ctxs req -> do
Left err -> return err
Right (ParamFile fileName :& ParamPos pos :& RNil) -> do
res <- liftIO $ applyHint (T.unpack fileName) (Just pos)
logm $ "applyOneCmd:res=" ++ show res
case res of
Left err -> return $ IdeResponseFail (IdeError PluginError
(T.pack $ "applyOne: " ++ show err) Nothing)
@ -62,6 +68,7 @@ applyAllCmd = CmdSync $ \_ctxs req -> do
Left err -> return err
Right (ParamFile fileName :& RNil) -> do
res <- liftIO $ applyHint (T.unpack fileName) Nothing
logm $ "applyAllCmd:res=" ++ show res
case res of
Left err -> return $ IdeResponseFail (IdeError PluginError
(T.pack $ "applyOne: " ++ show err) Nothing)
@ -83,25 +90,36 @@ applyHint file mpos = do
opts = case mpos of
Nothing -> optsf
Just (r,c) -> optsf ++ " --pos " ++ show r ++ "," ++ show c
let hlintOpts = [file, "--refactor", "--refactor-options=" ++ opts ]
-- let hlintOpts = [file, "--quiet", "--refactor", "--refactor-options=" ++ opts ]
let hlintOpts = [file, "--quiet" ]
logm $ "applyHint=" ++ show hlintOpts
res <- catchException $ hlint hlintOpts
logm $ "applyHint:res=" ++ show res
-- res <- hlint hlintOpts
case res of
Left "ExitSuccess" -> do
diff <- makeDiffResult file f
Left x -> return $ Left (show x)
Right x -> do
let commands = makeApplyRefact x
logm $ "applyHint:commands=" ++ show commands
appliedFile <- applyRefactorings mpos commands file
diff <- makeDiffResult file (T.pack appliedFile)
logm $ "applyHint:diff=" ++ show diff
return $ Right diff
Left x -> return $ Left (show x)
Right x -> return $ Left (show x)
-- ---------------------------------------------------------------------
makeDiffResult :: FilePath -> FilePath -> IO HieDiff
makeApplyRefact :: [Suggestion] -> [(String, [Refactoring R.SrcSpan])]
makeApplyRefact suggestions =
map (\(Suggestion i) -> (show i, ideaRefactoring i)) suggestions
-- ---------------------------------------------------------------------
makeDiffResult :: FilePath -> T.Text -> IO HieDiff
makeDiffResult orig new = do
(HieDiff f s d) <- diffFiles orig new
origText <- T.readFile orig
let (HieDiff f s d) = diffText (orig,origText) ("changed",new)
f' <- liftIO $ makeRelativeToCurrentDirectory f
s' <- liftIO $ makeRelativeToCurrentDirectory s
-- return (HieDiff f' s' d)
return (HieDiff f' "changed" d)

View File

@ -23,6 +23,7 @@ library
, ghc-mod
, hie-plugin-api
, hlint
, refact
, text
, transformers
, vinyl >= 0.5 && < 0.6

View File

@ -8,6 +8,7 @@ module Haskell.Ide.Engine.PluginUtils
getParams
, mapEithers
, diffFiles
, diffText
-- * Helper functions for errors
, missingParameter
, incorrectParameter
@ -89,11 +90,16 @@ diffFiles :: FilePath -> FilePath -> IO HieDiff
diffFiles f1 f2 = do
f1Text <- T.readFile f1
f2Text <- T.readFile f2
let diffb = getDiffBy (\(_,a) (_,b) -> a == b)
(zip [1..] (T.lines f1Text))
(zip [1..] (T.lines f2Text))
isDiff (Both {}) = False
isDiff _ = True
return $ diffText (f1,f1Text) (f2,f2Text)
diff = filter isDiff diffb
return (HieDiff f1 f2 diff)
-- |Generate a 'HieDiff' value from a pair of source Text
diffText :: (FilePath,T.Text) -> (FilePath,T.Text) -> HieDiff
diffText (f1,f1Text) (f2,f2Text) = HieDiff f1 f2 diff
where
diffb = getDiffBy (\(_,a) (_,b) -> a == b)
(zip [1..] (T.lines f1Text))
(zip [1..] (T.lines f2Text))
isDiff (Both {}) = False
isDiff _ = True
diff = filter isDiff diffb

View File

@ -14,10 +14,14 @@ packages:
commit: b9bd4ebf77b22d2d9061d647d7799ddcc7c51228
# commit: bff86be69f556f80a8dcd9dd42774ab77cb00eba
extra-dep: true
# - location:
# git: https://github.com/alanz/hlint.git
# commit: 6fb531d5ba32a4ba0e1a1c189e5f81ac7c43803f
# extra-dep: true
- location:
git: https://github.com/alanz/hlint.git
commit: e32f4d3cf32d15003e54d4f42afae7bf06b50168
extra-dep: true
- location:
git: https://github.com/alanz/apply-refact.git
commit: ba98a2902e5333519e60d38803f30f82c44eaffc
extra-dep: true
extra-deps:
- HaRe-0.8.2.1
- rosezipper-0.2