{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}
module Ide.PluginUtils
  ( WithDeletions(..),
    getProcessID,
    normalize,
    makeDiffTextEdit,
    makeDiffTextEditAdditive,
    diffText,
    diffText',
    pluginDescToIdePlugins,
    idePluginsToPluginDesc,
    responseError,
    getClientConfig,
    getPluginConfig,
    configForPlugin,
    pluginEnabled,
    extractRange,
    fullRange,
    mkLspCommand,
    mkLspCmdId,
    getPid,
    allLspCmdIds,
    allLspCmdIds',
    installSigUsr1Handler,
    subRange,
    positionInRange,
    usePropertyLsp,
    getNormalizedFilePath,
    response,
    handleMaybe,
    handleMaybeM,
    )
where


import           Control.Lens                    ((^.))
import           Control.Monad.Extra             (maybeM)
import           Control.Monad.Trans.Class       (lift)
import           Control.Monad.Trans.Except      (ExceptT, runExceptT, throwE)
import           Data.Algorithm.Diff
import           Data.Algorithm.DiffOutput
import           Data.Bifunctor                  (Bifunctor (first))
import           Data.Containers.ListUtils       (nubOrdOn)
import qualified Data.HashMap.Strict             as H
import           Data.String                     (IsString (fromString))
import qualified Data.Text                       as T
import           Ide.Plugin.Config
import           Ide.Plugin.Properties
import           Ide.Types
import           Language.LSP.Server
import           Language.LSP.Types              hiding
                                                 (SemanticTokenAbsolute (length, line),
                                                  SemanticTokenRelative (length),
                                                  SemanticTokensEdit (_start))
import qualified Language.LSP.Types              as J
import           Language.LSP.Types.Capabilities
import           Language.LSP.Types.Lens         (uri)

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

-- | Extend to the line below and above to replace newline character.
normalize :: Range -> Range
normalize :: Range -> Range
normalize (Range (Position UInt
sl UInt
_) (Position UInt
el UInt
_)) =
  Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
sl UInt
0) (UInt -> UInt -> Position
Position (UInt
el UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) UInt
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
_ LineNo
_) = 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 (LineNo
sl, LineNo
el) [String]
_) LineNo
_) = Range -> Text -> TextEdit
J.TextEdit Range
range Text
""
      where
        range :: Range
