{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
module Ide.PluginUtils
  ( WithDeletions(..),
    getProcessID,
    normalize,
    makeDiffTextEdit,
    makeDiffTextEditAdditive,
    diffText,
    diffText',
    pluginDescToIdePlugins,
    responseError,
    getClientConfig,
    getPluginConfig,
    configForPlugin,
    pluginEnabled,
    extractRange,
    fullRange,
    mkLspCommand,
    mkLspCmdId,
  allLspCmdIds,allLspCmdIds',installSigUsr1Handler, subRange)
where


import           Data.Algorithm.Diff
import           Data.Algorithm.DiffOutput
import qualified Data.HashMap.Strict                     as H
import           Data.Maybe
import qualified Data.Text                               as T
import           Ide.Types
import           Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types              as J
import           Language.Haskell.LSP.Types.Capabilities

#ifdef mingw32_HOST_OS
import qualified System.Win32.Process                    as P (getCurrentProcessId)
#else
import           System.Posix.Signals
import qualified System.Posix.Process                    as P (getProcessID)
#endif
import qualified Data.Aeson                              as J
import qualified Data.Default
import qualified Data.Map.Strict                         as Map
import           Ide.Plugin.Config
import qualified Language.Haskell.LSP.Core               as LSP
import Control.Monad (void)

-- ---------------------------------------------------------------------


-- | Extend to the line below and above to replace newline character.

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

-- | Generate a 'WorkspaceEdit' value from a pair of source Text

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

    {-
      In order to replace everything including newline characters,
      the end range should extend below the last line. From the specification:
      "If you want to specify a range that contains a line including
      the line ending character(s) then use an end position denoting
      the start of the next line"
    -}
    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
    -- fm has a range wrt to the changed file, which starts in the current file at l + 1

    -- So the range has to be shifted to start at l + 1

      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 -- Note: zero-based lines

        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  -- Note: zero-based lines



-- | A pure version of 'diffText' for testing

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 TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit Maybe WorkspaceEditMap
forall a. Maybe a
Nothing (List TextDocumentEdit -> Maybe (List TextDocumentEdit)
forall a. a -> Maybe a
Just List TextDocumentEdit
docChanges)
    else Maybe WorkspaceEditMap
-> Maybe (List TextDocumentEdit) -> WorkspaceEdit
WorkspaceEdit (WorkspaceEditMap -> Maybe WorkspaceEditMap
forall a. a -> Maybe a
Just WorkspaceEditMap
h) Maybe (List TextDocumentEdit)
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 TextDocumentEdit
docChanges = [TextDocumentEdit] -> List TextDocumentEdit
forall a. [a] -> List a
J.List [TextDocumentEdit
docEdit]
    docEdit :: TextDocumentEdit
docEdit = VersionedTextDocumentIdentifier
-> List TextEdit -> TextDocumentEdit
J.TextDocumentEdit (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
J.VersionedTextDocumentIdentifier Uri
f (Int -> TextDocumentVersion
forall a. a -> Maybe a
Just Int
0)) 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 <- WorkspaceClientCapabilities
-> Maybe WorkspaceEditClientCapabilities
_workspaceEdit WorkspaceClientCapabilities
wCaps
        Maybe Bool
mDc
  in
    Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
supports

-- ---------------------------------------------------------------------


pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins [PluginDescriptor ideState]
plugins = Map PluginId (PluginDescriptor ideState) -> IdePlugins ideState
forall ideState.
Map PluginId (PluginDescriptor ideState) -> IdePlugins ideState
IdePlugins (Map PluginId (PluginDescriptor ideState) -> IdePlugins ideState)
-> Map PluginId (PluginDescriptor ideState) -> IdePlugins ideState
forall a b. (a -> b) -> a -> b
$ [(PluginId, PluginDescriptor ideState)]
-> Map PluginId (PluginDescriptor ideState)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(PluginId, PluginDescriptor ideState)]
 -> Map PluginId (PluginDescriptor ideState))
-> [(PluginId, PluginDescriptor ideState)]
-> Map PluginId (PluginDescriptor 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]
plugins


-- ---------------------------------------------------------------------


responseError :: T.Text -> ResponseError
responseError :: Text -> ResponseError
responseError Text
txt = ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InvalidParams Text
txt Maybe Value
forall a. Maybe a
Nothing


-- ---------------------------------------------------------------------

-- | Returns the current client configuration. It is not wise to permanently

-- cache the returned value of this function, as clients can at runitime change

-- their configuration.

--

-- If no custom configuration has been set by the client, this function returns

-- our own defaults.

getClientConfig :: LSP.LspFuncs Config -> IO Config
getClientConfig :: LspFuncs Config -> IO Config
getClientConfig LspFuncs Config
lf = Config -> Maybe Config -> Config
forall a. a -> Maybe a -> a
fromMaybe Config
forall a. Default a => a
Data.Default.def (Maybe Config -> Config) -> IO (Maybe Config) -> IO Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LspFuncs Config -> IO (Maybe Config)
forall c. LspFuncs c -> IO (Maybe c)
LSP.config LspFuncs Config
lf

-- ---------------------------------------------------------------------


-- | Returns the current plugin configuration. It is not wise to permanently

-- cache the returned value of this function, as clients can change their

-- configuration at runtime.

--

-- If no custom configuration has been set by the client, this function returns

-- our own defaults.

getPluginConfig :: LSP.LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig :: LspFuncs Config -> PluginId -> IO PluginConfig
getPluginConfig LspFuncs Config
lf PluginId
plugin = do
    Config
config <- LspFuncs Config -> IO Config
getClientConfig LspFuncs Config
lf
    PluginConfig -> IO PluginConfig
