{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}

module Ide.PluginUtils
  ( -- * LSP Range manipulation functions
    normalize,
    extendNextLine,
    extendLineStart,
    extendToFullLines,
    WithDeletions(..),
    getProcessID,
    makeDiffTextEdit,
    makeDiffTextEditAdditive,
    diffText,
    diffText',
    pluginDescToIdePlugins,
    idePluginsToPluginDesc,
    getClientConfig,
    getPluginConfig,
    configForPlugin,
    handlesRequest,
    extractTextInRange,
    fullRange,
    mkLspCommand,
    mkLspCmdId,
    getPid,
    allLspCmdIds,
    allLspCmdIds',
    installSigUsr1Handler,
    subRange,
    positionInRange,
    usePropertyLsp,
    -- * Escape
    unescape,
    -- * toAbsolute
    toAbsolute
  )
where

import           Control.Arrow               ((&&&))
import           Control.Lens                (_head, _last, re, (%~), (^.))
import           Data.Algorithm.Diff
import           Data.Algorithm.DiffOutput
import           Data.Char                   (isPrint, showLitChar)
import           Data.Functor                (void)
import qualified Data.Map                    as M
import qualified Data.Text                   as T
import           Data.Void                   (Void)
import           Ide.Plugin.Config
import           Ide.Plugin.Properties
import           Ide.Types
import qualified Language.LSP.Protocol.Lens  as L
import           Language.LSP.Protocol.Types
import           Language.LSP.Server
import           System.FilePath             ((</>))
import qualified Text.Megaparsec             as P
import qualified Text.Megaparsec.Char        as P
import qualified Text.Megaparsec.Char.Lexer  as P

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

-- | Extend to the line below and above to replace newline character.
--
-- >>> normalize (Range (Position 5 5) (Position 5 10))
-- Range (Position 5 0) (Position 6 0)
normalize :: Range -> Range
normalize :: Range -> Range
normalize = Range -> Range
extendLineStart (Range -> Range) -> (Range -> Range) -> Range -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Range
extendNextLine

-- | Extend 'Range' to the start of the next line.
--
-- >>> extendNextLine (Range (Position 5 5) (Position 5 10))
-- Range (Position 5 5) (Position 6 0)
extendNextLine :: Range -> Range
extendNextLine :: Range -> Range
extendNextLine (Range Position
s (Position UInt
el UInt
_)) =
  Position -> Position -> Range
Range Position
s (UInt -> UInt -> Position
Position (UInt
el UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1) UInt
0)

-- | Extend 'Range' to the start of the current line.
--
-- >>> extendLineStart (Range (Position 5 5) (Position 5 10))
-- Range (Position 5 0) (Position 5 10)
extendLineStart :: Range -> Range
extendLineStart :: Range -> Range
extendLineStart (Range (Position UInt
sl UInt
_) Position
e) =
  Position -> Position -> Range
Range (UInt -> UInt -> Position
Position UInt
sl UInt
0) Position
e

-- | Extend 'Range' to include the start of the first line and start of the next line of the last line.
--
-- Caveat: It always extend the last line to the beginning of next line, even when the last position is at column 0.
-- This is to keep the compatibility with the implementation of old function @extractRange@.
--
-- >>> extendToFullLines (Range (Position 5 5) (Position 5 10))
-- Range (Position 5 0) (Position 6 0)
--
-- >>> extendToFullLines (Range (Position 5 5) (Position 7 2))
-- Range (Position 5 0) (Position 8 0)
--
-- >>> extendToFullLines (Range (Position 5 5) (Position 7 0))
-- Range (Position 5 0) (Position 8 0)
extendToFullLines :: Range -> Range
extendToFullLines :: Range -> Range
extendToFullLines = Range -> Range
extendLineStart (Range -> Range) -> (Range -> Range) -> Range -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Range
extendNextLine


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

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
$c== :: WithDeletions -> WithDeletions -> Bool
== :: WithDeletions -> WithDeletions -> Bool
$c/= :: WithDeletions -> WithDeletions -> Bool
/= :: WithDeletions -> WithDeletions -> Bool
Eq)

-- | Generate a 'WorkspaceEdit' value from a pair of source Text
diffText :: ClientCapabilities -> (VersionedTextDocumentIdentifier, T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText :: ClientCapabilities
-> (VersionedTextDocumentIdentifier, Text)
-> Text
-> WithDeletions
-> WorkspaceEdit
diffText ClientCapabilities
clientCaps (VersionedTextDocumentIdentifier, Text)
old Text
new WithDeletions
withDeletions =
  let supports :: Bool
supports = ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
clientCaps
   in Bool
-> (VersionedTextDocumentIdentifier, Text)
-> Text
-> WithDeletions
-> WorkspaceEdit
diffText' Bool
supports (VersionedTextDocumentIdentifier, Text)
old Text
new WithDeletions
withDeletions

makeDiffTextEdit :: T.Text -> T.Text -> [TextEdit]
makeDiffTextEdit :: Text -> Text -> [TextEdit]
makeDiffTextEdit Text
f1 Text
f2 = Text -> Text -> WithDeletions -> [TextEdit]
diffTextEdit Text
f1 Text
f2 WithDeletions
IncludeDeletions

makeDiffTextEditAdditive :: T.Text -> T.Text -> [TextEdit]
makeDiffTextEditAdditive :: Text -> Text -> [TextEdit]
makeDiffTextEditAdditive Text
f1 Text
f2 = Text -> Text -> WithDeletions -> [TextEdit]
diffTextEdit Text
f1 Text
f2 WithDeletions
SkipDeletions

diffTextEdit :: T.Text -> T.Text -> WithDeletions -> [TextEdit]
diffTextEdit :: Text -> Text -> WithDeletions -> [TextEdit]
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions = [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 -> TextEdit
    diffOperationToTextEdit :: DiffOperation LineRange -> TextEdit
diffOperationToTextEdit (Change LineRange
fm LineRange
to) = Range -> Text -> TextEdit
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. HasCallStack => [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
TextEdit Range
range Text
""
      where
        range :: Range
range =
          Position -> Position -> Range
Range
            (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) UInt
0)
            (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
el) UInt
0)
    diffOperationToTextEdit (Addition LineRange
fm Int
l) = Range -> Text -> TextEdit
TextEdit Range
range Text
nt
      where
        -- 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

        range :: Range
range =
          Position -> Position -> Range
Range
            (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l) UInt
0)
            (UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
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
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 :: UInt
sc = UInt
0
        s :: Position
s = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Int
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) UInt
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 :: UInt
ec = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> 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. HasCallStack => [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
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Int
el Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) UInt
ec -- Note: zero-based lines

-- | A pure version of 'diffText' for testing
diffText' :: Bool -> (VersionedTextDocumentIdentifier, T.Text) -> T.Text -> WithDeletions -> WorkspaceEdit
diffText' :: Bool
-> (VersionedTextDocumentIdentifier, Text)
-> Text
-> WithDeletions
-> WorkspaceEdit
diffText' Bool
supports (VersionedTextDocumentIdentifier
verTxtDocId, Text
fText) Text
f2Text WithDeletions
withDeletions =
  if Bool
supports
    then Maybe (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit Maybe (Map Uri [TextEdit])
forall a. Maybe a
Nothing ([TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. a -> Maybe a
Just [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
docChanges) Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
    else Maybe (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (Map Uri [TextEdit] -> Maybe (Map Uri [TextEdit])
forall a. a -> Maybe a
Just Map Uri [TextEdit]
h) Maybe
  [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
forall a. Maybe a
Nothing Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
forall a. Maybe a
Nothing
  where
    diff :: [TextEdit]
diff = Text -> Text -> WithDeletions -> [TextEdit]
diffTextEdit Text
fText Text
f2Text WithDeletions
withDeletions
    h :: Map Uri [TextEdit]
h = Uri -> [TextEdit] -> Map Uri [TextEdit]
forall k a. k -> a -> Map k a
M.singleton (VersionedTextDocumentIdentifier
verTxtDocId VersionedTextDocumentIdentifier
-> Getting Uri VersionedTextDocumentIdentifier Uri -> Uri
forall s a. s -> Getting a s a -> a
^. Getting Uri VersionedTextDocumentIdentifier Uri
forall s a. HasUri s a => Lens' s a
Lens' VersionedTextDocumentIdentifier Uri
L.uri) [TextEdit]
diff
    docChanges :: [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
docChanges = [TextDocumentEdit
-> TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))
forall a b. a -> a |? b
InL TextDocumentEdit
docEdit]
    docEdit :: TextDocumentEdit
docEdit = OptionalVersionedTextDocumentIdentifier
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
TextDocumentEdit (VersionedTextDocumentIdentifier
verTxtDocId VersionedTextDocumentIdentifier
-> Getting
     OptionalVersionedTextDocumentIdentifier
     VersionedTextDocumentIdentifier
     OptionalVersionedTextDocumentIdentifier
-> OptionalVersionedTextDocumentIdentifier
forall s a. s -> Getting a s a -> a
^. AReview
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
-> Getter
     VersionedTextDocumentIdentifier
     OptionalVersionedTextDocumentIdentifier
forall t b. AReview t b -> Getter b t
re AReview
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
Prism'
  OptionalVersionedTextDocumentIdentifier
  VersionedTextDocumentIdentifier
_versionedTextDocumentIdentifier) ([TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit)
-> [TextEdit |? AnnotatedTextEdit] -> TextDocumentEdit
forall a b. (a -> b) -> a -> b
$ (TextEdit -> TextEdit |? AnnotatedTextEdit)
-> [TextEdit] -> [TextEdit |? AnnotatedTextEdit]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextEdit -> TextEdit |? AnnotatedTextEdit
forall a b. a -> a |? b
InL [TextEdit]
diff

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

clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges :: ClientCapabilities -> Bool
clientSupportsDocumentChanges ClientCapabilities
caps =
  let ClientCapabilities Maybe WorkspaceClientCapabilities
mwCaps Maybe TextDocumentClientCapabilities
_ Maybe NotebookDocumentClientCapabilities
_ Maybe WindowClientCapabilities
_ Maybe GeneralClientCapabilities
_ Maybe Value
_ = ClientCapabilities
caps
      supports :: Maybe Bool
supports = do
        WorkspaceClientCapabilities
wCaps <- Maybe WorkspaceClientCapabilities
mwCaps
        WorkspaceEditClientCapabilities Maybe Bool
mDc Maybe [ResourceOperationKind]
_ Maybe FailureHandlingKind
_ Maybe Bool
_ Maybe ChangeAnnotationsSupportOptions
_ <- 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 :: forall ideState. [PluginDescriptor ideState] -> IdePlugins ideState
pluginDescToIdePlugins = [PluginDescriptor ideState] -> IdePlugins ideState
forall ideState. [PluginDescriptor ideState] -> IdePlugins ideState
IdePlugins

idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
idePluginsToPluginDesc :: forall ideState. IdePlugins ideState -> [PluginDescriptor ideState]
idePluginsToPluginDesc (IdePlugins [PluginDescriptor ideState]
pp) = [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 runtime change
-- their configuration.
getClientConfig :: (MonadLsp Config m) => m Config
getClientConfig :: forall (m :: * -> *). MonadLsp Config m => 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) => PluginDescriptor c -> m PluginConfig
getPluginConfig :: forall (m :: * -> *) c.
MonadLsp Config m =>
PluginDescriptor c -> m PluginConfig
getPluginConfig PluginDescriptor c
plugin = do
  Config
config <- m Config
forall (m :: * -> *). MonadLsp Config m => m Config
getClientConfig
  PluginConfig -> m PluginConfig
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PluginConfig -> m PluginConfig) -> PluginConfig -> m PluginConfig
forall a b. (a -> b) -> a -> b
$ Config -> PluginDescriptor c -> PluginConfig
forall c. Config -> PluginDescriptor c -> PluginConfig
configForPlugin Config
config PluginDescriptor c
plugin

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

-- | Returns the value of a property defined by the current plugin.
usePropertyLsp ::
  (HasProperty s k t r, MonadLsp Config m) =>
  KeyNameProxy s ->
  PluginDescriptor c ->
  Properties r ->
  m (ToHsType t)
usePropertyLsp :: forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]) (m :: * -> *) c.
(HasProperty s k t r, MonadLsp Config m) =>
KeyNameProxy s
-> PluginDescriptor c -> Properties r -> m (ToHsType t)
usePropertyLsp KeyNameProxy s
kn PluginDescriptor c
pId Properties r
p = do
  PluginConfig
config <- PluginDescriptor c -> m PluginConfig
forall (m :: * -> *) c.
MonadLsp Config m =>
PluginDescriptor c -> m PluginConfig
getPluginConfig PluginDescriptor c
pId
  ToHsType t -> m (ToHsType t)
forall a. a -> m a
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

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

-- | Extracts exact matching text in the range.
extractTextInRange :: Range -> T.Text -> T.Text
extractTextInRange :: Range -> Text -> Text
extractTextInRange (Range (Position UInt
sl UInt
sc) (Position UInt
el UInt
ec)) Text
s = Text
newS
  where
    focusLines :: [Text]
focusLines =
      Text -> [Text]
T.lines Text
s
        -- NOTE: Always append an empty line to the end to ensure there are
        -- sufficient lines to take from.
        --
        -- There is a situation that when the end position is placed at the line
        -- below the last line, if we simply do `drop` and then `take`, there
        -- will be `el - sl` lines left, not `el - sl + 1` lines. And then
        -- the last line of code will be emptied unexpectedly.
        --
        -- For details, see https://github.com/haskell/haskell-language-server/issues/3847
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& ([Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
""])
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sl)
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
el UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
- UInt
sl UInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+ UInt
1)
    -- NOTE: We have to trim the last line first to handle the single-line case
    newS :: Text
newS =
      [Text]
focusLines
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> [Text] -> Identity [Text]
forall s a. Snoc s s a a => Traversal' s a
Traversal' [Text] Text
_last ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Text -> Text
T.take (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
ec)
        [Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text) -> [Text] -> Identity [Text]
forall s a. Cons s s a a => Traversal' s a
Traversal' [Text] Text
_head ((Text -> Identity Text) -> [Text] -> Identity [Text])
-> (Text -> Text) -> [Text] -> [Text]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Text -> Text
T.drop (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
sc)
        -- NOTE: We cannot use unlines here, because we don't want to add trailing newline!
        [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Text
T.intercalate Text
"\n"

-- | 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 = Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ [Text] -> Int
forall a. [a] -> 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 -> Range -> Bool
isSubrangeOf

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

allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text]
allLspCmdIds' :: forall ideState. Text -> IdePlugins ideState -> [Text]
allLspCmdIds' Text
pid (IdePlugins [PluginDescriptor ideState]
ls) =
  Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
forall ideState.
Text -> [(PluginId, [PluginCommand ideState])] -> [Text]
allLspCmdIds Text
pid ([(PluginId, [PluginCommand ideState])] -> [Text])
-> [(PluginId, [PluginCommand ideState])] -> [Text]
forall a b. (a -> b) -> a -> b
$ (PluginDescriptor ideState -> (PluginId, [PluginCommand ideState]))
-> [PluginDescriptor ideState]
-> [(PluginId, [PluginCommand ideState])]
forall a b. (a -> b) -> [a] -> [b]
map (PluginDescriptor ideState -> PluginId
forall ideState. PluginDescriptor ideState -> PluginId
pluginId (PluginDescriptor ideState -> PluginId)
-> (PluginDescriptor ideState -> [PluginCommand ideState])
-> PluginDescriptor ideState
-> (PluginId, [PluginCommand ideState])
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& PluginDescriptor ideState -> [PluginCommand ideState]
forall ideState.
PluginDescriptor ideState -> [PluginCommand ideState]
pluginCommands) [PluginDescriptor ideState]
ls

allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text]
allLspCmdIds :: forall ideState.
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

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


type TextParser = P.Parsec Void T.Text

-- | Unescape printable escape sequences within double quotes.
-- This is useful if you have to call 'show' indirectly, and it escapes some characters which you would prefer to
-- display as is.
unescape :: T.Text -> T.Text
unescape :: Text -> Text
unescape Text
input =
  case Parsec Void Text String
-> String -> Text -> Either (ParseErrorBundle Text Void) String
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec Void Text String
escapedTextParser String
"inline" Text
input of
    Left ParseErrorBundle Text Void
_     -> Text
input
    Right String
strs -> String -> Text
T.pack String
strs

-- | Parser for a string that contains double quotes. Returns unescaped string.
escapedTextParser :: TextParser String
escapedTextParser :: Parsec Void Text String
escapedTextParser = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ParsecT Void Text Identity [String] -> Parsec Void Text String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text String -> ParsecT Void Text Identity [String]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many (Parsec Void Text String
outsideStringLiteral Parsec Void Text String
-> Parsec Void Text String -> Parsec Void Text String
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> Parsec Void Text String
stringLiteral)
  where
    outsideStringLiteral :: TextParser String
    outsideStringLiteral :: Parsec Void Text String
outsideStringLiteral = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> Parsec Void Text String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.someTill (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
P.anySingleBut Char
Token Text
'"') (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'"') ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
P.<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof))

    stringLiteral :: TextParser String
    stringLiteral :: Parsec Void Text String
stringLiteral = do
      String
inside <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'"' ParsecT Void Text Identity Char
-> Parsec Void Text String -> Parsec Void Text String
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char -> Parsec Void Text String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
P.charLiteral (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token Text
'"')
      let f :: Char -> String
f Char
'"' = String
"\\\"" -- double quote should still be escaped
      -- Despite the docs, 'showLitChar' and 'showLitString' from 'Data.Char' DOES ESCAPE unicode printable
      -- characters. So we need to call 'isPrint' from 'Data.Char' manually.
          f Char
ch  = if Char -> Bool
isPrint Char
ch then [Char
ch] else Char -> String -> String
showLitChar Char
ch String
""
          inside' :: String
inside' = (Char -> String) -> String -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
f String
inside

      String -> Parsec Void Text String
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Parsec Void Text String)
-> String -> Parsec Void Text String
forall a b. (a -> b) -> a -> b
$ String
"\"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
inside' String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\""

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

-- | toAbsolute
-- use `toAbsolute` to state our intention that we are actually make a path absolute
-- the first argument should be the root directory
-- the second argument should be the relative path
toAbsolute :: FilePath -> FilePath -> FilePath
toAbsolute :: String -> String -> String
toAbsolute = String -> String -> String
(</>)