{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Ide.PluginUtils
( WithDeletions(..),
getProcessID,
normalize,
makeDiffTextEdit,
makeDiffTextEditAdditive,
diffText,
diffText',
pluginDescToIdePlugins,
responseError,
getClientConfig,
getPluginConfig,
configForPlugin,
pluginEnabled,
extractRange,
fullRange,
mkLspCommand,
mkLspCmdId,
getPid,
allLspCmdIds,
allLspCmdIds',
installSigUsr1Handler,
subRange,
usePropertyLsp)
where
import Data.Algorithm.Diff
import Data.Algorithm.DiffOutput
import qualified Data.HashMap.Strict as H
import qualified Data.Text as T
import Ide.Types
import Language.LSP.Types
import qualified Language.LSP.Types as J
import Language.LSP.Types.Capabilities
import Data.Containers.ListUtils (nubOrdOn)
import Ide.Plugin.Config
import Ide.Plugin.Properties
import Language.LSP.Server
normalize :: Range -> Range
normalize :: Range -> Range
normalize (Range (Position Int
sl Int
_) (Position Int
el Int
_)) =
Position -> Position -> Range
Range (Int -> Int -> Position
Position Int
sl Int
0) (Int -> Int -> Position
Position (Int
el Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0)
data WithDeletions = IncludeDeletions | SkipDeletions
deriving WithDeletions -> WithDeletions -> Bool
(WithDeletions -> WithDeletions -> Bool)
-> (WithDeletions -> WithDeletions -> Bool) -> Eq WithDeletions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithDeletions -> WithDeletions -> Bool
$c/= :: WithDeletions -> WithDeletions -> Bool
== :: WithDeletions -> WithDeletions -> Bool
$c== :: WithDeletions -> WithDeletions -> Bool
Eq
diffText :: ClientCapabilities -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText :: ClientCapabilities
-> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText ClientCapabilities
clientCaps (Uri, Text)
old Text
new WithDeletions
withDeletions =
let
supports :: Bool
supports = ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
clientCaps
in Bool -> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText' Bool
supports (Uri, Text)
old Text
new WithDeletions
withDeletions
makeDiffTextEdit :: T.Text -> T.Text -> List TextEdit
makeDiffTextEdit :: Text -> Text -> List TextEdit
makeDiffTextEdit Text
f1 Text
f2 = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
f1 Text
f2 WithDeletions
IncludeDeletions
makeDiffTextEditAdditive :: T.Text -> T.Text -> List TextEdit
makeDiffTextEditAdditive :: Text -> Text -> List TextEdit
makeDiffTextEditAdditive Text
f1 Text
f2 = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
f1 Text
f2 WithDeletions
SkipDeletions
diffTextEdit :: T.Text -> T.Text -> WithDeletions -> List TextEdit
diffTextEdit :: Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions = [TextEdit] -> List TextEdit
forall a. [a] -> List a
J.List [TextEdit]
r
where
r :: [TextEdit]
r = (DiffOperation LineRange -> TextEdit)
-> [DiffOperation LineRange] -> [TextEdit]
forall a b. (a -> b) -> [a] -> [b]
map DiffOperation LineRange -> TextEdit
diffOperationToTextEdit [DiffOperation LineRange]
diffOps
d :: [Diff [String]]
d = [String] -> [String] -> [Diff [String]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fText) (String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
f2Text)
diffOps :: [DiffOperation LineRange]
diffOps = (DiffOperation LineRange -> Bool)
-> [DiffOperation LineRange] -> [DiffOperation LineRange]
forall a. (a -> Bool) -> [a] -> [a]
filter (\DiffOperation LineRange
x -> (WithDeletions
withDeletions WithDeletions -> WithDeletions -> Bool
forall a. Eq a => a -> a -> Bool
== WithDeletions
IncludeDeletions) Bool -> Bool -> Bool
|| Bool -> Bool
not (DiffOperation LineRange -> Bool
forall a. DiffOperation a -> Bool
isDeletion DiffOperation LineRange
x))
([Diff [String]] -> [DiffOperation LineRange]
diffToLineRanges [Diff [String]]
d)
isDeletion :: DiffOperation a -> Bool
isDeletion (Deletion a
_ Int
_) = Bool
True
isDeletion DiffOperation a
_ = Bool
False
diffOperationToTextEdit :: DiffOperation LineRange -> J.TextEdit
diffOperationToTextEdit :: DiffOperation LineRange -> TextEdit
diffOperationToTextEdit (Change LineRange
fm LineRange
to) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
nt
where
range :: Range
range = LineRange -> Range
calcRange LineRange
fm
nt :: Text
nt = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
init (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
to
diffOperationToTextEdit (Deletion (LineRange (Int
sl, Int
el) [String]
_) Int
_) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
""
where
range :: Range
range = Position -> Position -> Range
J.Range (Int -> Int -> Position
J.Position (Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
0)
(Int -> Int -> Position
J.Position Int
el Int
0)
diffOperationToTextEdit (Addition LineRange
fm Int
l) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
nt
where
range :: Range
range = Position -> Position -> Range
J.Range (Int -> Int -> Position
J.Position Int
l Int
0)
(Int -> Int -> Position
J.Position Int
l Int
0)
nt :: Text
nt = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
fm
calcRange :: LineRange -> Range
calcRange LineRange
fm = Position -> Position -> Range
J.Range Position
s Position
e
where
sl :: Int
sl = (Int, Int) -> Int
forall a b. (a, b) -> a
fst ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ LineRange -> (Int, Int)
lrNumbers LineRange
fm
sc :: Int
sc = Int
0
s :: Position
s = Int -> Int -> Position
J.Position (Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
sc
el :: Int
el = (Int, Int) -> Int
forall a b. (a, b) -> b
snd ((Int, Int) -> Int) -> (Int, Int) -> Int
forall a b. (a -> b) -> a -> b
$ LineRange -> (Int, Int)
lrNumbers LineRange
fm
ec :: Int
ec = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
last ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ LineRange -> [String]
lrContents LineRange
fm
e :: Position
e = Int -> Int -> Position
J.Position (Int
el Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int
ec
diffText' :: Bool -> (Uri,T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText' :: Bool -> (Uri, Text) -> Text -> WithDeletions -> WorkspaceEdit
diffText' Bool
supports (Uri
f,Text
fText) Text
f2Text WithDeletions
withDeletions =
if Bool
supports
then Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing (List DocumentChange -> Maybe (List DocumentChange)
forall a. a -> Maybe a
Just List DocumentChange
docChanges) Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
else Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just WorkspaceEditMap
h) Maybe (List DocumentChange)
forall a. Maybe a
Nothing Maybe ChangeAnnotationMap
forall a. Maybe a
Nothing
where
diff :: List TextEdit
diff = Text -> Text -> WithDeletions -> List TextEdit
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions
h :: WorkspaceEditMap
h = Uri -> List TextEdit -> WorkspaceEditMap
forall k v. Hashable k => k -> v -> HashMap k v
H.singleton Uri
f List TextEdit
diff
docChanges :: List DocumentChange
docChanges = [DocumentChange] -> List DocumentChange
forall a. [a] -> List a
J.List [TextDocumentEdit -> DocumentChange
forall a b. a -> a |? b
InL TextDocumentEdit
docEdit]
docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
J.TextDocumentEdit (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier Uri
f (Int -> TextDocumentVersion
forall a. a -> Maybe a
Just Int
0)) (List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit)
-> List (TextEdit |? AnnotatedTextEdit) -> TextDocumentEdit
forall a b. (a -> b) -> a -> b
$ (TextEdit -> TextEdit |? AnnotatedTextEdit)
-> List TextEdit -> List (TextEdit |? AnnotatedTextEdit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL List TextEdit
diff
clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
caps =
let ClientCapabilities Maybe WorkspaceClientCapabilities
mwCaps Maybe TextDocumentClientCapabilities
_ Maybe WindowClientCapabilities
_ Maybe Object
_ = ClientCapabilities
caps
supports :: Maybe Bool
supports = do
WorkspaceClientCapabilities
wCaps <- Maybe WorkspaceClientCapabilities
mwCaps
WorkspaceEditClientCapabilities Maybe Bool
mDc Maybe (List ResourceOperationKind)
_ Maybe FailureHandlingKind
_ Maybe Bool
_ Maybe WorkspaceEditChangeAnnotationClientCapabilities
_ <- WorkspaceClientCapabilities
-> Maybe WorkspaceEditClientCapabilities
_workspaceEdit WorkspaceClientCapabilities
wCaps
Maybe Bool
mDc
in
Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Bool
supports
pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins [PluginDescriptor ideState]
plugins =
[(PluginId, PluginDescriptor ideState)] -> IdePlugins ideState
forall ideState.
[(PluginId, PluginDescriptor ideState)] -> IdePlugins ideState
IdePlugins ([(PluginId, PluginDescriptor ideState)] -> IdePlugins ideState)
-> [(PluginId, PluginDescriptor ideState)] -> IdePlugins ideState
forall a b. (a -> b) -> a -> b
$ (PluginDescriptor ideState
-> (PluginId, PluginDescriptor ideState))
-> [PluginDescriptor ideState]
-> [(PluginId, PluginDescriptor ideState)]
forall a b. (a -> b) -> [a] -> [b]
map (\PluginDescriptor ideState
p -> (PluginDescriptor ideState -> PluginId
forall ideState. PluginDescriptor ideState -> PluginId
pluginId PluginDescriptor ideState
p, PluginDescriptor ideState
p)) ([PluginDescriptor ideState]
-> [(PluginId, PluginDescriptor ideState)])
-> [PluginDescriptor ideState]
-> [(PluginId, PluginDescriptor ideState)]
forall a b. (a -> b) -> a -> b
$ (PluginDescriptor ideState -> PluginId)
-> [PluginDescriptor ideState] -> [PluginDescriptor ideState]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn PluginDescriptor ideState -> PluginId
forall ideState. PluginDescriptor ideState -> PluginId
pluginId [PluginDescriptor ideState]
plugins
getClientConfig :: MonadLsp Config m => m Config
getClientConfig :: m Config
getClientConfig = m Config
forall config (m :: * -> *). MonadLsp config m => m config
getConfig
getPluginConfig :: MonadLsp Config m => PluginId -> m PluginConfig
getPluginConfig :: PluginId -> m PluginConfig
getPluginConfig PluginId
plugin = do
Config
config <- m Config
forall (m :: * -> *). MonadLsp Config m => m Config
getClientConfig
PluginConfig -> m PluginConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (PluginConfig -> m PluginConfig) -> PluginConfig -> m PluginConfig
forall a b. (a -> b) -> a -> b
$ (Config -> PluginId -> PluginConfig)
-> PluginId -> Config -> PluginConfig
forall a b c. (a -> b -> c) -> b -> a -> c
flip Config -> PluginId -> PluginConfig
configForPlugin PluginId
plugin Config
config
usePropertyLsp ::
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s ->
PluginId ->
Properties r ->
m (ToHsType t)
usePropertyLsp :: KeyNameProxy s -> PluginId -> Properties r -> m (ToHsType t)
usePropertyLsp KeyNameProxy s
kn PluginId
pId Properties r
p = do
PluginConfig
config <- PluginId -> m PluginConfig
forall (m :: * -> *).
MonadLsp Config m =>
PluginId -> m PluginConfig
getPluginConfig PluginId
pId
ToHsType t -> m (ToHsType t)
forall (m :: * -> *) a. Monad m => a -> m a
return (ToHsType t -> m (ToHsType t)) -> ToHsType t -> m (ToHsType t)
forall a b. (a -> b) -> a -> b
$ KeyNameProxy s -> Properties r -> Object -> ToHsType t
forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
(r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> Properties r -> Object -> ToHsType t
useProperty KeyNameProxy s
kn Properties r
p (Object -> ToHsType t) -> Object -> ToHsType t
forall a b. (a -> b) -> a -> b
$ PluginConfig -> Object
plcConfig PluginConfig
config
extractRange :: Range -> T.Text -> T.Text
(Range (Position Int
sl Int
_) (Position Int
el Int
_)) Text
s = Text
newS
where focusLines :: [Text]
focusLines = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (Int
elInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
slInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
sl ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
newS :: Text
newS = [Text] -> Text
T.unlines [Text]
focusLines
fullRange :: T.Text -> Range
fullRange :: Text -> Range
fullRange Text
s = Position -> Position -> Range
Range Position
startPos Position
endPos
where startPos :: Position
startPos = Int -> Int -> Position
Position Int
0 Int
0
endPos :: Position
endPos = Int -> Int -> Position
Position Int
lastLine Int
0
lastLine :: Int
lastLine = [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
s
subRange :: Range -> Range -> Bool
subRange :: Range -> Range -> Bool
subRange Range
smallRange Range
range =
Position -> Range -> Bool
positionInRange (Range -> Position
_start Range
smallRange) Range
range
Bool -> Bool -> Bool
&& Position -> Range -> Bool
positionInRange (Range -> Position
_end Range
smallRange) Range
range
positionInRange :: Position -> Range -> Bool
positionInRange :: Position -> Range -> Bool
positionInRange (Position Int
pl Int
po) (Range (Position Int
sl Int
so) (Position Int
el Int
eo)) =
Int
pl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
sl Bool -> Bool -> Bool
&& Int
pl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
el
Bool -> Bool -> Bool
|| Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
so Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
eo
Bool -> Bool -> Bool
|| Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sl Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
so
Bool -> Bool -> Bool
|| Int
pl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
el Bool -> Bool -> Bool
&& Int
po Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
eo
allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text]
allLspCmdIds' :: Text -> IdePlugins ideState -> [Text]
allLspCmdIds' Text
pid (IdePlugins [(PluginId, PluginDescriptor ideState)]
ls) = ([(PluginId, [PluginCommand ideState])] -> [Text])
-> (PluginDescriptor ideState -> Maybe [PluginCommand ideState])
-> [Text]
mkPlugin (Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
forall ideState.
Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
allLspCmdIds Text
pid) ([PluginCommand ideState] -> Maybe [PluginCommand ideState]
forall a. a -> Maybe a
Just ([PluginCommand ideState] -> Maybe [PluginCommand ideState])
-> (PluginDescriptor ideState -> [PluginCommand ideState])
-> PluginDescriptor ideState
-> Maybe [PluginCommand ideState]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginDescriptor ideState -> [PluginCommand ideState]
forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginCommands)
where
justs :: (a, Maybe b) -> [(a, b)]
justs (a
p, Just b
x) = [(a
p, b
x)]
justs (a
_, Maybe b
Nothing) = []
mkPlugin :: ([(PluginId, [PluginCommand ideState])] -> [Text])
-> (PluginDescriptor ideState -> Maybe [PluginCommand ideState])
-> [Text]
mkPlugin [(PluginId, [PluginCommand ideState])] -> [Text]
maker PluginDescriptor ideState -> Maybe [PluginCommand ideState]
selector
= [(PluginId, [PluginCommand ideState])] -> [Text]
maker ([(PluginId, [PluginCommand ideState])] -> [Text])
-> [(PluginId, [PluginCommand ideState])] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((PluginId, PluginDescriptor ideState)
-> [(PluginId, [PluginCommand ideState])])
-> [(PluginId, PluginDescriptor ideState)]
-> [(PluginId, [PluginCommand ideState])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(PluginId
pid, PluginDescriptor ideState
p) -> (PluginId, Maybe [PluginCommand ideState])
-> [(PluginId, [PluginCommand ideState])]
forall a b. (a, Maybe b) -> [(a, b)]
justs (PluginId
pid, PluginDescriptor ideState -> Maybe [PluginCommand ideState]
selector PluginDescriptor ideState
p)) [(PluginId, PluginDescriptor ideState)]
ls
allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text]
allLspCmdIds :: Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
allLspCmdIds Text
pid [(PluginId, [PluginCommand ideState])]
commands = ((PluginId, [PluginCommand ideState]) -> [Text])
-> [(PluginId, [PluginCommand ideState])] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (PluginId, [PluginCommand ideState]) -> [Text]
go [(PluginId, [PluginCommand ideState])]
commands
where
go :: (PluginId, [PluginCommand ideState]) -> [Text]
go (PluginId
plid, [PluginCommand ideState]
cmds) = (PluginCommand ideState -> Text)
-> [PluginCommand ideState] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> PluginId -> CommandId -> Text
mkLspCmdId Text
pid PluginId
plid (CommandId -> Text)
-> (PluginCommand ideState -> CommandId)
-> PluginCommand ideState
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PluginCommand ideState -> CommandId
forall ideState. PluginCommand ideState -> CommandId
commandId) [PluginCommand ideState]
cmds