forall (m :: * -> *) a. Monad m => a -> m a
return (PluginConfig -> IO PluginConfig)
-> PluginConfig -> IO PluginConfig
forall a b. (a -> b) -> a -> b
$ Config -> PluginId -> PluginConfig
configForPlugin Config
config PluginId
plugin

configForPlugin :: Config -> PluginId -> PluginConfig
configForPlugin :: Config -> PluginId -> PluginConfig
configForPlugin Config
config (PluginId Text
plugin)
    = PluginConfig -> Text -> Map Text PluginConfig -> PluginConfig
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault PluginConfig
forall a. Default a => a
Data.Default.def Text
plugin (Config -> Map Text PluginConfig
plugins Config
config)

-- ---------------------------------------------------------------------


-- | Checks that a given plugin is both enabled and the specific feature is

-- enabled

pluginEnabled :: PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled :: PluginConfig -> (PluginConfig -> Bool) -> Bool
pluginEnabled PluginConfig
pluginConfig PluginConfig -> Bool
f = PluginConfig -> Bool
plcGlobalOn PluginConfig
pluginConfig Bool -> Bool -> Bool
&& PluginConfig -> Bool
f PluginConfig
pluginConfig

-- ---------------------------------------------------------------------


extractRange :: Range -> T.Text -> T.Text
extractRange :: Range -> Text -> Text
extractRange (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

-- | Gets the range that covers the entire text

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
        {-
        In order to replace everything including newline characters,
        the end range should extend below the last line. From the specification:
        "If you want to specify a range that contains a line including
        the line ending character(s) then use an end position denoting
        the start of the next line"
        -}
        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 ideState
mp = ([(PluginId, [PluginCommand ideState])] -> [Text])
-> (PluginDescriptor ideState -> Maybe [PluginCommand ideState])
-> [Text]
forall b t.
([(PluginId, b)] -> t)
-> (PluginDescriptor ideState -> Maybe b) -> t
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) = []

        ls :: [(PluginId, PluginDescriptor ideState)]
ls = Map PluginId (PluginDescriptor ideState)
-> [(PluginId, PluginDescriptor ideState)]
forall k a. Map k a -> [(k, a)]
Map.toList (IdePlugins ideState -> Map PluginId (PluginDescriptor ideState)
forall ideState.
IdePlugins ideState -> Map PluginId (PluginDescriptor ideState)
ipMap IdePlugins ideState
mp)

        mkPlugin :: ([(PluginId, b)] -> t)
-> (PluginDescriptor ideState -> Maybe b) -> t
mkPlugin [(PluginId, b)] -> t
maker PluginDescriptor ideState -> Maybe b
selector
            = [(PluginId, b)] -> t
maker ([(PluginId, b)] -> t) -> [(PluginId, b)] -> t
forall a b. (a -> b) -> a -> b
$ ((PluginId, PluginDescriptor ideState) -> [(PluginId, b)])
-> [(PluginId, PluginDescriptor ideState)] -> [(PluginId, b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(PluginId
pid, PluginDescriptor ideState
p) -> (PluginId, Maybe b) -> [(PluginId, b)]
forall a b. (a, Maybe b) -> [(a, b)]
justs (PluginId
pid, PluginDescriptor ideState -> Maybe b
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 = [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Text]] -> [Text]) -> [[Text]] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((PluginId, [PluginCommand ideState]) -> [Text])
-> [(PluginId, [PluginCommand ideState])] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (PluginId, [PluginCommand ideState]) -> [Text]
forall ideState. (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

mkLspCommand :: PluginId -> CommandId -> T.Text -> Maybe [J.Value] -> IO Command
mkLspCommand :: PluginId -> CommandId -> Text -> Maybe [Value] -> IO Command
mkLspCommand PluginId
plid CommandId
cn Text
title Maybe [Value]
args' = do
  Text
pid <- IO Text
getPid
  let cmdId :: Text
cmdId = Text -> PluginId -> CommandId -> Text
mkLspCmdId Text
pid PluginId
plid CommandId
cn
  let args :: Maybe (List Value)
args = [Value] -> List Value
forall a. [a] -> List a
List ([Value] -> List Value) -> Maybe [Value] -> Maybe (List Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Value]
args'
  Command -> IO Command
forall (m :: * -> *) a. Monad m => a -> m a
return (Command -> IO Command) -> Command -> IO Command
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe (List Value) -> Command
Command Text
title Text
cmdId Maybe (List Value)
args

mkLspCmdId :: T.Text -> PluginId -> CommandId -> T.Text
mkLspCmdId :: Text -> PluginId -> CommandId -> Text
mkLspCmdId Text
pid (PluginId Text
plid) (CommandId Text
cid)
  = Text
pid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
plid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cid

-- | Get the operating system process id for the running server

-- instance. This should be the same for the lifetime of the instance,

-- and different from that of any other currently running instance.

getPid :: IO T.Text
getPid :: IO Text
getPid = String -> Text
T.pack (String -> Text) -> (Int -> String) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> Text) -> IO Int -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Int
getProcessID

getProcessID :: IO Int
installSigUsr1Handler :: IO () -> IO ()

#ifdef mingw32_HOST_OS
getProcessID = fromIntegral <$> P.getCurrentProcessId
installSigUsr1Handler _ = return ()

#else
getProcessID :: IO Int
getProcessID = ProcessID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ProcessID -> Int) -> IO ProcessID -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProcessID
P.getProcessID

installSigUsr1Handler :: IO () -> IO ()
installSigUsr1Handler IO ()
h = IO Handler -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handler -> IO ()) -> IO Handler -> IO ()
forall a b. (a -> b) -> a -> b
$ Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sigUSR1 (IO () -> Handler
Catch IO ()
h) Maybe SignalSet
forall a. Maybe a
Nothing
#endif