Add the rest of the commands to HaRe plugin

Closes #36

.gitignore

@@ -33,3 +33,6 @@ cabal.sandbox.config
 dist/
 tags
 /test/testdata/HaReRename.refactored.hs
+/test/testdata/HaReCase.refactored.hs
+/test/testdata/HaReDemote.refactored.hs
+/test/testdata/HaReMoveDef.refactored.hs

haskell-ide-plugin-api/Haskell/Ide/Engine/PluginDescriptor.hs

@@ -198,7 +198,7 @@ data IdeResponse = IdeResponseOk    Value    -- ^ Command Succeeded
                                              -- haskell-ide-engine
                                              -- driver. Equivalent to HTTP 500
                                              -- status
-                 deriving (Show,Generic)
+                 deriving (Show,Generic,Eq)
 
 -- | Error codes. Add as required
 data IdeErrorCode = IncorrectParameterType  -- ^ Wrong parameter type

haskell-ide-plugin-hare/Haskell/Ide/HaRePlugin.hs

@@ -21,6 +21,56 @@ hareDescriptor = PluginDescriptor
     pdCommands =
       [
         Command
+          { cmdDesc = CommandDesc
+                     { cmdName = "demote"
+                     , cmdUiDescription = "Move a definition one level down"
+                     , cmdFileExtensions = [".hs"]
+                     , cmdContexts = [CtxPoint]
+                     , cmdAdditionalParams = []
+                     }
+          , cmdFunc = demoteCmd
+          }
+      , Command
+          { cmdDesc = CommandDesc
+                     { cmdName = "dupdef"
+                     , cmdUiDescription = "Duplicate a definition"
+                     , cmdFileExtensions = [".hs"]
+                     , cmdContexts = [CtxPoint]
+                     , cmdAdditionalParams = [RP "name" "the new name" PtText]
+                     }
+          , cmdFunc = dupdefCmd
+          }
+      , Command
+          { cmdDesc = CommandDesc
+                     { cmdName = "iftocase"
+                     , cmdUiDescription = "Converts an if statement to a case statement"
+                     , cmdFileExtensions = [".hs"]
+                     , cmdContexts = [CtxRegion]
+                     , cmdAdditionalParams = []
+                     }
+          , cmdFunc = ifToCaseCmd
+          }
+      , Command
+          { cmdDesc = CommandDesc
+                     { cmdName = "liftOneLevel"
+                     , cmdUiDescription = "Move a definition one level up from where it is now"
+                     , cmdFileExtensions = [".hs"]
+                     , cmdContexts = [CtxPoint]
+                     , cmdAdditionalParams = []
+                     }
+          , cmdFunc = liftOneLevelCmd
+          }
+      , Command
+          { cmdDesc = CommandDesc
+                     { cmdName = "liftToTopLevel"
+                     , cmdUiDescription = "Move a definition to the top level from where it is now"
+                     , cmdFileExtensions = [".hs"]
+                     , cmdContexts = [CtxPoint]
+                     , cmdAdditionalParams = []
+                     }
+          , cmdFunc = liftToTopLevelCmd
+          }
+      , Command
           { cmdDesc = CommandDesc
                      { cmdName = "rename"
                      , cmdUiDescription = "rename a variable or type"
@@ -37,6 +87,101 @@ hareDescriptor = PluginDescriptor
 
 -- ---------------------------------------------------------------------
 
+demoteCmd :: CommandFunc
+demoteCmd _ctxs req = do
+  case getParams (IdFile "file" :& IdPos "start_pos" :& RNil) req of
+    Left err -> return err
+    Right (ParamFile fileName :& ParamPos pos :& RNil) -> do
+      res <- liftIO $ catchException $ demote defaultSettings GM.defaultOptions (T.unpack fileName) pos
+      case res of
+        Left err -> return $ IdeResponseFail (IdeError PluginError
+                      (T.pack $ "demote: " ++ show err) Nothing)
+        Right fs -> do
+          fs' <- liftIO $ mapM makeRelativeToCurrentDirectory fs
+          return (IdeResponseOk (toJSON fs'))
+    Right _ -> return $ IdeResponseError (IdeError InternalError
+      "HaRePlugin.demoteCmd: ghc’s exhaustiveness checker is broken" Nothing)
+
+-- demote :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
+
+-- ---------------------------------------------------------------------
+
+dupdefCmd :: CommandFunc
+dupdefCmd _ctxs req = do
+  case getParams (IdFile "file" :& IdPos "start_pos" :& IdText "name" :& RNil) req of
+    Left err -> return err
+    Right (ParamFile fileName :& ParamPos pos :& ParamText name :& RNil) -> do
+      res <- liftIO $ catchException $ duplicateDef defaultSettings GM.defaultOptions (T.unpack fileName) (T.unpack name) pos
+      case res of
+        Left err -> return $ IdeResponseFail (IdeError PluginError
+                      (T.pack $ "dupdef: " ++ show err) Nothing)
+        Right fs -> do
+          fs' <- liftIO $ mapM makeRelativeToCurrentDirectory fs
+          return (IdeResponseOk (toJSON fs'))
+    Right _ -> return $ IdeResponseError (IdeError InternalError
+      "HaRePlugin.dupdefCmd: ghc’s exhaustiveness checker is broken" Nothing)
+
+-- duplicateDef :: RefactSettings -> GM.Options -> FilePath -> String -> SimpPos -> IO [FilePath]
+
+-- ---------------------------------------------------------------------
+
+ifToCaseCmd :: CommandFunc
+ifToCaseCmd _ctxs req = do
+  case getParams (IdFile "file" :& IdPos "start_pos" :& IdPos "end_pos" :& RNil) req of
+    Left err -> return err
+    Right (ParamFile fileName :& ParamPos start :& ParamPos end :& RNil) -> do
+      res <- liftIO $ catchException $ ifToCase defaultSettings GM.defaultOptions (T.unpack fileName) start end
+      case res of
+        Left err -> return $ IdeResponseFail (IdeError PluginError
+                      (T.pack $ "ifToCase: " ++ show err) Nothing)
+        Right fs -> do
+          fs' <- liftIO $ mapM makeRelativeToCurrentDirectory fs
+          return (IdeResponseOk (toJSON fs'))
+    Right _ -> return $ IdeResponseError (IdeError InternalError
+      "HaRePlugin.ifToCaseCmd: ghc’s exhaustiveness checker is broken" Nothing)
+
+-- ifToCase :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> SimpPos -> IO [FilePath]
+
+-- ---------------------------------------------------------------------
+
+liftOneLevelCmd :: CommandFunc
+liftOneLevelCmd _ctxs req = do
+  case getParams (IdFile "file" :& IdPos "start_pos" :& RNil) req of
+    Left err -> return err
+    Right (ParamFile fileName :& ParamPos pos :& RNil) -> do
+      res <- liftIO $ catchException $ liftOneLevel defaultSettings GM.defaultOptions (T.unpack fileName) pos
+      case res of
+        Left err -> return $ IdeResponseFail (IdeError PluginError
+                      (T.pack $ "liftOneLevel: " ++ show err) Nothing)
+        Right fs -> do
+          fs' <- liftIO $ mapM makeRelativeToCurrentDirectory fs
+          return (IdeResponseOk (toJSON fs'))
+    Right _ -> return $ IdeResponseError (IdeError InternalError
+      "HaRePlugin.liftOneLevel: ghc’s exhaustiveness checker is broken" Nothing)
+
+-- liftOneLevel :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
+
+-- ---------------------------------------------------------------------
+
+liftToTopLevelCmd :: CommandFunc
+liftToTopLevelCmd _ctxs req = do
+  case getParams (IdFile "file" :& IdPos "start_pos" :& RNil) req of
+    Left err -> return err
+    Right (ParamFile fileName :& ParamPos pos :& RNil) -> do
+      res <- liftIO $ catchException $ liftToTopLevel defaultSettings GM.defaultOptions (T.unpack fileName) pos
+      case res of
+        Left err -> return $ IdeResponseFail (IdeError PluginError
+                      (T.pack $ "liftToTopLevel: " ++ show err) Nothing)
+        Right fs -> do
+          fs' <- liftIO $ mapM makeRelativeToCurrentDirectory fs
+          return (IdeResponseOk (toJSON fs'))
+    Right _ -> return $ IdeResponseError (IdeError InternalError
+      "HaRePlugin.liftToTopLevel: ghc’s exhaustiveness checker is broken" Nothing)
+
+-- liftToTopLevel :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]
+
+-- ---------------------------------------------------------------------
+
 renameCmd :: CommandFunc
 renameCmd _ctxs req = do
   case getParams (IdFile "file" :& IdPos "start_pos" :& IdText "name" :& RNil) req of

test/HaRePluginSpec.hs

@@ -1,14 +1,16 @@
 {-# LANGUAGE OverloadedStrings #-}
 module HaRePluginSpec where
 
--- import           Control.Logging
--- import           Data.Aeson
+import           Control.Concurrent
+import           Control.Logging
+import           Data.Aeson
+import qualified Data.Map as Map
+import           Haskell.Ide.Engine.Dispatcher
 import           Haskell.Ide.Engine.Monad
 import           Haskell.Ide.Engine.PluginDescriptor
+import           Haskell.Ide.Engine.Types
 import           Haskell.Ide.HaRePlugin
 
-import qualified Data.Map as Map
-
 import           Test.Hspec
 
 -- ---------------------------------------------------------------------
@@ -28,20 +30,85 @@ spec = do
 
 -- ---------------------------------------------------------------------
 
+testPlugins :: Plugins
+testPlugins = Map.fromList [("hare",hareDescriptor)]
+
+-- TODO: break this out into a TestUtils file
+dispatchRequest :: IdeRequest -> IO IdeResponse
+dispatchRequest req = do
+  testChan <- newChan
+  let cr = CReq "hare" 1 req testChan
+  r <- withStdoutLogging $ runIdeM (IdeState Map.empty) (doDispatch testPlugins cr)
+  return r
+
+-- ---------------------------------------------------------------------
+
 hareSpec :: Spec
 hareSpec = do
   describe "hare plugin commands" $ do
+    -- ---------------------------------
     it "renames" $ do
+
       let req = IdeRequest "rename" (Map.fromList [("file",ParamValP $ ParamFile "./test/testdata/HaReRename.hs")
                                                   ,("start_pos",ParamValP $ ParamPos (5,1))
                                                   ,("name",ParamValP $ ParamText "foolong")])
-      r <- runIdeM (IdeState Map.empty) (renameCmd [] req)
-      (show r) `shouldBe` "IdeResponseOk (Array [String \"test/testdata/HaReRename.hs\"])"
+      r <- dispatchRequest req
+      r `shouldBe` IdeResponseOk (toJSON [String "test/testdata/HaReRename.hs"])
+
+    -- ---------------------------------
 
     it "returns an error for invalid rename" $ do
       let req = IdeRequest "rename" (Map.fromList [("file",ParamValP $ ParamFile "./test/testdata/HaReRename.hs")
                                                   ,("start_pos",ParamValP $ ParamPos (15,1))
                                                   ,("name",ParamValP $ ParamText "foolong")])
-      r <- runIdeM (IdeState Map.empty) (renameCmd [] req)
-      (show r) `shouldBe`
-        "IdeResponseFail (IdeError {ideCode = PluginError, ideMessage = \"rename: \\\"Invalid cursor position!\\\"\", ideInfo = Nothing})"
+      r <- dispatchRequest req
+      r `shouldBe` IdeResponseFail (IdeError { ideCode = PluginError
+                                             , ideMessage = "rename: \"Invalid cursor position!\"", ideInfo = Nothing})
+
+    -- ---------------------------------
+
+    it "demotes" $ do
+      let req = IdeRequest "demote" (Map.fromList [("file",ParamValP $ ParamFile "./test/testdata/HaReDemote.hs")
+                                                  ,("start_pos",ParamValP $ ParamPos (6,1))])
+      r <- dispatchRequest req
+      r `shouldBe` IdeResponseOk (toJSON [String "test/testdata/HaReDemote.hs"])
+
+    -- ---------------------------------
+
+    it "duplicates a definition" $ do
+
+      let req = IdeRequest "dupdef" (Map.fromList [("file",ParamValP $ ParamFile "./test/testdata/HaReRename.hs")
+                                                  ,("start_pos",ParamValP $ ParamPos (5,1))
+                                                  ,("name",ParamValP $ ParamText "foonew")])
+      r <- dispatchRequest req
+      r `shouldBe` IdeResponseOk (toJSON [String "test/testdata/HaReRename.hs"])
+
+    -- ---------------------------------
+
+    it "converts if to case" $ do
+
+      let req = IdeRequest "iftocase" (Map.fromList [("file",ParamValP $ ParamFile "./test/testdata/HaReCase.hs")
+                                                    ,("start_pos",ParamValP $ ParamPos (5,9))
+                                                    ,("end_pos",  ParamValP $ ParamPos (9,12))])
+      r <- dispatchRequest req
+      r `shouldBe` IdeResponseOk (toJSON [String "test/testdata/HaReCase.hs"])
+
+    -- ---------------------------------
+
+    it "lifts one level" $ do
+
+      let req = IdeRequest "liftOneLevel" (Map.fromList [("file",ParamValP $ ParamFile "./test/testdata/HaReMoveDef.hs")
+                                                    ,("start_pos",ParamValP $ ParamPos (6,5))])
+      r <- dispatchRequest req
+      r `shouldBe` IdeResponseOk (toJSON [String "test/testdata/HaReMoveDef.hs"])
+
+    -- ---------------------------------
+
+    it "lifts to top level" $ do
+
+      let req = IdeRequest "liftToTopLevel" (Map.fromList [("file",ParamValP $ ParamFile "./test/testdata/HaReMoveDef.hs")
+                                                          ,("start_pos",ParamValP $ ParamPos (12,9))])
+      r <- dispatchRequest req
+      r `shouldBe` IdeResponseOk (toJSON [String "test/testdata/HaReMoveDef.hs"])
+
+    -- ---------------------------------

test/testdata/HaReCase.hs

@@ -0,0 +1,10 @@
+
+main = putStrLn "hello"
+
+foo :: Int -> Int
+foo x = if odd x
+        then
+          x + 3
+        else
+          x
+

test/testdata/HaReDemote.hs

@@ -0,0 +1,6 @@
+
+main = putStrLn "hello"
+
+foo x = y + 3
+
+y = 7

test/testdata/HaReMoveDef.hs

@@ -0,0 +1,14 @@
+
+main = putStrLn "hello"
+
+lifting x = x + y
+  where
+    y = 4
+
+liftToTop x = x + y
+  where
+    y = z + 4
+      where
+        z = 7
+
+