mirror of
https://github.com/haskell/haskell-ide-engine.git
synced 2024-10-26 11:18:42 +03:00
Merge branch 'master' of https://github.com/haskell/haskell-ide-engine into import-code-actions
This commit is contained in:
commit
d7b41e104b
@ -197,9 +197,9 @@ failModule fp err = do
|
||||
modifyCache (\gmc ->
|
||||
gmc {
|
||||
uriCaches = Map.insert fp' (UriCacheFailed err) (uriCaches gmc)
|
||||
}
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
-- Fail the queued actions
|
||||
runDeferredActions fp' (Left err)
|
||||
|
||||
|
@ -7,6 +7,9 @@ module Haskell.Ide.Engine.Plugin.GhcMod where
|
||||
|
||||
import Bag
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Lens.Getter ((^.))
|
||||
import Control.Lens.Setter ((%~))
|
||||
import Control.Lens.Traversal (traverseOf)
|
||||
import Data.Aeson
|
||||
#if __GLASGOW_HASKELL__ < 802
|
||||
import Data.Aeson.Types
|
||||
@ -20,6 +23,7 @@ import Data.Monoid
|
||||
#endif
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as T
|
||||
import DynFlags
|
||||
import ErrUtils
|
||||
import qualified Exception as G
|
||||
@ -35,11 +39,13 @@ import qualified GhcMod.Monad as GM
|
||||
import qualified GhcMod.SrcUtils as GM
|
||||
import qualified GhcMod.Types as GM
|
||||
import qualified GhcMod.Utils as GM
|
||||
import qualified GhcMod.Exe.CaseSplit as GM
|
||||
import Haskell.Ide.Engine.MonadFunctions
|
||||
import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import Haskell.Ide.Engine.ArtifactMap
|
||||
import HscTypes
|
||||
import qualified Language.Haskell.LSP.Types as LSP
|
||||
import TcRnTypes
|
||||
import Outputable (renderWithStyle, mkUserStyle, Depth(..))
|
||||
|
||||
@ -57,6 +63,7 @@ ghcmodDescriptor = PluginDescriptor
|
||||
, PluginCommand "lint" "Check files using `hlint'" lintCmd
|
||||
, PluginCommand "info" "Look up an identifier in the context of FILE (like ghci's `:info')" infoCmd
|
||||
, PluginCommand "type" "Get the type of the expression under (LINE,COL)" typeCmd
|
||||
, PluginCommand "casesplit" "Generate a pattern match for a binding under (LINE,COL)" splitCaseCmd
|
||||
]
|
||||
}
|
||||
|
||||
@ -184,7 +191,7 @@ setTypecheckedModule uri =
|
||||
case mtm of
|
||||
Nothing -> do
|
||||
debugm $ "setTypecheckedModule: Didn't get typechecked module for: " ++ show fp
|
||||
|
||||
|
||||
failModule fp (T.unlines errs)
|
||||
|
||||
return $ IdeResultOk (diags,errs)
|
||||
@ -290,6 +297,69 @@ cmp a b
|
||||
isSubRangeOf :: Range -> Range -> Bool
|
||||
isSubRangeOf (Range sa ea) (Range sb eb) = sb <= sa && eb >= ea
|
||||
|
||||
|
||||
splitCaseCmd :: CommandFunc LSP.TextDocumentPositionParams WorkspaceEdit
|
||||
splitCaseCmd = CmdSync $ \posParams -> do
|
||||
splitCaseCmd' (posParams ^. LSP.textDocument . LSP.uri) (posParams ^. LSP.position)
|
||||
|
||||
splitCaseCmd' :: Uri -> Position -> IdeGhcM (IdeResult WorkspaceEdit)
|
||||
splitCaseCmd' uri newPos =
|
||||
pluginGetFile "splitCaseCmd: " uri $ \path -> do
|
||||
origText <- GM.withMappedFile path $ liftIO . T.readFile
|
||||
cachedMod <- getCachedModule path
|
||||
case cachedMod of
|
||||
ModuleCached checkedModule _ ->
|
||||
runGhcModCommand $
|
||||
case newPosToOld checkedModule newPos of
|
||||
Just oldPos -> do
|
||||
let (line, column) = unPos oldPos
|
||||
splitResult' <- GM.splits' path (tcMod checkedModule) line column
|
||||
case splitResult' of
|
||||
Just splitResult -> return
|
||||
$ oldToNewPositions checkedModule
|
||||
$ splitResultToWorkspaceEdit origText splitResult
|
||||
Nothing -> return mempty
|
||||
Nothing -> return mempty
|
||||
ModuleFailed errText -> return $ IdeResultFail $ IdeError PluginError (T.append "hie-ghc-mod: " errText) Null
|
||||
ModuleLoading -> return $ IdeResultOk mempty
|
||||
where
|
||||
|
||||
-- | Transform all ranges in a WorkspaceEdit from old to new positions.
|
||||
oldToNewPositions :: CachedModule -> WorkspaceEdit -> WorkspaceEdit
|
||||
oldToNewPositions cMod wsEdit =
|
||||
wsEdit
|
||||
& LSP.documentChanges %~ (>>= traverseOf (traverse . LSP.edits . traverse . LSP.range) (oldRangeToNew cMod))
|
||||
& LSP.changes %~ (>>= traverseOf (traverse . traverse . LSP.range) (oldRangeToNew cMod))
|
||||
|
||||
-- | Given the range and text to replace, construct a 'WorkspaceEdit'
|
||||
-- by diffing the change against the current text.
|
||||
splitResultToWorkspaceEdit :: T.Text -> GM.SplitResult -> WorkspaceEdit
|
||||
splitResultToWorkspaceEdit originalText (GM.SplitResult replaceFromLine replaceFromCol replaceToLine replaceToCol replaceWith) =
|
||||
diffText (uri, originalText) newText
|
||||
where
|
||||
before = takeUntil (toPos (replaceFromLine, replaceFromCol)) originalText
|
||||
after = dropUntil (toPos (replaceToLine, replaceToCol)) originalText
|
||||
newText = before <> replaceWith <> after
|
||||
|
||||
-- | Take the first part of text until the given position.
|
||||
-- Returns all characters before the position.
|
||||
takeUntil :: Position -> T.Text -> T.Text
|
||||
takeUntil (Position l c) txt =
|
||||
T.unlines takeLines <> takeCharacters
|
||||
where
|
||||
textLines = T.lines txt
|
||||
takeLines = take l textLines
|
||||
takeCharacters = T.take c (textLines !! c)
|
||||
|
||||
-- | Drop the first part of text until the given position.
|
||||
-- Returns all characters after and including the position.
|
||||
dropUntil :: Position -> T.Text -> T.Text
|
||||
dropUntil (Position l c) txt = dropCharacters
|
||||
where
|
||||
textLines = T.lines txt
|
||||
dropLines = drop l textLines
|
||||
dropCharacters = T.drop c (T.unlines dropLines)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
runGhcModCommand :: IdeGhcM a
|
||||
|
@ -3,6 +3,7 @@
|
||||
module GhcModPluginSpec where
|
||||
|
||||
import Control.Exception
|
||||
import qualified Data.HashMap.Strict as H
|
||||
import qualified Data.Map as Map
|
||||
#if __GLASGOW_HASKELL__ < 804
|
||||
import Data.Monoid
|
||||
@ -13,6 +14,7 @@ import Haskell.Ide.Engine.MonadTypes
|
||||
import Haskell.Ide.Engine.PluginDescriptor
|
||||
import Haskell.Ide.Engine.PluginUtils
|
||||
import Haskell.Ide.Engine.Plugin.GhcMod
|
||||
import Language.Haskell.LSP.Types (TextEdit(..), TextDocumentPositionParams(..), TextDocumentIdentifier(..))
|
||||
import System.Directory
|
||||
import TestUtils
|
||||
|
||||
@ -35,9 +37,8 @@ testPlugins = pluginDescToIdePlugins [("ghcmod",ghcmodDescriptor)]
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
ghcmodSpec :: Spec
|
||||
ghcmodSpec = do
|
||||
describe "ghc-mod plugin commands" $ do
|
||||
|
||||
ghcmodSpec =
|
||||
describe "ghc-mod plugin commands(old plugin api)" $ do
|
||||
it "runs the check command" $ cdAndDo "./test/testdata" $ do
|
||||
fp <- makeAbsolute "./FileWithWarning.hs"
|
||||
let act = setTypecheckedModule arg
|
||||
@ -115,3 +116,36 @@ ghcmodSpec = do
|
||||
testCommand testPlugins act "ghcmod" "type" arg res
|
||||
|
||||
-- ---------------------------------
|
||||
|
||||
it "runs the casesplit command" $ cdAndDo "./test/testdata" $ do
|
||||
fp <- makeAbsolute "GhcModCaseSplit.hs"
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
splitCaseCmd' uri (toPos (5,5))
|
||||
arg = TextDocumentPositionParams (TextDocumentIdentifier uri) (toPos (5,5))
|
||||
res = IdeResultOk $ WorkspaceEdit
|
||||
(Just $ H.singleton uri
|
||||
$ List [TextEdit (Range (Position 4 0) (Position 4 10))
|
||||
"foo Nothing = ()\nfoo (Just x) = ()"])
|
||||
Nothing
|
||||
testCommand testPlugins act "ghcmod" "casesplit" arg res
|
||||
|
||||
it "runs the casesplit command with an absolute path from another folder, correct params" $ do
|
||||
fp <- makeAbsolute "./test/testdata/GhcModCaseSplit.hs"
|
||||
cd <- getCurrentDirectory
|
||||
cd2 <- getHomeDirectory
|
||||
bracket (setCurrentDirectory cd2)
|
||||
(\_-> setCurrentDirectory cd)
|
||||
$ \_-> do
|
||||
let uri = filePathToUri fp
|
||||
act = do
|
||||
_ <- setTypecheckedModule uri
|
||||
splitCaseCmd' uri (toPos (5,5))
|
||||
arg = TextDocumentPositionParams (TextDocumentIdentifier uri) (toPos (5,5))
|
||||
res = IdeResultOk $ WorkspaceEdit
|
||||
(Just $ H.singleton uri
|
||||
$ List [TextEdit (Range (Position 4 0) (Position 4 10))
|
||||
"foo Nothing = ()\nfoo (Just x) = ()"])
|
||||
Nothing
|
||||
testCommand testPlugins act "ghcmod" "casesplit" arg res
|
||||
|
5
test/testdata/GhcModCaseSplit.hs
vendored
Normal file
5
test/testdata/GhcModCaseSplit.hs
vendored
Normal file
@ -0,0 +1,5 @@
|
||||
|
||||
main = putStrLn "hello"
|
||||
|
||||
foo :: Maybe Int -> ()
|
||||
foo x = ()
|
Loading…
Reference in New Issue
Block a user