{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}

module Ide.Plugin.SelectionRange (descriptor) where

import           Control.Monad.Except                    (ExceptT (ExceptT),
                                                          runExceptT)
import           Control.Monad.IO.Class                  (liftIO)
import           Control.Monad.Reader                    (runReader)
import           Control.Monad.Trans.Maybe               (MaybeT (MaybeT),
                                                          maybeToExceptT)
import           Data.Coerce                             (coerce)
import           Data.Containers.ListUtils               (nubOrd)
import           Data.Either.Extra                       (maybeToEither)
import           Data.Foldable                           (find)
import qualified Data.Map.Strict                         as Map
import           Data.Maybe                              (fromMaybe, mapMaybe)
import qualified Data.Text                               as T
import           Development.IDE                         (GetHieAst (GetHieAst),
                                                          HieAstResult (HAR, hieAst, refMap),
                                                          IdeAction,
                                                          IdeState (shakeExtras),
                                                          Range (Range),
                                                          fromNormalizedFilePath,
                                                          ideLogger, logDebug,
                                                          realSrcSpanToRange,
                                                          runIdeAction,
                                                          toNormalizedFilePath',
                                                          uriToFilePath')
import           Development.IDE.Core.Actions            (useE)
import           Development.IDE.Core.PositionMapping    (PositionMapping,
                                                          fromCurrentPosition,
                                                          toCurrentRange)
import           Development.IDE.GHC.Compat              (HieAST (Node), Span,
                                                          getAsts)
import           Development.IDE.GHC.Compat.Util
import           Ide.Plugin.SelectionRange.ASTPreProcess (PreProcessEnv (PreProcessEnv),
                                                          preProcessAST)
import           Ide.PluginUtils                         (response)
import           Ide.Types                               (PluginDescriptor (pluginHandlers),
                                                          PluginId,
                                                          defaultPluginDescriptor,
                                                          mkPluginHandler)
import           Language.LSP.Server                     (LspM)
import           Language.LSP.Types                      (List (List),
                                                          NormalizedFilePath,
                                                          Position,
                                                          ResponseError,
                                                          SMethod (STextDocumentSelectionRange),
                                                          SelectionRange (..),
                                                          SelectionRangeParams (..),
                                                          TextDocumentIdentifier (TextDocumentIdentifier),
                                                          Uri)
import           Prelude                                 hiding (span)

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { pluginHandlers :: PluginHandlers IdeState
pluginHandlers = SClientMethod 'TextDocumentSelectionRange
-> PluginMethodHandler IdeState 'TextDocumentSelectionRange
-> PluginHandlers IdeState
forall (m :: Method 'FromClient 'Request) ideState.
PluginMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SClientMethod 'TextDocumentSelectionRange
STextDocumentSelectionRange PluginMethodHandler IdeState 'TextDocumentSelectionRange
forall c.
IdeState
-> PluginId
-> SelectionRangeParams
-> LspM c (Either ResponseError (List SelectionRange))
selectionRangeHandler
    }

selectionRangeHandler :: IdeState -> PluginId -> SelectionRangeParams -> LspM c (Either ResponseError (List SelectionRange))
selectionRangeHandler :: IdeState
-> PluginId
-> SelectionRangeParams
-> LspM c (Either ResponseError (List SelectionRange))
selectionRangeHandler IdeState
ide PluginId
_ SelectionRangeParams{Maybe ProgressToken
List Position
TextDocumentIdentifier
$sel:_workDoneToken:SelectionRangeParams :: SelectionRangeParams -> Maybe ProgressToken
$sel:_partialResultToken:SelectionRangeParams :: SelectionRangeParams -> Maybe ProgressToken
$sel:_textDocument:SelectionRangeParams :: SelectionRangeParams -> TextDocumentIdentifier
$sel:_positions:SelectionRangeParams :: SelectionRangeParams -> List Position
_positions :: List Position
_textDocument :: TextDocumentIdentifier
_partialResultToken :: Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken
..} = do
    IO () -> LspT c IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT c IO ()) -> IO () -> LspT c IO ()
forall a b. (a -> b) -> a -> b
$ Logger -> Text -> IO ()
logDebug Logger
logger (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"requesting selection range for file: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Uri -> String
forall a. Show a => a -> String
show Uri
uri)
    ExceptT String (LspT c IO) (List SelectionRange)
-> LspM c (Either ResponseError (List SelectionRange))
forall (m :: * -> *) a.
Monad m =>
ExceptT String m a -> m (Either ResponseError a)
response (ExceptT String (LspT c IO) (List SelectionRange)
 -> LspM c (Either ResponseError (List SelectionRange)))
-> ExceptT String (LspT c IO) (List SelectionRange)
-> LspM c (Either ResponseError (List SelectionRange))
forall a b. (a -> b) -> a -> b
$ do
        NormalizedFilePath
filePath <- LspT c IO (Either String NormalizedFilePath)
-> ExceptT String (LspT c IO) NormalizedFilePath
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (LspT c IO (Either String NormalizedFilePath)
 -> ExceptT String (LspT c IO) NormalizedFilePath)
-> (Maybe NormalizedFilePath
    -> LspT c IO (Either String NormalizedFilePath))
-> Maybe NormalizedFilePath
-> ExceptT String (LspT c IO) NormalizedFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String NormalizedFilePath
-> LspT c IO (Either String NormalizedFilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String NormalizedFilePath
 -> LspT c IO (Either String NormalizedFilePath))
-> (Maybe NormalizedFilePath -> Either String NormalizedFilePath)
-> Maybe NormalizedFilePath
-> LspT c IO (Either String NormalizedFilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Maybe NormalizedFilePath -> Either String NormalizedFilePath
forall a b. a -> Maybe b -> Either a b
maybeToEither String
"fail to convert uri to file path" (Maybe NormalizedFilePath
 -> ExceptT String (LspT c IO) NormalizedFilePath)
-> Maybe NormalizedFilePath
-> ExceptT String (LspT c IO) NormalizedFilePath
forall a b. (a -> b) -> a -> b
$
                String -> NormalizedFilePath
toNormalizedFilePath' (String -> NormalizedFilePath)
-> Maybe String -> Maybe NormalizedFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe String
uriToFilePath' Uri
uri
        [SelectionRange]
selectionRanges <- LspT c IO (Either String [SelectionRange])
-> ExceptT String (LspT c IO) [SelectionRange]
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (LspT c IO (Either String [SelectionRange])
 -> ExceptT String (LspT c IO) [SelectionRange])
-> (ExceptT String IdeAction [SelectionRange]
    -> LspT c IO (Either String [SelectionRange]))
-> ExceptT String IdeAction [SelectionRange]
-> ExceptT String (LspT c IO) [SelectionRange]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either String [SelectionRange])
-> LspT c IO (Either String [SelectionRange])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either String [SelectionRange])
 -> LspT c IO (Either String [SelectionRange]))
-> (ExceptT String IdeAction [SelectionRange]
    -> IO (Either String [SelectionRange]))
-> ExceptT String IdeAction [SelectionRange]
-> LspT c IO (Either String [SelectionRange])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> ShakeExtras
-> IdeAction (Either String [SelectionRange])
-> IO (Either String [SelectionRange])
forall a. String -> ShakeExtras -> IdeAction a -> IO a
runIdeAction String
"SelectionRange" (IdeState -> ShakeExtras
shakeExtras IdeState
ide) (IdeAction (Either String [SelectionRange])
 -> IO (Either String [SelectionRange]))
-> (ExceptT String IdeAction [SelectionRange]
    -> IdeAction (Either String [SelectionRange]))
-> ExceptT String IdeAction [SelectionRange]
-> IO (Either String [SelectionRange])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT String IdeAction [SelectionRange]
-> IdeAction (Either String [SelectionRange])
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IdeAction [SelectionRange]
 -> ExceptT String (LspT c IO) [SelectionRange])
-> ExceptT String IdeAction [SelectionRange]
-> ExceptT String (LspT c IO) [SelectionRange]
forall a b. (a -> b) -> a -> b
$
            NormalizedFilePath
-> [Position] -> ExceptT String IdeAction [SelectionRange]
getSelectionRanges NormalizedFilePath
filePath [Position]
positions
        List SelectionRange
-> ExceptT String (LspT c IO) (List SelectionRange)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (List SelectionRange
 -> ExceptT String (LspT c IO) (List SelectionRange))
-> ([SelectionRange] -> List SelectionRange)
-> [SelectionRange]
-> ExceptT String (LspT c IO) (List SelectionRange)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SelectionRange] -> List SelectionRange
forall a. [a] -> List a
List ([SelectionRange]
 -> ExceptT String (LspT c IO) (List SelectionRange))
-> [SelectionRange]
-> ExceptT String (LspT c IO) (List SelectionRange)
forall a b. (a -> b) -> a -> b
$ [SelectionRange]
selectionRanges
  where
    uri :: Uri
    TextDocumentIdentifier Uri
uri = TextDocumentIdentifier
_textDocument

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

    logger :: Logger
logger = IdeState -> Logger
ideLogger IdeState
ide

getSelectionRanges :: NormalizedFilePath -> [Position] -> ExceptT String IdeAction [SelectionRange]
getSelectionRanges :: NormalizedFilePath
-> [Position] -> ExceptT String IdeAction [SelectionRange]
getSelectionRanges NormalizedFilePath
file [Position]
positions = do
    (HAR{HieASTs a
hieAst :: HieASTs a
hieAst :: ()
hieAst, RefMap a
refMap :: RefMap a
refMap :: ()
refMap}, PositionMapping
positionMapping) <- String
-> MaybeT IdeAction (HieAstResult, PositionMapping)
-> ExceptT String IdeAction (HieAstResult, PositionMapping)
forall (m :: * -> *) e a.
Functor m =>
e -> MaybeT m a -> ExceptT e m a
maybeToExceptT String
"fail to get hie ast" (MaybeT IdeAction (HieAstResult, PositionMapping)
 -> ExceptT String IdeAction (HieAstResult, PositionMapping))
-> MaybeT IdeAction (HieAstResult, PositionMapping)
-> ExceptT String IdeAction (HieAstResult, PositionMapping)
forall a b. (a -> b) -> a -> b
$ GetHieAst
-> NormalizedFilePath
-> MaybeT IdeAction (HieAstResult, PositionMapping)
forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE GetHieAst
GetHieAst NormalizedFilePath
file
    -- 'positionMapping' should be applied to the input positions before using them
    [Position]
positions' <- String
-> MaybeT IdeAction [Position]
-> ExceptT String IdeAction [Position]
forall (m :: * -> *) e a.
Functor m =>
e -> MaybeT m a -> ExceptT e m a
maybeToExceptT String
"fail to apply position mapping to input positions" (MaybeT IdeAction [Position]
 -> ExceptT String IdeAction [Position])
-> (Maybe [Position] -> MaybeT IdeAction [Position])
-> Maybe [Position]
-> ExceptT String IdeAction [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeAction (Maybe [Position]) -> MaybeT IdeAction [Position]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe [Position]) -> MaybeT IdeAction [Position])
-> (Maybe [Position] -> IdeAction (Maybe [Position]))
-> Maybe [Position]
-> MaybeT IdeAction [Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Position] -> IdeAction (Maybe [Position])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Position] -> ExceptT String IdeAction [Position])
-> Maybe [Position] -> ExceptT String IdeAction [Position]
forall a b. (a -> b) -> a -> b
$
        (Position -> Maybe Position) -> [Position] -> Maybe [Position]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
positionMapping) [Position]
positions

    HieAST a
ast <- String
-> MaybeT IdeAction (HieAST a)
-> ExceptT String IdeAction (HieAST a)
forall (m :: * -> *) e a.
Functor m =>
e -> MaybeT m a -> ExceptT e m a
maybeToExceptT String
"fail to get ast for current file" (MaybeT IdeAction (HieAST a)
 -> ExceptT String IdeAction (HieAST a))
-> (Maybe (HieAST a) -> MaybeT IdeAction (HieAST a))
-> Maybe (HieAST a)
-> ExceptT String IdeAction (HieAST a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeAction (Maybe (HieAST a)) -> MaybeT IdeAction (HieAST a)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe (HieAST a)) -> MaybeT IdeAction (HieAST a))
-> (Maybe (HieAST a) -> IdeAction (Maybe (HieAST a)))
-> Maybe (HieAST a)
-> MaybeT IdeAction (HieAST a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (HieAST a) -> IdeAction (Maybe (HieAST a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HieAST a) -> ExceptT String IdeAction (HieAST a))
-> Maybe (HieAST a) -> ExceptT String IdeAction (HieAST a)
forall a b. (a -> b) -> a -> b
$
        -- in GHC 9, the 'FastString' in 'HieASTs' is replaced by a newtype wrapper around 'LexicalFastString'
        -- so we use 'coerce' to make it work in both GHC 8 and 9
        HieASTs a -> Map FastString (HieAST a)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts HieASTs a
hieAst Map FastString (HieAST a) -> FastString -> Maybe (HieAST a)
forall k a. Ord k => Map k a -> k -> Maybe a
Map.!? (FastString -> FastString
coerce (FastString -> FastString)
-> (NormalizedFilePath -> FastString)
-> NormalizedFilePath
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FastString
mkFastString (String -> FastString)
-> (NormalizedFilePath -> String)
-> NormalizedFilePath
-> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> String
fromNormalizedFilePath) NormalizedFilePath
file

    let ast' :: HieAST a
ast' = Reader (PreProcessEnv a) (HieAST a) -> PreProcessEnv a -> HieAST a
forall r a. Reader r a -> r -> a
runReader (HieAST a -> Reader (PreProcessEnv a) (HieAST a)
forall a. HieAST a -> Reader (PreProcessEnv a) (HieAST a)
preProcessAST HieAST a
ast) (RefMap a -> PreProcessEnv a
forall a. RefMap a -> PreProcessEnv a
PreProcessEnv RefMap a
refMap)
    let selectionRanges :: [SelectionRange]
selectionRanges = [SelectionRange] -> [Position] -> [SelectionRange]
findSelectionRangesByPositions (HieAST a -> [SelectionRange]
forall a. HieAST a -> [SelectionRange]
astPathsLeafToRoot HieAST a
ast') [Position]
positions'

    -- 'positionMapping' should be applied to the output ranges before returning them
    String
-> MaybeT IdeAction [SelectionRange]
-> ExceptT String IdeAction [SelectionRange]
forall (m :: * -> *) e a.
Functor m =>
e -> MaybeT m a -> ExceptT e m a
maybeToExceptT String
"fail to apply position mapping to output positions" (MaybeT IdeAction [SelectionRange]
 -> ExceptT String IdeAction [SelectionRange])
-> (Maybe [SelectionRange] -> MaybeT IdeAction [SelectionRange])
-> Maybe [SelectionRange]
-> ExceptT String IdeAction [SelectionRange]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdeAction (Maybe [SelectionRange])
-> MaybeT IdeAction [SelectionRange]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (IdeAction (Maybe [SelectionRange])
 -> MaybeT IdeAction [SelectionRange])
-> (Maybe [SelectionRange] -> IdeAction (Maybe [SelectionRange]))
-> Maybe [SelectionRange]
-> MaybeT IdeAction [SelectionRange]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [SelectionRange] -> IdeAction (Maybe [SelectionRange])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [SelectionRange]
 -> ExceptT String IdeAction [SelectionRange])
-> Maybe [SelectionRange]
-> ExceptT String IdeAction [SelectionRange]
forall a b. (a -> b) -> a -> b
$
         (SelectionRange -> Maybe SelectionRange)
-> [SelectionRange] -> Maybe [SelectionRange]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (PositionMapping -> SelectionRange -> Maybe SelectionRange
toCurrentSelectionRange PositionMapping
positionMapping) [SelectionRange]
selectionRanges

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

-- | Build all paths from ast leaf to root
astPathsLeafToRoot :: HieAST a -> [SelectionRange]
astPathsLeafToRoot :: HieAST a -> [SelectionRange]
astPathsLeafToRoot = ([Span] -> Maybe SelectionRange) -> [[Span]] -> [SelectionRange]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Span] -> Maybe SelectionRange
spansToSelectionRange ([Span] -> Maybe SelectionRange)
-> ([Span] -> [Span]) -> [Span] -> Maybe SelectionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Span] -> [Span]
forall a. Ord a => [a] -> [a]
nubOrd) ([[Span]] -> [SelectionRange])
-> (HieAST a -> [[Span]]) -> HieAST a -> [SelectionRange]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Span]] -> HieAST a -> [[Span]]
forall a. [[Span]] -> HieAST a -> [[Span]]
go [[]]
  where
    go :: [[Span]] -> HieAST a -> [[Span]]
    go :: [[Span]] -> HieAST a -> [[Span]]
go [[Span]]
acc (Node NodeInfo a
_ Span
span [])       = ([Span] -> [Span]) -> [[Span]] -> [[Span]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Span
spanSpan -> [Span] -> [Span]
forall a. a -> [a] -> [a]
:) [[Span]]
acc
    go [[Span]]
acc (Node NodeInfo a
_ Span
span [HieAST a]
children) = (HieAST a -> [[Span]]) -> [HieAST a] -> [[Span]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([[Span]] -> HieAST a -> [[Span]]
forall a. [[Span]] -> HieAST a -> [[Span]]
go (([Span] -> [Span]) -> [[Span]] -> [[Span]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Span
spanSpan -> [Span] -> [Span]
forall a. a -> [a] -> [a]
:) [[Span]]
acc)) [HieAST a]
children

spansToSelectionRange :: [Span] -> Maybe SelectionRange
spansToSelectionRange :: [Span] -> Maybe SelectionRange
spansToSelectionRange [] = Maybe SelectionRange
forall a. Maybe a
Nothing
spansToSelectionRange (Span
span:[Span]
spans) = SelectionRange -> Maybe SelectionRange
forall a. a -> Maybe a
Just (SelectionRange -> Maybe SelectionRange)
-> SelectionRange -> Maybe SelectionRange
forall a b. (a -> b) -> a -> b
$
    SelectionRange :: Range -> Maybe SelectionRange -> SelectionRange
SelectionRange {$sel:_range:SelectionRange :: Range
_range = Span -> Range
realSrcSpanToRange Span
span, $sel:_parent:SelectionRange :: Maybe SelectionRange
_parent = [Span] -> Maybe SelectionRange
spansToSelectionRange [Span]
spans}

{-|
For each position, find the selection range that contains it, without taking each selection range's
parent into account. These selection ranges are un-divisible, representing the leaf nodes in original AST, so they
won't overlap.
-}
findSelectionRangesByPositions :: [SelectionRange] -- ^ all possible selection ranges
                               -> [Position] -- ^ requested positions
                               -> [SelectionRange]
findSelectionRangesByPositions :: [SelectionRange] -> [Position] -> [SelectionRange]
findSelectionRangesByPositions [SelectionRange]
selectionRanges = (Position -> SelectionRange) -> [Position] -> [SelectionRange]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Position -> SelectionRange
findByPosition
    {-
        Performance Tips:
        Doing a linear search from the first selection range for each position is not optimal.
        If it becomes too slow for a large file and many positions, you may optimize the implementation.
        Assume the number of selection range is n, then the following techniques may be applied:
            1. For each position, we may treat HieAST as a position indexed tree to search it in O(log(n)).
            2. For all positions, a searched position will narrow the search range for other positions.
    -}
  where
    findByPosition :: Position -> SelectionRange
    findByPosition :: Position -> SelectionRange
findByPosition Position
p = SelectionRange -> Maybe SelectionRange -> SelectionRange
forall a. a -> Maybe a -> a
fromMaybe SelectionRange :: Range -> Maybe SelectionRange -> SelectionRange
SelectionRange{$sel:_range:SelectionRange :: Range
_range = Position -> Position -> Range
Range Position
p Position
p, $sel:_parent:SelectionRange :: Maybe SelectionRange
_parent = Maybe SelectionRange
forall a. Maybe a
Nothing} (Maybe SelectionRange -> SelectionRange)
-> Maybe SelectionRange -> SelectionRange
forall a b. (a -> b) -> a -> b
$
        (SelectionRange -> Bool)
-> [SelectionRange] -> Maybe SelectionRange
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Position -> SelectionRange -> Bool
isPositionInSelectionRange Position
p) [SelectionRange]
selectionRanges

    isPositionInSelectionRange :: Position -> SelectionRange -> Bool
    isPositionInSelectionRange :: Position -> SelectionRange -> Bool
isPositionInSelectionRange Position
p SelectionRange{Range
_range :: Range
$sel:_range:SelectionRange :: SelectionRange -> Range
_range} =
        let Range Position
sp Position
ep = Range
_range in 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