mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-09-11 11:05:30 +03:00
Can use apply-refact without worrying about stdio
This commit is contained in:
parent
3ce3b5212c
commit
8425de6ffa
@ -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)
|
||||
|
||||
|
@ -23,6 +23,7 @@ library
|
||||
, ghc-mod
|
||||
, hie-plugin-api
|
||||
, hlint
|
||||
, refact
|
||||
, text
|
||||
, transformers
|
||||
, vinyl >= 0.5 && < 0.6
|
||||
|
@ -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
|
||||
|
12
stack.yaml
12
stack.yaml
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user