Can use apply-refact without worrying about stdio

Author: alanz

hie-apply-refact/Haskell/Ide/ApplyRefactPlugin.hs

@@ -5,13 +5,18 @@ 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
 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)
 

hie-apply-refact/hie-apply-refact.cabal

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

hie-plugin-api/Haskell/Ide/Engine/PluginUtils.hs

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

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