range = Position -> Position -> Range
J.Range (UInt -> UInt -> Position
J.Position (LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LineNo -> UInt) -> LineNo -> UInt
forall a b. (a -> b) -> a -> b
$ LineNo
sl LineNo -> LineNo -> LineNo
forall a. Num a => a -> a -> a
- LineNo
1) UInt
0)
                        (UInt -> UInt -> Position
J.Position (LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral LineNo
el) UInt
0)

    diffOperationToTextEdit (Addition LineRange
fm LineNo
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 (UInt -> UInt -> Position
J.Position (LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral LineNo
l) UInt
0)
                        (UInt -> UInt -> Position
J.Position (LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral LineNo
l) UInt
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 :: LineNo
sl = (LineNo, LineNo) -> LineNo
forall a b. (a, b) -> a
fst ((LineNo, LineNo) -> LineNo) -> (LineNo, LineNo) -> LineNo
forall a b. (a -> b) -> a -> b
$ LineRange -> (LineNo, LineNo)
lrNumbers LineRange
fm
        sc :: UInt
sc = UInt
0
        s :: Position
s = UInt -> UInt -> Position
J.Position (LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LineNo -> UInt) -> LineNo -> UInt
forall a b. (a -> b) -> a -> b
$ LineNo
sl LineNo -> LineNo -> LineNo
forall a. Num a => a -> a -> a
- LineNo
1) UInt
sc -- Note: zero-based lines
        el :: LineNo
el = (LineNo, LineNo) -> LineNo
forall a b. (a, b) -> b
snd ((LineNo, LineNo) -> LineNo) -> (LineNo, LineNo) -> LineNo
forall a b. (a -> b) -> a -> b
$ LineRange -> (LineNo, LineNo)
lrNumbers LineRange
fm
        ec :: UInt
ec = LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LineNo -> UInt) -> LineNo -> UInt
forall a b. (a -> b) -> a -> b
$ String -> LineNo
forall (t :: * -> *) a. Foldable t => t a -> LineNo
length (String -> LineNo) -> String -> LineNo
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 = UInt -> UInt -> Position
J.Position (LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LineNo -> UInt) -> LineNo -> UInt
forall a b. (a -> b) -> a -> b
$ LineNo
el LineNo -> LineNo -> LineNo
forall a. Num a => a -> a -> a
- LineNo
1) UInt
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 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 (Int32 -> TextDocumentVersion
forall a. a -> Maybe a
Just Int32
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 GeneralClientCapabilities
_ 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

idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
idePluginsToPluginDesc (IdePlugins [(PluginId, PluginDescriptor ideState)]
pp) = ((PluginId, PluginDescriptor ideState)
 -> PluginDescriptor ideState)
-> [(PluginId, PluginDescriptor ideState)]
-> [PluginDescriptor ideState]
forall a b. (a -> b) -> [a] -> [b]
map (PluginId, PluginDescriptor ideState) -> PluginDescriptor ideState
forall a b. (a, b) -> b
snd [(PluginId, PluginDescriptor ideState)]
pp

-- ---------------------------------------------------------------------
-- | 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.
--
getClientConfig :: MonadLsp Config m => m Config
getClientConfig :: m Config
getClientConfig = m Config
forall config (m :: * -> *). MonadLsp config m => m config
getConfig

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

-- | 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.
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
configForPlugin Config
config PluginId
plugin

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

-- | Returns the value of a property defined by the current plugin.
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
extractRange :: Range -> Text -> Text
extractRange (Range (Position UInt
sl UInt
_) (Position UInt
el UInt
_)) Text
s = Text
newS
  where focusLines :: [Text]
focusLines = LineNo -> [Text] -> [Text]
forall a. LineNo -> [a] -> [a]
take (UInt -> LineNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> LineNo) -> UInt -> LineNo
forall a b. (a -> b) -> a -> b
$ UInt
elUInt -> UInt -> UInt
forall a. Num a => a -> a -> a
-UInt
slUInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+UInt
1) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ LineNo -> [Text] -> [Text]
forall a. LineNo -> [a] -> [a]
drop (UInt -> LineNo
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
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 = UInt -> UInt -> Position
Position UInt
0 UInt
0
        endPos :: Position
endPos = UInt -> UInt -> Position
Position UInt
lastLine UInt
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 :: UInt
lastLine = LineNo -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (LineNo -> UInt) -> LineNo -> UInt
forall a b. (a -> b) -> a -> b
$ [Text] -> LineNo
forall (t :: * -> *) a. Foldable t => t a -> LineNo
length ([Text] -> LineNo) -> [Text] -> LineNo
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
p (Range Position
sp Position
ep) = Position
sp Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
p Bool -> Bool -> Bool
&& Position
p Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
<= Position
ep

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

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

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

getNormalizedFilePath :: Monad m => PluginId -> TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
getNormalizedFilePath :: PluginId
-> TextDocumentIdentifier -> ExceptT String m NormalizedFilePath
getNormalizedFilePath (PluginId Text
plId) TextDocumentIdentifier
docId = String
-> Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath
forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe String
errMsg
        (Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath)
-> Maybe NormalizedFilePath -> ExceptT String m NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath
        (NormalizedUri -> Maybe NormalizedFilePath)
-> NormalizedUri -> Maybe NormalizedFilePath
forall a b. (a -> b) -> a -> b
$ Uri -> NormalizedUri
toNormalizedUri Uri
uri'
    where
        errMsg :: String
errMsg = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
"Error(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
plId Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"): converting " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Uri -> Text
getUri Uri
uri' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to NormalizedFilePath"
        uri' :: Uri
uri' = TextDocumentIdentifier
docId TextDocumentIdentifier
-> Getting Uri TextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri TextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
uri

-- ---------------------------------------------------------------------
handleMaybe :: Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe :: e -> Maybe b -> ExceptT e m b
handleMaybe e
msg = ExceptT e m b -> (b -> ExceptT e m b) -> Maybe b -> ExceptT e m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) b -> ExceptT e m b
forall (m :: * -> *) a. Monad m => a -> m a
return

handleMaybeM :: Monad m => e -> m (Maybe b) -> ExceptT e m b
handleMaybeM :: e -> m (Maybe b) -> ExceptT e m b
handleMaybeM e
msg m (Maybe b)
act = ExceptT e m b
-> (b -> ExceptT e m b) -> ExceptT e m (Maybe b) -> ExceptT e m b
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM (e -> ExceptT e m b
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE e
msg) b -> ExceptT e m b
forall (m :: * -> *) a. Monad m => a -> m a
return (ExceptT e m (Maybe b) -> ExceptT e m b)
-> ExceptT e m (Maybe b) -> ExceptT e m b
forall a b. (a -> b) -> a -> b
$ m (Maybe b) -> ExceptT e m (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Maybe b)
act

response :: Monad m => ExceptT String m a -> m (Either ResponseError a)
response :: ExceptT String m a -> m (Either ResponseError a)
response =
  (Either String a -> Either ResponseError a)
-> m (Either String a) -> m (Either ResponseError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> ResponseError)
-> Either String a -> Either ResponseError a
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
msg -> ErrorCode -> Text -> Maybe Value -> ResponseError
ResponseError ErrorCode
InternalError (String -> Text
forall a. IsString a => String -> a
fromString String
msg) Maybe Value
forall a. Maybe a
Nothing))
    (m (Either String a) -> m (Either ResponseError a))
-> (ExceptT String m a -> m (Either String a))
-> ExceptT String m a
-> m (Either ResponseError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String m a -> m (Either String a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT