{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Ide.Plugin.CodeRange (
    descriptor
    , Log

    -- * Internal
    , findPosition
    , findFoldingRanges
    , createFoldingRange
    ) where

import           Control.Monad.IO.Class               (MonadIO (liftIO))
import           Control.Monad.Trans.Except           (ExceptT, mapExceptT)
import           Control.Monad.Trans.Maybe            (MaybeT (MaybeT),
                                                       maybeToExceptT)
import           Data.List.Extra                      (drop1)
import           Data.Maybe                           (fromMaybe)
import           Data.Vector                          (Vector)
import qualified Data.Vector                          as V
import           Development.IDE                      (Action,
                                                       IdeState (shakeExtras),
                                                       Range (Range), Recorder,
                                                       WithPriority,
                                                       cmapWithPrio)
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.PositionMapping (PositionMapping,
                                                       toCurrentRange)
import           Ide.Logger                           (Pretty (..))
import           Ide.Plugin.CodeRange.Rules           (CodeRange (..),
                                                       GetCodeRange (..),
                                                       codeRangeRule, crkToFrk)
import qualified Ide.Plugin.CodeRange.Rules           as Rules (Log)
import           Ide.Plugin.Error
import           Ide.PluginUtils                      (positionInRange)
import           Ide.Types                            (PluginDescriptor (pluginHandlers, pluginRules),
                                                       PluginId,
                                                       PluginMethodHandler,
                                                       defaultPluginDescriptor,
                                                       mkPluginHandler)
import           Language.LSP.Protocol.Message        (Method (Method_TextDocumentFoldingRange, Method_TextDocumentSelectionRange),
                                                       SMethod (SMethod_TextDocumentFoldingRange, SMethod_TextDocumentSelectionRange))
import           Language.LSP.Protocol.Types          (FoldingRange (..),
                                                       FoldingRangeParams (..),
                                                       NormalizedFilePath, Null,
                                                       Position (..),
                                                       Range (_start),
                                                       SelectionRange (..),
                                                       SelectionRangeParams (..),
                                                       TextDocumentIdentifier (TextDocumentIdentifier),
                                                       Uri, type (|?) (InL))
import           Prelude                              hiding (log, span)

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId = (PluginId -> Text -> PluginDescriptor IdeState
forall ideState. PluginId -> Text -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId Text
"Provides selection and folding ranges for Haskell")
    { pluginHandlers = mkPluginHandler SMethod_TextDocumentSelectionRange (selectionRangeHandler recorder)
    <> mkPluginHandler SMethod_TextDocumentFoldingRange (foldingRangeHandler recorder)
    , pluginRules = codeRangeRule (cmapWithPrio LogRules recorder)
    }

newtype Log = LogRules Rules.Log

instance Pretty Log where
    pretty :: forall ann. Log -> Doc ann
pretty (LogRules Log
codeRangeLog) = Log -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Log -> Doc ann
pretty Log
codeRangeLog


foldingRangeHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentFoldingRange
foldingRangeHandler :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentFoldingRange
foldingRangeHandler Recorder (WithPriority Log)
_ IdeState
ide PluginId
_ FoldingRangeParams{Maybe ProgressToken
TextDocumentIdentifier
_workDoneToken :: Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
_textDocument :: TextDocumentIdentifier
$sel:_partialResultToken:FoldingRangeParams :: FoldingRangeParams -> Maybe ProgressToken
$sel:_textDocument:FoldingRangeParams :: FoldingRangeParams -> TextDocumentIdentifier
$sel:_workDoneToken:FoldingRangeParams :: FoldingRangeParams -> Maybe ProgressToken
..} =
    do
        NormalizedFilePath
filePath <- Uri -> ExceptT PluginError (LspM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
        [FoldingRange]
foldingRanges <- String
-> IdeState
-> ExceptT PluginError Action [FoldingRange]
-> ExceptT PluginError (LspM Config) [FoldingRange]
forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"FoldingRange" IdeState
ide (ExceptT PluginError Action [FoldingRange]
 -> ExceptT PluginError (LspM Config) [FoldingRange])
-> ExceptT PluginError Action [FoldingRange]
-> ExceptT PluginError (LspM Config) [FoldingRange]
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> ExceptT PluginError Action [FoldingRange]
getFoldingRanges NormalizedFilePath
filePath
        ([FoldingRange] |? Null)
-> ExceptT PluginError (LspM Config) ([FoldingRange] |? Null)
forall a. a -> ExceptT PluginError (LspM Config) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([FoldingRange] |? Null)
 -> ExceptT PluginError (LspM Config) ([FoldingRange] |? Null))
-> ([FoldingRange] -> [FoldingRange] |? Null)
-> [FoldingRange]
-> ExceptT PluginError (LspM Config) ([FoldingRange] |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FoldingRange] -> [FoldingRange] |? Null
forall a b. a -> a |? b
InL ([FoldingRange]
 -> ExceptT PluginError (LspM Config) ([FoldingRange] |? Null))
-> [FoldingRange]
-> ExceptT PluginError (LspM Config) ([FoldingRange] |? Null)
forall a b. (a -> b) -> a -> b
$ [FoldingRange]
foldingRanges
  where
    uri :: Uri
    TextDocumentIdentifier Uri
uri = TextDocumentIdentifier
_textDocument

getFoldingRanges :: NormalizedFilePath -> ExceptT PluginError Action [FoldingRange]
getFoldingRanges :: NormalizedFilePath -> ExceptT PluginError Action [FoldingRange]
getFoldingRanges NormalizedFilePath
file = do
    CodeRange
codeRange <- GetCodeRange
-> NormalizedFilePath -> ExceptT PluginError Action CodeRange
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> ExceptT PluginError Action v
useE GetCodeRange
GetCodeRange NormalizedFilePath
file
    [FoldingRange] -> ExceptT PluginError Action [FoldingRange]
forall a. a -> ExceptT PluginError Action a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FoldingRange] -> ExceptT PluginError Action [FoldingRange])
-> [FoldingRange] -> ExceptT PluginError Action [FoldingRange]
forall a b. (a -> b) -> a -> b
$ CodeRange -> [FoldingRange]
findFoldingRanges CodeRange
codeRange

selectionRangeHandler :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentSelectionRange
selectionRangeHandler :: Recorder (WithPriority Log)
-> PluginMethodHandler IdeState 'Method_TextDocumentSelectionRange
selectionRangeHandler Recorder (WithPriority Log)
_ IdeState
ide PluginId
_ SelectionRangeParams{[Position]
Maybe ProgressToken
TextDocumentIdentifier
_workDoneToken :: Maybe ProgressToken
_partialResultToken :: Maybe ProgressToken
_textDocument :: TextDocumentIdentifier
_positions :: [Position]
$sel:_partialResultToken:SelectionRangeParams :: SelectionRangeParams -> Maybe ProgressToken
$sel:_positions:SelectionRangeParams :: SelectionRangeParams -> [Position]
$sel:_textDocument:SelectionRangeParams :: SelectionRangeParams -> TextDocumentIdentifier
$sel:_workDoneToken:SelectionRangeParams :: SelectionRangeParams -> Maybe ProgressToken
..} = do
   do
        NormalizedFilePath
filePath <- Uri -> ExceptT PluginError (LspM Config) NormalizedFilePath
forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
        (IO (Either PluginError ([SelectionRange] |? Null))
 -> LspM Config (Either PluginError ([SelectionRange] |? Null)))
-> ExceptT PluginError IO ([SelectionRange] |? Null)
-> ExceptT PluginError (LspM Config) ([SelectionRange] |? Null)
forall (m :: * -> *) e a (n :: * -> *) e' b.
(m (Either e a) -> n (Either e' b))
-> ExceptT e m a -> ExceptT e' n b
mapExceptT IO (Either PluginError ([SelectionRange] |? Null))
-> LspM Config (Either PluginError ([SelectionRange] |? Null))
forall a. IO a -> LspT Config IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ExceptT PluginError IO ([SelectionRange] |? Null)
 -> ExceptT PluginError (LspM Config) ([SelectionRange] |? Null))
-> ExceptT PluginError IO ([SelectionRange] |? Null)
-> ExceptT PluginError (LspM Config) ([SelectionRange] |? Null)
forall a b. (a -> b) -> a -> b
$ IdeState
-> NormalizedFilePath
-> [Position]
-> ExceptT PluginError IO ([SelectionRange] |? Null)
getSelectionRanges IdeState
ide NormalizedFilePath
filePath [Position]
positions
  where
    uri :: Uri
    TextDocumentIdentifier Uri
uri = TextDocumentIdentifier
_textDocument

    positions :: [Position]
    positions :: [Position]
positions = [Position]
_positions


getSelectionRanges :: IdeState -> NormalizedFilePath -> [Position] -> ExceptT PluginError IO ([SelectionRange] |? Null)
getSelectionRanges :: IdeState
-> NormalizedFilePath
-> [Position]
-> ExceptT PluginError IO ([SelectionRange] |? Null)
getSelectionRanges IdeState
ide NormalizedFilePath
file [Position]
positions = do
    (CodeRange
codeRange, PositionMapping
positionMapping) <- String
-> ShakeExtras
-> ExceptT PluginError IdeAction (CodeRange, PositionMapping)
-> ExceptT PluginError IO (CodeRange, PositionMapping)
forall (m :: * -> *) e a.
MonadIO m =>
String -> ShakeExtras -> ExceptT e IdeAction a -> ExceptT e m a
runIdeActionE String
"SelectionRange" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (ExceptT PluginError IdeAction (CodeRange, PositionMapping)
 -> ExceptT PluginError IO (CodeRange, PositionMapping))
-> ExceptT PluginError IdeAction (CodeRange, PositionMapping)
-> ExceptT PluginError IO (CodeRange, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GetCodeRange
-> NormalizedFilePath
-> ExceptT PluginError IdeAction (CodeRange, PositionMapping)
forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError IdeAction (v, PositionMapping)
useWithStaleFastE GetCodeRange
GetCodeRange NormalizedFilePath
file
    -- 'positionMapping' should be applied to the input before using them
    [Position]
positions' <-
        (Position -> ExceptT PluginError IO Position)
-> [Position] -> ExceptT PluginError IO [Position]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (PositionMapping -> Position -> ExceptT PluginError IO Position
forall (m :: * -> *).
Monad m =>
PositionMapping -> Position -> ExceptT PluginError m Position
fromCurrentPositionE PositionMapping
positionMapping) [Position]
positions

    let selectionRanges :: [SelectionRange]
selectionRanges = ((Position -> SelectionRange) -> [Position] -> [SelectionRange])
-> [Position] -> (Position -> SelectionRange) -> [SelectionRange]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Position -> SelectionRange) -> [Position] -> [SelectionRange]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Position]
positions' ((Position -> SelectionRange) -> [SelectionRange])
-> (Position -> SelectionRange) -> [SelectionRange]
forall a b. (a -> b) -> a -> b
$ \Position
pos ->
            -- We need a default selection range if the lookup fails,
            -- so that other positions can still have valid results.
            let defaultSelectionRange :: SelectionRange
defaultSelectionRange = Range -> Maybe SelectionRange -> SelectionRange
SelectionRange (Position -> Position -> Range
Range Position
pos Position
pos) Maybe SelectionRange
forall a. Maybe a
Nothing
             in SelectionRange -> Maybe SelectionRange -> SelectionRange
forall a. a -> Maybe a -> a
fromMaybe SelectionRange
defaultSelectionRange (Maybe SelectionRange -> SelectionRange)
-> (CodeRange -> Maybe SelectionRange)
-> CodeRange
-> SelectionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> CodeRange -> Maybe SelectionRange
findPosition Position
pos (CodeRange -> SelectionRange) -> CodeRange -> SelectionRange
forall a b. (a -> b) -> a -> b
$ CodeRange
codeRange

    -- 'positionMapping' should be applied to the output ranges before returning them
    PluginError
-> MaybeT IO ([SelectionRange] |? Null)
-> ExceptT PluginError IO ([SelectionRange] |? Null)
forall (m :: * -> *) e a.
Functor m =>
e -> MaybeT m a -> ExceptT e m a
maybeToExceptT (Text -> PluginError
PluginInvalidUserState Text
"toCurrentSelectionRange") (MaybeT IO ([SelectionRange] |? Null)
 -> ExceptT PluginError IO ([SelectionRange] |? Null))
-> (Maybe ([SelectionRange] |? Null)
    -> MaybeT IO ([SelectionRange] |? Null))
-> Maybe ([SelectionRange] |? Null)
-> ExceptT PluginError IO ([SelectionRange] |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Maybe ([SelectionRange] |? Null))
-> MaybeT IO ([SelectionRange] |? Null)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IO (Maybe ([SelectionRange] |? Null))
 -> MaybeT IO ([SelectionRange] |? Null))
-> (Maybe ([SelectionRange] |? Null)
    -> IO (Maybe ([SelectionRange] |? Null)))
-> Maybe ([SelectionRange] |? Null)
-> MaybeT IO ([SelectionRange] |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ([SelectionRange] |? Null)
-> IO (Maybe ([SelectionRange] |? Null))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ([SelectionRange] |? Null)
 -> ExceptT PluginError IO ([SelectionRange] |? Null))
-> Maybe ([SelectionRange] |? Null)
-> ExceptT PluginError IO ([SelectionRange] |? Null)
forall a b. (a -> b) -> a -> b
$
        [SelectionRange] -> [SelectionRange] |? Null
forall a b. a -> a |? b
InL ([SelectionRange] -> [SelectionRange] |? Null)
-> Maybe [SelectionRange] -> Maybe ([SelectionRange] |? Null)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SelectionRange -> Maybe SelectionRange)
-> [SelectionRange] -> Maybe [SelectionRange]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (PositionMapping -> SelectionRange -> Maybe SelectionRange
toCurrentSelectionRange PositionMapping
positionMapping) [SelectionRange]
selectionRanges

-- | Find 'Position' in 'CodeRange'. This can fail, if the given position is not covered by the 'CodeRange'.
findPosition :: Position -> CodeRange -> Maybe SelectionRange
findPosition :: Position -> CodeRange -> Maybe SelectionRange
findPosition Position
pos CodeRange
root = Maybe SelectionRange -> CodeRange -> Maybe SelectionRange
go Maybe SelectionRange
forall a. Maybe a
Nothing CodeRange
root
  where
    -- Helper function for recursion. The range list is built top-down
    go :: Maybe SelectionRange -> CodeRange -> Maybe SelectionRange
    go :: Maybe SelectionRange -> CodeRange -> Maybe SelectionRange
go Maybe SelectionRange
acc CodeRange
node =
        if Position -> Range -> Bool
positionInRange Position
pos Range
range
        then Maybe SelectionRange
-> (CodeRange -> Maybe SelectionRange)
-> Maybe CodeRange
-> Maybe SelectionRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe SelectionRange
acc' (Maybe SelectionRange -> CodeRange -> Maybe SelectionRange
go Maybe SelectionRange
acc') (Vector CodeRange -> Maybe CodeRange
binarySearchPos Vector CodeRange
children)
        -- If all children doesn't contain pos, acc' will be returned.
        -- acc' will be Nothing only if we are in the root level.
        else Maybe SelectionRange
forall a. Maybe a
Nothing
      where
        range :: Range
range = CodeRange -> Range
_codeRange_range CodeRange
node
        children :: Vector CodeRange
children = CodeRange -> Vector CodeRange
_codeRange_children CodeRange
node
        acc' :: Maybe SelectionRange
acc' = SelectionRange -> Maybe SelectionRange
forall a. a -> Maybe a
Just (SelectionRange -> Maybe SelectionRange)
-> SelectionRange -> Maybe SelectionRange
forall a b. (a -> b) -> a -> b
$ SelectionRange
-> (SelectionRange -> SelectionRange)
-> Maybe SelectionRange
-> SelectionRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Range -> Maybe SelectionRange -> SelectionRange
SelectionRange Range
range Maybe SelectionRange
forall a. Maybe a
Nothing) (Range -> Maybe SelectionRange -> SelectionRange
SelectionRange Range
range (Maybe SelectionRange -> SelectionRange)
-> (SelectionRange -> Maybe SelectionRange)
-> SelectionRange
-> SelectionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectionRange -> Maybe SelectionRange
forall a. a -> Maybe a
Just) Maybe SelectionRange
acc

    binarySearchPos :: Vector CodeRange -> Maybe CodeRange
    binarySearchPos :: Vector CodeRange -> Maybe CodeRange
binarySearchPos Vector CodeRange
v
        | Vector CodeRange -> Bool
forall a. Vector a -> Bool
V.null Vector CodeRange
v = Maybe CodeRange
forall a. Maybe a
Nothing
        | Vector CodeRange -> Int
forall a. Vector a -> Int
V.length Vector CodeRange
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1,
            Just CodeRange
r <- Vector CodeRange -> Maybe CodeRange
forall (m :: * -> *) a. Monad m => Vector a -> m a
V.headM Vector CodeRange
v = if Position -> Range -> Bool
positionInRange Position
pos (CodeRange -> Range
_codeRange_range CodeRange
r) then CodeRange -> Maybe CodeRange
forall a. a -> Maybe a
Just CodeRange
r else Maybe CodeRange
forall a. Maybe a
Nothing
        | Bool
otherwise = do
            let (Vector CodeRange
left, Vector CodeRange
right) = Int -> Vector CodeRange -> (Vector CodeRange, Vector CodeRange)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt (Vector CodeRange -> Int
forall a. Vector a -> Int
V.length Vector CodeRange
v Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) Vector CodeRange
v
            Position
startOfRight <- Range -> Position
_start (Range -> Position)
-> (CodeRange -> Range) -> CodeRange -> Position
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CodeRange -> Range
_codeRange_range (CodeRange -> Position) -> Maybe CodeRange -> Maybe Position
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector CodeRange -> Maybe CodeRange
forall (m :: * -> *) a. Monad m => Vector a -> m a
V.headM Vector CodeRange
right
            if Position
pos Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
< Position
startOfRight then Vector CodeRange -> Maybe CodeRange
binarySearchPos Vector CodeRange
left else Vector CodeRange -> Maybe CodeRange
binarySearchPos Vector CodeRange
right

-- | Traverses through the code range and it children to a folding ranges.
--
-- It starts with the root node, converts that into a folding range then moves towards the children.
-- It converts each child of each root node and parses it to folding range and moves to its children.
--
-- Two cases to that are assumed to be taken care on the client side are:
--
--      1. When a folding range starts and ends on the same line, it is upto the client if it wants to
--      fold a single line folding or not.
--
--      2. As we are converting nodes of the ast into folding ranges, there are multiple nodes starting from a single line.
--      A single line of code doesn't mean a single node in AST, so this function removes all the nodes that have a duplicate
--      start line, ie. they start from the same line.
--      Eg. A multi-line function that also has a multi-line if statement starting from the same line should have the folding
--      according to the function.
--
-- We think the client can handle this, if not we could change to remove these in future
--
-- Discussion reference: https://github.com/haskell/haskell-language-server/pull/3058#discussion_r973737211
findFoldingRanges :: CodeRange -> [FoldingRange]
findFoldingRanges :: CodeRange -> [FoldingRange]
findFoldingRanges CodeRange
codeRange =
    -- removing the first node because it folds the entire file
    [FoldingRange] -> [FoldingRange]
forall a. [a] -> [a]
drop1 ([FoldingRange] -> [FoldingRange])
-> [FoldingRange] -> [FoldingRange]
forall a b. (a -> b) -> a -> b
$ CodeRange -> [FoldingRange]
findFoldingRangesRec CodeRange
codeRange

findFoldingRangesRec :: CodeRange -> [FoldingRange]
findFoldingRangesRec :: CodeRange -> [FoldingRange]
findFoldingRangesRec r :: CodeRange
r@(CodeRange Range
_ Vector CodeRange
children CodeRangeKind
_) =
    let [FoldingRange]
frChildren :: [FoldingRange] = [[FoldingRange]] -> [FoldingRange]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FoldingRange]] -> [FoldingRange])
-> [[FoldingRange]] -> [FoldingRange]
forall a b. (a -> b) -> a -> b
$ Vector [FoldingRange] -> [[FoldingRange]]
forall a. Vector a -> [a]
V.toList (Vector [FoldingRange] -> [[FoldingRange]])
-> Vector [FoldingRange] -> [[FoldingRange]]
forall a b. (a -> b) -> a -> b
$ (CodeRange -> [FoldingRange])
-> Vector CodeRange -> Vector [FoldingRange]
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodeRange -> [FoldingRange]
findFoldingRangesRec Vector CodeRange
children
    in case CodeRange -> Maybe FoldingRange
createFoldingRange CodeRange
r of
        Just FoldingRange
x  -> FoldingRange
xFoldingRange -> [FoldingRange] -> [FoldingRange]
forall a. a -> [a] -> [a]
:[FoldingRange]
frChildren
        Maybe FoldingRange
Nothing -> [FoldingRange]
frChildren

-- | Parses code range to folding range
createFoldingRange :: CodeRange -> Maybe FoldingRange
createFoldingRange :: CodeRange -> Maybe FoldingRange
createFoldingRange (CodeRange (Range (Position UInt
lineStart UInt
charStart) (Position UInt
lineEnd UInt
charEnd)) Vector CodeRange
_ CodeRangeKind
ck) = do
    -- Type conversion of codeRangeKind to FoldingRangeKind
    let frk :: FoldingRangeKind
frk = CodeRangeKind -> FoldingRangeKind
crkToFrk CodeRangeKind
ck
    FoldingRange -> Maybe FoldingRange
forall a. a -> Maybe a
Just (UInt
-> Maybe UInt
-> UInt
-> Maybe UInt
-> Maybe FoldingRangeKind
-> Maybe Text
-> FoldingRange
FoldingRange UInt
lineStart (UInt -> Maybe UInt
forall a. a -> Maybe a
Just UInt
charStart) UInt
lineEnd (UInt -> Maybe UInt
forall a. a -> Maybe a
Just UInt
charEnd) (FoldingRangeKind -> Maybe FoldingRangeKind
forall a. a -> Maybe a
Just FoldingRangeKind
frk) Maybe Text
forall a. Maybe a
Nothing)

-- | Likes 'toCurrentPosition', but works on 'SelectionRange'
toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange
toCurrentSelectionRange :: PositionMapping -> SelectionRange -> Maybe SelectionRange
toCurrentSelectionRange PositionMapping
positionMapping SelectionRange{Maybe SelectionRange
Range
_range :: Range
_parent :: Maybe SelectionRange
$sel:_parent:SelectionRange :: SelectionRange -> Maybe SelectionRange
$sel:_range:SelectionRange :: SelectionRange -> Range
..} = do
    Range
newRange <- PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
positionMapping Range
_range
    SelectionRange -> Maybe SelectionRange
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SelectionRange -> Maybe SelectionRange)
-> SelectionRange -> Maybe SelectionRange
forall a b. (a -> b) -> a -> b
$ SelectionRange {
        $sel:_range:SelectionRange :: Range
_range = Range
newRange,
        $sel:_parent:SelectionRange :: Maybe SelectionRange
_parent = Maybe SelectionRange
_parent Maybe SelectionRange
-> (SelectionRange -> Maybe SelectionRange) -> Maybe SelectionRange
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PositionMapping -> SelectionRange -> Maybe SelectionRange
toCurrentSelectionRange PositionMapping
positionMapping
    }