-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE CPP   #-}
{-# LANGUAGE GADTs #-}

-- | Gives information about symbols at a given point in DAML files.
-- These are all pure functions that should execute quickly.
module Development.IDE.Spans.AtPoint (
    atPoint
  , gotoDefinition
  , gotoTypeDefinition
  , documentHighlight
  , pointCommand
  , referencesAtPoint
  , computeTypeReferences
  , FOIReferences(..)
  , defRowToSymbolInfo
  , getAstNamesAtPoint
  , toCurrentLocation
  , rowToLoc
  ) where

import           Development.IDE.GHC.Error
import           Development.IDE.GHC.Orphans          ()
import           Development.IDE.Types.Location
import           Language.LSP.Types

-- compiler and infrastructure
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.RuleTypes
import           Development.IDE.GHC.Compat
import           Development.IDE.Spans.Common
import           Development.IDE.Types.Options

-- GHC API imports
import           FastString                           (unpackFS)
import           IfaceType
import           Name
import           NameEnv
import           Outputable                           hiding ((<>))
import           SrcLoc
import           TyCoRep                              hiding (FunTy)
import           TyCon
import qualified Var

import           Control.Applicative
import           Control.Monad.Extra
import           Control.Monad.IO.Class
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Maybe
import qualified Data.HashMap.Strict                  as HM
import qualified Data.Map.Strict                      as M
import           Data.Maybe
import qualified Data.Text                            as T

import qualified Data.Array                           as A
import           Data.Either
import           Data.List                            (isSuffixOf)
import           Data.List.Extra                      (dropEnd1, nubOrd)

import           Data.Version                         (showVersion)
import           HieDb                                hiding (pointCommand)
import           System.Directory                     (doesFileExist)

-- | Gives a Uri for the module, given the .hie file location and the the module info
-- The Bool denotes if it is a boot module
type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri

-- | HieFileResult for files of interest, along with the position mappings
newtype FOIReferences = FOIReferences (HM.HashMap NormalizedFilePath (HieAstResult, PositionMapping))

computeTypeReferences :: Foldable f => f (HieAST Type) -> M.Map Name [Span]
computeTypeReferences :: f (HieAST Type) -> Map Name [Span]
computeTypeReferences = (HieAST Type -> Map Name [Span] -> Map Name [Span])
-> Map Name [Span] -> f (HieAST Type) -> Map Name [Span]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\HieAST Type
ast Map Name [Span]
m -> ([Span] -> [Span] -> [Span])
-> Map Name [Span] -> Map Name [Span] -> Map Name [Span]
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith [Span] -> [Span] -> [Span]
forall a. [a] -> [a] -> [a]
(++) (HieAST Type -> Map Name [Span]
go HieAST Type
ast) Map Name [Span]
m) Map Name [Span]
forall k a. Map k a
M.empty
  where
    go :: HieAST Type -> Map Name [Span]
go HieAST Type
ast = ([Span] -> [Span] -> [Span])
-> [Map Name [Span]] -> Map Name [Span]
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith [Span] -> [Span] -> [Span]
forall a. [a] -> [a] -> [a]
(++) (Map Name [Span]
this Map Name [Span] -> [Map Name [Span]] -> [Map Name [Span]]
forall a. a -> [a] -> [a]
: (HieAST Type -> Map Name [Span])
-> [HieAST Type] -> [Map Name [Span]]
forall a b. (a -> b) -> [a] -> [b]
map HieAST Type -> Map Name [Span]
go (HieAST Type -> [HieAST Type]
forall a. HieAST a -> [HieAST a]
nodeChildren HieAST Type
ast))
      where
        this :: Map Name [Span]
this = ([Span] -> [Span] -> [Span]) -> [(Name, [Span])] -> Map Name [Span]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith [Span] -> [Span] -> [Span]
forall a. [a] -> [a] -> [a]
(++)
          ([(Name, [Span])] -> Map Name [Span])
-> [(Name, [Span])] -> Map Name [Span]
forall a b. (a -> b) -> a -> b
$ (Name -> (Name, [Span])) -> [Name] -> [(Name, [Span])]
forall a b. (a -> b) -> [a] -> [b]
map (, [HieAST Type -> Span
forall a. HieAST a -> Span
nodeSpan HieAST Type
ast])
          ([Name] -> [(Name, [Span])]) -> [Name] -> [(Name, [Span])]
forall a b. (a -> b) -> a -> b
$ (Type -> [Name]) -> [Type] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [Name]
namesInType
          ([Type] -> [Name]) -> [Type] -> [Name]
forall a b. (a -> b) -> a -> b
$ (IdentifierDetails Type -> Maybe Type)
-> [IdentifierDetails Type] -> [Type]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\IdentifierDetails Type
x -> Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ContextInfo -> Bool
isOccurrence (Set ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall a b. (a -> b) -> a -> b
$ IdentifierDetails Type -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails Type
x) Maybe () -> Maybe Type -> Maybe Type
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IdentifierDetails Type -> Maybe Type
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails Type
x)
          ([IdentifierDetails Type] -> [Type])
-> [IdentifierDetails Type] -> [Type]
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails Type) -> [IdentifierDetails Type]
forall k a. Map k a -> [a]
M.elems
          (Map Identifier (IdentifierDetails Type)
 -> [IdentifierDetails Type])
-> Map Identifier (IdentifierDetails Type)
-> [IdentifierDetails Type]
forall a b. (a -> b) -> a -> b
$ NodeInfo Type -> Map Identifier (IdentifierDetails Type)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Type -> Map Identifier (IdentifierDetails Type))
-> NodeInfo Type -> Map Identifier (IdentifierDetails Type)
forall a b. (a -> b) -> a -> b
$ HieAST Type -> NodeInfo Type
forall a. HieAST a -> NodeInfo a
nodeInfo HieAST Type
ast

-- | Given a file and position, return the names at a point, the references for
-- those names in the FOIs, and a list of file paths we already searched through
foiReferencesAtPoint
  :: NormalizedFilePath
  -> Position
  -> FOIReferences
  -> ([Name],[Location],[FilePath])
foiReferencesAtPoint :: NormalizedFilePath
-> Position -> FOIReferences -> ([Name], [Location], [FilePath])
foiReferencesAtPoint NormalizedFilePath
file Position
pos (FOIReferences HashMap NormalizedFilePath (HieAstResult, PositionMapping)
asts) =
  case NormalizedFilePath
-> HashMap NormalizedFilePath (HieAstResult, PositionMapping)
-> Maybe (HieAstResult, PositionMapping)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup NormalizedFilePath
file HashMap NormalizedFilePath (HieAstResult, PositionMapping)
asts of
    Maybe (HieAstResult, PositionMapping)
Nothing -> ([],[],[])
    Just (HAR Module
_ HieASTs a
hf RefMap a
_ Map Name [Span]
_ HieKind a
_,PositionMapping
mapping) ->
      let names :: [Name]
names = HieASTs a -> Position -> PositionMapping -> [Name]
forall a. HieASTs a -> Position -> PositionMapping -> [Name]
getAstNamesAtPoint HieASTs a
hf Position
pos PositionMapping
mapping
          adjustedLocs :: [Location]
adjustedLocs = ((HieAstResult, PositionMapping) -> [Location] -> [Location])
-> [Location]
-> HashMap NormalizedFilePath (HieAstResult, PositionMapping)
-> [Location]
forall v a k. (v -> a -> a) -> a -> HashMap k v -> a
HM.foldr (HieAstResult, PositionMapping) -> [Location] -> [Location]
go [] HashMap NormalizedFilePath (HieAstResult, PositionMapping)
asts
          go :: (HieAstResult, PositionMapping) -> [Location] -> [Location]
go (HAR Module
_ HieASTs a
_ RefMap a
rf Map Name [Span]
tr HieKind a
_, PositionMapping
mapping) [Location]
xs = [Location]
refs [Location] -> [Location] -> [Location]
forall a. [a] -> [a] -> [a]
++ [Location]
typerefs [Location] -> [Location] -> [Location]
forall a. [a] -> [a] -> [a]
++ [Location]
xs
            where
              refs :: [Location]
refs = ((Span, IdentifierDetails a) -> Maybe Location)
-> [(Span, IdentifierDetails a)] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
mapping (Location -> Maybe Location)
-> ((Span, IdentifierDetails a) -> Location)
-> (Span, IdentifierDetails a)
-> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Location
realSrcSpanToLocation (Span -> Location)
-> ((Span, IdentifierDetails a) -> Span)
-> (Span, IdentifierDetails a)
-> Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span, IdentifierDetails a) -> Span
forall a b. (a, b) -> a
fst)
                   ([(Span, IdentifierDetails a)] -> [Location])
-> [(Span, IdentifierDetails a)] -> [Location]
forall a b. (a -> b) -> a -> b
$ [[(Span, IdentifierDetails a)]] -> [(Span, IdentifierDetails a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Span, IdentifierDetails a)]] -> [(Span, IdentifierDetails a)])
-> [[(Span, IdentifierDetails a)]] -> [(Span, IdentifierDetails a)]
forall a b. (a -> b) -> a -> b
$ (Name -> Maybe [(Span, IdentifierDetails a)])
-> [Name] -> [[(Span, IdentifierDetails a)]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\Name
n -> Identifier -> RefMap a -> Maybe [(Span, IdentifierDetails a)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Identifier
forall a b. b -> Either a b
Right Name
n) RefMap a
rf) [Name]
names
              typerefs :: [Location]
typerefs = (Span -> Maybe Location) -> [Span] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
mapping (Location -> Maybe Location)
-> (Span -> Location) -> Span -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Location
realSrcSpanToLocation)
                   ([Span] -> [Location]) -> [Span] -> [Location]
forall a b. (a -> b) -> a -> b
$ [[Span]] -> [Span]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Span]] -> [Span]) -> [[Span]] -> [Span]
forall a b. (a -> b) -> a -> b
$ (Name -> Maybe [Span]) -> [Name] -> [[Span]]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Name -> Map Name [Span] -> Maybe [Span]
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` Map Name [Span]
tr) [Name]
names
        in ([Name]
names, [Location]
adjustedLocs,(NormalizedFilePath -> FilePath)
-> [NormalizedFilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map NormalizedFilePath -> FilePath
fromNormalizedFilePath ([NormalizedFilePath] -> [FilePath])
-> [NormalizedFilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ HashMap NormalizedFilePath (HieAstResult, PositionMapping)
-> [NormalizedFilePath]
forall k v. HashMap k v -> [k]
HM.keys HashMap NormalizedFilePath (HieAstResult, PositionMapping)
asts)

getAstNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name]
getAstNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name]
getAstNamesAtPoint HieASTs a
hf Position
pos PositionMapping
mapping =
  [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> (HieAST a -> [Name]) -> [[Name]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hf Position
posFile ([Identifier] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Identifier] -> [Name])
-> (HieAST a -> [Identifier]) -> HieAST a -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier (IdentifierDetails a) -> [Identifier]
forall k a. Map k a -> [k]
M.keys (Map Identifier (IdentifierDetails a) -> [Identifier])
-> (HieAST a -> Map Identifier (IdentifierDetails a))
-> HieAST a
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> Map Identifier (IdentifierDetails a)
forall a. HieAST a -> NodeIdentifiers a
getNodeIds)
    where
      posFile :: Position
posFile = Position -> Maybe Position -> Position
forall a. a -> Maybe a -> a
fromMaybe Position
pos (Maybe Position -> Position) -> Maybe Position -> Position
forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos

toCurrentLocation :: PositionMapping -> Location -> Maybe Location
toCurrentLocation :: PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
mapping (Location Uri
uri Range
range) =
  Uri -> Range -> Location
Location Uri
uri (Range -> Location) -> Maybe Range -> Maybe Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
mapping Range
range

referencesAtPoint
  :: MonadIO m
  => HieDb
  -> NormalizedFilePath -- ^ The file the cursor is in
  -> Position -- ^ position in the file
  -> FOIReferences -- ^ references data for FOIs
  -> m [Location]
referencesAtPoint :: HieDb
-> NormalizedFilePath -> Position -> FOIReferences -> m [Location]
referencesAtPoint HieDb
hiedb NormalizedFilePath
nfp Position
pos FOIReferences
refs = do
  -- The database doesn't have up2date references data for the FOIs so we must collect those
  -- from the Shake graph.
  let ([Name]
names, [Location]
foiRefs, [FilePath]
exclude) = NormalizedFilePath
-> Position -> FOIReferences -> ([Name], [Location], [FilePath])
foiReferencesAtPoint NormalizedFilePath
nfp Position
pos FOIReferences
refs
  [[Location]]
nonFOIRefs <- [Name] -> (Name -> m [Location]) -> m [[Location]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Name]
names ((Name -> m [Location]) -> m [[Location]])
-> (Name -> m [Location]) -> m [[Location]]
forall a b. (a -> b) -> a -> b
$ \Name
name ->
    case Name -> Maybe Module
nameModule_maybe Name
name of
      Maybe Module
Nothing -> [Location] -> m [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Just Module
mod -> do
         -- Look for references (strictly in project files, not dependencies),
         -- excluding the files in the FOIs (since those are in foiRefs)
         [Res RefRow]
rows <- IO [Res RefRow] -> m [Res RefRow]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Res RefRow] -> m [Res RefRow])
-> IO [Res RefRow] -> m [Res RefRow]
forall a b. (a -> b) -> a -> b
$ HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [FilePath]
-> IO [Res RefRow]
findReferences HieDb
hiedb Bool
True (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnitId Module
mod) [FilePath]
exclude
         pure $ (Res RefRow -> Maybe Location) -> [Res RefRow] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Res RefRow -> Maybe Location
rowToLoc [Res RefRow]
rows
  [[Location]]
typeRefs <- [Name] -> (Name -> m [Location]) -> m [[Location]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Name]
names ((Name -> m [Location]) -> m [[Location]])
-> (Name -> m [Location]) -> m [[Location]]
forall a b. (a -> b) -> a -> b
$ \Name
name ->
    case Name -> Maybe Module
nameModule_maybe Name
name of
      Just Module
mod | NameSpace -> Bool
isTcClsNameSpace (OccName -> NameSpace
occNameSpace (OccName -> NameSpace) -> OccName -> NameSpace
forall a b. (a -> b) -> a -> b
$ Name -> OccName
nameOccName Name
name) -> do
        [Res TypeRef]
refs <- IO [Res TypeRef] -> m [Res TypeRef]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Res TypeRef] -> m [Res TypeRef])
-> IO [Res TypeRef] -> m [Res TypeRef]
forall a b. (a -> b) -> a -> b
$ HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [FilePath]
-> IO [Res TypeRef]
findTypeRefs HieDb
hiedb Bool
True (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnitId Module
mod) [FilePath]
exclude
        pure $ (Res TypeRef -> Maybe Location) -> [Res TypeRef] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Res TypeRef -> Maybe Location
typeRowToLoc [Res TypeRef]
refs
      Maybe Module
_ -> [Location] -> m [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  pure $ [Location] -> [Location]
forall a. Ord a => [a] -> [a]
nubOrd ([Location] -> [Location]) -> [Location] -> [Location]
forall a b. (a -> b) -> a -> b
$ [Location]
foiRefs [Location] -> [Location] -> [Location]
forall a. [a] -> [a] -> [a]
++ [[Location]] -> [Location]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Location]]
nonFOIRefs [Location] -> [Location] -> [Location]
forall a. [a] -> [a] -> [a]
++ [[Location]] -> [Location]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Location]]
typeRefs

rowToLoc :: Res RefRow -> Maybe Location
rowToLoc :: Res RefRow -> Maybe Location
rowToLoc (RefRow
row:.ModuleInfo
info) = (Uri -> Range -> Location) -> Range -> Uri -> Location
forall a b c. (a -> b -> c) -> b -> a -> c
flip Uri -> Range -> Location
Location Range
range (Uri -> Location) -> Maybe Uri -> Maybe Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Uri
mfile
  where
    range :: Range
range = Position -> Position -> Range
Range Position
start Position
end
    start :: Position
start = Int -> Int -> Position
Position (RefRow -> Int
refSLine RefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (RefRow -> Int
refSCol RefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    end :: Position
end = Int -> Int -> Position
Position (RefRow -> Int
refELine RefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (RefRow -> Int
refECol RefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    mfile :: Maybe Uri
mfile = case ModuleInfo -> Maybe FilePath
modInfoSrcFile ModuleInfo
info of
      Just FilePath
f  -> Uri -> Maybe Uri
forall a. a -> Maybe a
Just (Uri -> Maybe Uri) -> Uri -> Maybe Uri
forall a b. (a -> b) -> a -> b
$ FilePath -> Uri
toUri FilePath
f
      Maybe FilePath
Nothing -> Maybe Uri
forall a. Maybe a
Nothing

typeRowToLoc :: Res TypeRef -> Maybe Location
typeRowToLoc :: Res TypeRef -> Maybe Location
typeRowToLoc (TypeRef
row:.ModuleInfo
info) = do
  FilePath
file <- ModuleInfo -> Maybe FilePath
modInfoSrcFile ModuleInfo
info
  pure $ Uri -> Range -> Location
Location (FilePath -> Uri
toUri FilePath
file) Range
range
  where
    range :: Range
range = Position -> Position -> Range
Range Position
start Position
end
    start :: Position
start = Int -> Int -> Position
Position (TypeRef -> Int
typeRefSLine TypeRef
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (TypeRef -> Int
typeRefSCol TypeRef
row Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
    end :: Position
end = Int -> Int -> Position
Position (TypeRef -> Int
typeRefELine TypeRef
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (TypeRef -> Int
typeRefECol TypeRef
row Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

documentHighlight
  :: Monad m
  => HieASTs a
  -> RefMap a
  -> Position
  -> MaybeT m [DocumentHighlight]
documentHighlight :: HieASTs a -> RefMap a -> Position -> MaybeT m [DocumentHighlight]
documentHighlight HieASTs a
hf RefMap a
rf Position
pos = [DocumentHighlight] -> MaybeT m [DocumentHighlight]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [DocumentHighlight]
highlights
  where
    ns :: [Name]
ns = [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Name]] -> [Name]) -> [[Name]] -> [Name]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> (HieAST a -> [Name]) -> [[Name]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hf Position
pos ([Identifier] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Identifier] -> [Name])
-> (HieAST a -> [Identifier]) -> HieAST a -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Identifier (IdentifierDetails a) -> [Identifier]
forall k a. Map k a -> [k]
M.keys (Map Identifier (IdentifierDetails a) -> [Identifier])
-> (HieAST a -> Map Identifier (IdentifierDetails a))
-> HieAST a
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> Map Identifier (IdentifierDetails a)
forall a. HieAST a -> NodeIdentifiers a
getNodeIds)
    highlights :: [DocumentHighlight]
highlights = do
      Name
n <- [Name]
ns
      (Span, IdentifierDetails a)
ref <- [(Span, IdentifierDetails a)]
-> Maybe [(Span, IdentifierDetails a)]
-> [(Span, IdentifierDetails a)]
forall a. a -> Maybe a -> a
fromMaybe [] (Identifier -> RefMap a -> Maybe [(Span, IdentifierDetails a)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Identifier
forall a b. b -> Either a b
Right Name
n) RefMap a
rf)
      pure $ (Span, IdentifierDetails a) -> DocumentHighlight
forall a. (Span, IdentifierDetails a) -> DocumentHighlight
makeHighlight (Span, IdentifierDetails a)
ref
    makeHighlight :: (Span, IdentifierDetails a) -> DocumentHighlight
makeHighlight (Span
sp,IdentifierDetails a
dets) =
      Range -> Maybe DocumentHighlightKind -> DocumentHighlight
DocumentHighlight (Span -> Range
realSrcSpanToRange Span
sp) (DocumentHighlightKind -> Maybe DocumentHighlightKind
forall a. a -> Maybe a
Just (DocumentHighlightKind -> Maybe DocumentHighlightKind)
-> DocumentHighlightKind -> Maybe DocumentHighlightKind
forall a b. (a -> b) -> a -> b
$ Set ContextInfo -> DocumentHighlightKind
forall (t :: * -> *).
Foldable t =>
t ContextInfo -> DocumentHighlightKind
highlightType (Set ContextInfo -> DocumentHighlightKind)
-> Set ContextInfo -> DocumentHighlightKind
forall a b. (a -> b) -> a -> b
$ IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets)
    highlightType :: t ContextInfo -> DocumentHighlightKind
highlightType t ContextInfo
s =
      if (ContextInfo -> Bool) -> t ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Maybe [Scope] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Scope] -> Bool)
-> (ContextInfo -> Maybe [Scope]) -> ContextInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextInfo -> Maybe [Scope]
getScopeFromContext) t ContextInfo
s
        then DocumentHighlightKind
HkWrite
        else DocumentHighlightKind
HkRead

gotoTypeDefinition
  :: MonadIO m
  => HieDb
  -> LookupModule m
  -> IdeOptions
  -> HieAstResult
  -> Position
  -> MaybeT m [Location]
gotoTypeDefinition :: HieDb
-> LookupModule m
-> IdeOptions
-> HieAstResult
-> Position
-> MaybeT m [Location]
gotoTypeDefinition HieDb
hiedb LookupModule m
lookupModule IdeOptions
ideOpts HieAstResult
srcSpans Position
pos
  = m [Location] -> MaybeT m [Location]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Location] -> MaybeT m [Location])
-> m [Location] -> MaybeT m [Location]
forall a b. (a -> b) -> a -> b
$ HieDb
-> LookupModule m
-> IdeOptions
-> Position
-> HieAstResult
-> m [Location]
forall (m :: * -> *).
MonadIO m =>
HieDb
-> LookupModule m
-> IdeOptions
-> Position
-> HieAstResult
-> m [Location]
typeLocationsAtPoint HieDb
hiedb LookupModule m
lookupModule IdeOptions
ideOpts Position
pos HieAstResult
srcSpans

-- | Locate the definition of the name at a given position.
gotoDefinition
  :: MonadIO m
  => HieDb
  -> LookupModule m
  -> IdeOptions
  -> M.Map ModuleName NormalizedFilePath
  -> HieASTs a
  -> Position
  -> MaybeT m [Location]
gotoDefinition :: HieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> HieASTs a
-> Position
-> MaybeT m [Location]
gotoDefinition HieDb
hiedb LookupModule m
getHieFile IdeOptions
ideOpts Map ModuleName NormalizedFilePath
imports HieASTs a
srcSpans Position
pos
  = m [Location] -> MaybeT m [Location]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Location] -> MaybeT m [Location])
-> m [Location] -> MaybeT m [Location]
forall a b. (a -> b) -> a -> b
$ HieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs a
-> m [Location]
forall (m :: * -> *) a.
MonadIO m =>
HieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs a
-> m [Location]
locationsAtPoint HieDb
hiedb LookupModule m
getHieFile IdeOptions
ideOpts Map ModuleName NormalizedFilePath
imports Position
pos HieASTs a
srcSpans

-- | Synopsis for the name at a given position.
atPoint
  :: IdeOptions
  -> HieAstResult
  -> DocAndKindMap
  -> DynFlags
  -> Position
  -> Maybe (Maybe Range, [T.Text])
atPoint :: IdeOptions
-> HieAstResult
-> DocAndKindMap
-> DynFlags
-> Position
-> Maybe (Maybe Range, [Text])
atPoint IdeOptions{} (HAR Module
_ HieASTs a
hf RefMap a
_ Map Name [Span]
_ HieKind a
kind) (DKMap DocMap
dm KindMap
km) DynFlags
df Position
pos = [(Maybe Range, [Text])] -> Maybe (Maybe Range, [Text])
forall a. [a] -> Maybe a
listToMaybe ([(Maybe Range, [Text])] -> Maybe (Maybe Range, [Text]))
-> [(Maybe Range, [Text])] -> Maybe (Maybe Range, [Text])
forall a b. (a -> b) -> a -> b
$ HieASTs a
-> Position
-> (HieAST a -> (Maybe Range, [Text]))
-> [(Maybe Range, [Text])]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hf Position
pos HieAST a -> (Maybe Range, [Text])
hoverInfo
  where
    -- Hover info for values/data
    hoverInfo :: HieAST a -> (Maybe Range, [Text])
hoverInfo HieAST a
ast = (Range -> Maybe Range
forall a. a -> Maybe a
Just Range
range, [Text]
prettyNames [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
pTypes)
      where
        pTypes :: [Text]
pTypes
          | [(Identifier, IdentifierDetails a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
Prelude.length [(Identifier, IdentifierDetails a)]
names Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Text] -> [Text]
forall a. [a] -> [a]
dropEnd1 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapHaskell [Text]
prettyTypes
          | Bool
otherwise = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapHaskell [Text]
prettyTypes

        range :: Range
range = Span -> Range
realSrcSpanToRange (Span -> Range) -> Span -> Range
forall a b. (a -> b) -> a -> b
$ HieAST a -> Span
forall a. HieAST a -> Span
nodeSpan HieAST a
ast

        wrapHaskell :: a -> a
wrapHaskell a
x = a
"\n```haskell\n"a -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
xa -> a -> a
forall a. Semigroup a => a -> a -> a
<>a
"\n```\n"
        info :: NodeInfo a
info = HieKind a -> HieAST a -> NodeInfo a
forall a. HieKind a -> HieAST a -> NodeInfo a
nodeInfoH HieKind a
kind HieAST a
ast
        names :: [(Identifier, IdentifierDetails a)]
names = Map Identifier (IdentifierDetails a)
-> [(Identifier, IdentifierDetails a)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map Identifier (IdentifierDetails a)
 -> [(Identifier, IdentifierDetails a)])
-> Map Identifier (IdentifierDetails a)
-> [(Identifier, IdentifierDetails a)]
forall a b. (a -> b) -> a -> b
$ NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo a
info
        types :: [a]
types = NodeInfo a -> [a]
forall a. NodeInfo a -> [a]
nodeType NodeInfo a
info

        prettyNames :: [T.Text]
        prettyNames :: [Text]
prettyNames = ((Identifier, IdentifierDetails a) -> Text)
-> [(Identifier, IdentifierDetails a)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Identifier, IdentifierDetails a) -> Text
prettyName [(Identifier, IdentifierDetails a)]
names
        prettyName :: (Identifier, IdentifierDetails a) -> Text
prettyName (Right Name
n, IdentifierDetails a
dets) = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
          Text -> Text
forall a. (Semigroup a, IsString a) => a -> a
wrapHaskell (Name -> Text
forall a. Outputable a => a -> Text
showNameWithoutUniques Name
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) ((a -> Text
prettyType (a -> Text) -> Maybe a -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdentifierDetails a -> Maybe a
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails a
dets) Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
maybeKind))
          Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Name -> [Text]
definedAt Name
n
          [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Name -> Maybe Text
prettyPackageName Name
n)
          [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [ [Text] -> Text
T.unlines ([Text] -> Text) -> (SpanDoc -> [Text]) -> SpanDoc -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanDoc -> [Text]
spanDocToMarkdown (SpanDoc -> Text) -> Maybe SpanDoc -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DocMap -> Name -> Maybe SpanDoc
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv DocMap
dm Name
n
                       ]
          where maybeKind :: Maybe Text
maybeKind = (Type -> Text) -> Maybe Type -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Text
forall a. Outputable a => a -> Text
showGhc (Maybe Type -> Maybe Text) -> Maybe Type -> Maybe Text
forall a b. (a -> b) -> a -> b
$ TyThing -> Maybe Type
safeTyThingType (TyThing -> Maybe Type) -> Maybe TyThing -> Maybe Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KindMap -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv KindMap
km Name
n
        prettyName (Left ModuleName
m,IdentifierDetails a
_) = ModuleName -> Text
forall a. Outputable a => a -> Text
showGhc ModuleName
m

        prettyPackageName :: Name -> Maybe Text
prettyPackageName Name
n = do
          Module
m <- Name -> Maybe Module
nameModule_maybe Name
n
          let pid :: Unit
pid = Module -> Unit
moduleUnitId Module
m
          PackageConfig
conf <- DynFlags -> Unit -> Maybe PackageConfig
lookupPackage DynFlags
df Unit
pid
          let pkgName :: Text
pkgName = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ PackageConfig -> FilePath
packageNameString PackageConfig
conf
              version :: Text
version = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Version -> FilePath
showVersion (PackageConfig -> Version
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
packageVersion PackageConfig
conf)
          Text -> Maybe Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
" *(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pkgName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
version Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")*"

        prettyTypes :: [Text]
prettyTypes = (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"_ :: "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
prettyType) [a]
types
        prettyType :: a -> Text
prettyType a
t = case HieKind a
kind of
          HieKind a
HieFresh -> Type -> Text
forall a. Outputable a => a -> Text
showGhc a
Type
t
          HieFromDisk HieFile
full_file -> IfaceType -> Text
forall a. Outputable a => a -> Text
showGhc (IfaceType -> Text) -> IfaceType -> Text
forall a b. (a -> b) -> a -> b
$ HieTypeFix -> IfaceType
hieTypeToIface (HieTypeFix -> IfaceType) -> HieTypeFix -> IfaceType
forall a b. (a -> b) -> a -> b
$ Int -> Array Int HieTypeFlat -> HieTypeFix
recoverFullType a
Int
t (HieFile -> Array Int HieTypeFlat
hie_types HieFile
full_file)

        definedAt :: Name -> [Text]
definedAt Name
name =
          -- do not show "at <no location info>" and similar messages
          -- see the code of 'pprNameDefnLoc' for more information
          case Name -> SrcLoc
nameSrcLoc Name
name of
            UnhelpfulLoc {} | Name -> Bool
isInternalName Name
name Bool -> Bool -> Bool
|| Name -> Bool
isSystemName Name
name -> []
            SrcLoc
_ -> [Text
"*Defined " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (SDoc -> FilePath
showSDocUnsafe (SDoc -> FilePath) -> SDoc -> FilePath
forall a b. (a -> b) -> a -> b
$ Name -> SDoc
pprNameDefnLoc Name
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"]

typeLocationsAtPoint
  :: forall m
   . MonadIO m
  => HieDb
  -> LookupModule m
  -> IdeOptions
  -> Position
  -> HieAstResult
  -> m [Location]
typeLocationsAtPoint :: HieDb
-> LookupModule m
-> IdeOptions
-> Position
-> HieAstResult
-> m [Location]
typeLocationsAtPoint HieDb
hiedb LookupModule m
lookupModule IdeOptions
_ideOptions Position
pos (HAR Module
_ HieASTs a
ast RefMap a
_ Map Name [Span]
_ HieKind a
hieKind) =
  case HieKind a
hieKind of
    HieFromDisk HieFile
hf ->
      let arr :: Array Int HieTypeFlat
arr = HieFile -> Array Int HieTypeFlat
hie_types HieFile
hf
          ts :: [a]
ts = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> (HieAST a -> [a]) -> [[a]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
ast Position
pos HieAST a -> [a]
forall b. Ord b => HieAST b -> [b]
getts
          unfold :: [Int] -> [HieTypeFlat]
unfold = (Int -> HieTypeFlat) -> [Int] -> [HieTypeFlat]
forall a b. (a -> b) -> [a] -> [b]
map (Array Int HieTypeFlat
arr Array Int HieTypeFlat -> Int -> HieTypeFlat
forall i e. Ix i => Array i e -> i -> e
A.!)
          getts :: HieAST b -> [b]
getts HieAST b
x = NodeInfo b -> [b]
forall a. NodeInfo a -> [a]
nodeType NodeInfo b
ni  [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ ((IdentifierDetails b -> Maybe b) -> [IdentifierDetails b] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IdentifierDetails b -> Maybe b
forall a. IdentifierDetails a -> Maybe a
identType ([IdentifierDetails b] -> [b]) -> [IdentifierDetails b] -> [b]
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails b) -> [IdentifierDetails b]
forall k a. Map k a -> [a]
M.elems (Map Identifier (IdentifierDetails b) -> [IdentifierDetails b])
-> Map Identifier (IdentifierDetails b) -> [IdentifierDetails b]
forall a b. (a -> b) -> a -> b
$ NodeInfo b -> Map Identifier (IdentifierDetails b)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo b
ni)
            where ni :: NodeInfo b
ni = HieAST b -> NodeInfo b
forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo' HieAST b
x
          getTypes :: [Int] -> [Name]
getTypes [Int]
ts = ((HieTypeFlat -> [Name]) -> [HieTypeFlat] -> [Name])
-> [HieTypeFlat] -> (HieTypeFlat -> [Name]) -> [Name]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HieTypeFlat -> [Name]) -> [HieTypeFlat] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Int] -> [HieTypeFlat]
unfold [Int]
ts) ((HieTypeFlat -> [Name]) -> [Name])
-> (HieTypeFlat -> [Name]) -> [Name]
forall a b. (a -> b) -> a -> b
$ \case
            HTyVarTy Name
n -> [Name
n]
#if MIN_VERSION_ghc(8,8,0)
            HAppTy Int
a (HieArgs [(Bool, Int)]
xs) -> [Int] -> [Name]
getTypes (Int
a Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((Bool, Int) -> Int) -> [(Bool, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Int) -> Int
forall a b. (a, b) -> b
snd [(Bool, Int)]
xs)
#else
            HAppTy a b -> getTypes [a,b]
#endif
            HTyConApp IfaceTyCon
tc (HieArgs [(Bool, Int)]
xs) -> IfaceTyCon -> Name
ifaceTyConName IfaceTyCon
tc Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Int] -> [Name]
getTypes (((Bool, Int) -> Int) -> [(Bool, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Int) -> Int
forall a b. (a, b) -> b
snd [(Bool, Int)]
xs)
            HForAllTy ((Name, Int), ArgFlag)
_ Int
a -> [Int] -> [Name]
getTypes [Int
a]
#if MIN_VERSION_ghc(9,0,1)
            HFunTy a b c -> getTypes [a,b,c]
#else
            HFunTy Int
a Int
b -> [Int] -> [Name]
getTypes [Int
a,Int
b]
#endif
            HQualTy Int
a Int
b -> [Int] -> [Name]
getTypes [Int
a,Int
b]
            HCastTy Int
a -> [Int] -> [Name]
getTypes [Int
a]
            HieTypeFlat
_ -> []
        in ([Location] -> [Location]) -> m [Location] -> m [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Location] -> [Location]
forall a. Ord a => [a] -> [a]
nubOrd (m [Location] -> m [Location]) -> m [Location] -> m [Location]
forall a b. (a -> b) -> a -> b
$ (Name -> m [Location]) -> [Name] -> m [Location]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((Maybe [Location] -> [Location])
-> m (Maybe [Location]) -> m [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Location] -> Maybe [Location] -> [Location]
forall a. a -> Maybe a -> a
fromMaybe []) (m (Maybe [Location]) -> m [Location])
-> (Name -> m (Maybe [Location])) -> Name -> m [Location]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDb -> LookupModule m -> Name -> m (Maybe [Location])
forall (m :: * -> *).
MonadIO m =>
HieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation HieDb
hiedb LookupModule m
lookupModule) ([Int] -> [Name]
getTypes [a]
[Int]
ts)
    HieKind a
HieFresh ->
      let ts :: [a]
ts = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> (HieAST a -> [a]) -> [[a]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
ast Position
pos HieAST a -> [a]
forall b. HieAST b -> [b]
getts
          getts :: HieAST b -> [b]
getts HieAST b
x = NodeInfo b -> [b]
forall a. NodeInfo a -> [a]
nodeType NodeInfo b
ni  [b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++ ((IdentifierDetails b -> Maybe b) -> [IdentifierDetails b] -> [b]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IdentifierDetails b -> Maybe b
forall a. IdentifierDetails a -> Maybe a
identType ([IdentifierDetails b] -> [b]) -> [IdentifierDetails b] -> [b]
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails b) -> [IdentifierDetails b]
forall k a. Map k a -> [a]
M.elems (Map Identifier (IdentifierDetails b) -> [IdentifierDetails b])
-> Map Identifier (IdentifierDetails b) -> [IdentifierDetails b]
forall a b. (a -> b) -> a -> b
$ NodeInfo b -> Map Identifier (IdentifierDetails b)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo b
ni)
            where ni :: NodeInfo b
ni = HieAST b -> NodeInfo b
forall a. HieAST a -> NodeInfo a
nodeInfo HieAST b
x
        in ([Location] -> [Location]) -> m [Location] -> m [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Location] -> [Location]
forall a. Ord a => [a] -> [a]
nubOrd (m [Location] -> m [Location]) -> m [Location] -> m [Location]
forall a b. (a -> b) -> a -> b
$ (Name -> m [Location]) -> [Name] -> m [Location]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM ((Maybe [Location] -> [Location])
-> m (Maybe [Location]) -> m [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Location] -> Maybe [Location] -> [Location]
forall a. a -> Maybe a -> a
fromMaybe []) (m (Maybe [Location]) -> m [Location])
-> (Name -> m (Maybe [Location])) -> Name -> m [Location]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieDb -> LookupModule m -> Name -> m (Maybe [Location])
forall (m :: * -> *).
MonadIO m =>
HieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation HieDb
hiedb LookupModule m
lookupModule) ([Type] -> [Name]
getTypes [a]
[Type]
ts)

namesInType :: Type -> [Name]
namesInType :: Type -> [Name]
namesInType (TyVarTy Var
n)      = [Var -> Name
Var.varName Var
n]
namesInType (AppTy Type
a Type
b)      = [Type] -> [Name]
getTypes [Type
a,Type
b]
namesInType (TyConApp TyCon
tc [Type]
ts) = TyCon -> Name
tyConName TyCon
tc Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: [Type] -> [Name]
getTypes [Type]
ts
namesInType (ForAllTy TyCoVarBinder
b Type
t)   = Var -> Name
Var.varName (TyCoVarBinder -> Var
forall tv argf. VarBndr tv argf -> tv
binderVar TyCoVarBinder
b) Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: Type -> [Name]
namesInType Type
t
namesInType (FunTy Type
a Type
b)      = [Type] -> [Name]
getTypes [Type
a,Type
b]
namesInType (CastTy Type
t KindCoercion
_)     = Type -> [Name]
namesInType Type
t
namesInType (LitTy TyLit
_)        = []
namesInType Type
_                = []

getTypes :: [Type] -> [Name]
getTypes :: [Type] -> [Name]
getTypes [Type]
ts = (Type -> [Name]) -> [Type] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Type -> [Name]
namesInType [Type]
ts

locationsAtPoint
  :: forall m a
   . MonadIO m
  => HieDb
  -> LookupModule m
  -> IdeOptions
  -> M.Map ModuleName NormalizedFilePath
  -> Position
  -> HieASTs a
  -> m [Location]
locationsAtPoint :: HieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs a
-> m [Location]
locationsAtPoint HieDb
hiedb LookupModule m
lookupModule IdeOptions
_ideOptions Map ModuleName NormalizedFilePath
imports Position
pos HieASTs a
ast =
  let ns :: [Identifier]
ns = [[Identifier]] -> [Identifier]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Identifier]] -> [Identifier]) -> [[Identifier]] -> [Identifier]
forall a b. (a -> b) -> a -> b
$ HieASTs a
-> Position -> (HieAST a -> [Identifier]) -> [[Identifier]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
ast Position
pos (Map Identifier (IdentifierDetails a) -> [Identifier]
forall k a. Map k a -> [k]
M.keys (Map Identifier (IdentifierDetails a) -> [Identifier])
-> (HieAST a -> Map Identifier (IdentifierDetails a))
-> HieAST a
-> [Identifier]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> Map Identifier (IdentifierDetails a)
forall a. HieAST a -> NodeIdentifiers a
getNodeIds)
      zeroPos :: Position
zeroPos = Int -> Int -> Position
Position Int
0 Int
0
      zeroRange :: Range
zeroRange = Position -> Position -> Range
Range Position
zeroPos Position
zeroPos
      modToLocation :: ModuleName -> Maybe [Location]
modToLocation ModuleName
m = (NormalizedFilePath -> [Location])
-> Maybe NormalizedFilePath -> Maybe [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NormalizedFilePath
fs -> Location -> [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Location -> [Location]) -> Location -> [Location]
forall a b. (a -> b) -> a -> b
$ Uri -> Range -> Location
Location (NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri) -> NormalizedUri -> Uri
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> NormalizedUri
filePathToUri' NormalizedFilePath
fs) Range
zeroRange) (Maybe NormalizedFilePath -> Maybe [Location])
-> Maybe NormalizedFilePath -> Maybe [Location]
forall a b. (a -> b) -> a -> b
$ ModuleName
-> Map ModuleName NormalizedFilePath -> Maybe NormalizedFilePath
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ModuleName
m Map ModuleName NormalizedFilePath
imports
    in ([[Location]] -> [Location]) -> m [[Location]] -> m [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Location] -> [Location]
forall a. Ord a => [a] -> [a]
nubOrd ([Location] -> [Location])
-> ([[Location]] -> [Location]) -> [[Location]] -> [Location]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Location]] -> [Location]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (m [[Location]] -> m [Location]) -> m [[Location]] -> m [Location]
forall a b. (a -> b) -> a -> b
$ (Identifier -> m (Maybe [Location]))
-> [Identifier] -> m [[Location]]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM ((ModuleName -> m (Maybe [Location]))
-> (Name -> m (Maybe [Location]))
-> Identifier
-> m (Maybe [Location])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe [Location] -> m (Maybe [Location])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Location] -> m (Maybe [Location]))
-> (ModuleName -> Maybe [Location])
-> ModuleName
-> m (Maybe [Location])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> Maybe [Location]
modToLocation) ((Name -> m (Maybe [Location]))
 -> Identifier -> m (Maybe [Location]))
-> (Name -> m (Maybe [Location]))
-> Identifier
-> m (Maybe [Location])
forall a b. (a -> b) -> a -> b
$ HieDb -> LookupModule m -> Name -> m (Maybe [Location])
forall (m :: * -> *).
MonadIO m =>
HieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation HieDb
hiedb LookupModule m
lookupModule) [Identifier]
ns

-- | Given a 'Name' attempt to find the location where it is defined.
nameToLocation :: MonadIO m => HieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation :: HieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation HieDb
hiedb LookupModule m
lookupModule Name
name = MaybeT m [Location] -> m (Maybe [Location])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m [Location] -> m (Maybe [Location]))
-> MaybeT m [Location] -> m (Maybe [Location])
forall a b. (a -> b) -> a -> b
$
  case Name -> SrcSpan
nameSrcSpan Name
name of
    sp :: SrcSpan
sp@(OldRealSrcSpan Span
rsp)
      -- Lookup in the db if we got a location in a boot file
      | FilePath
fs <- FastString -> FilePath
unpackFS (Span -> FastString
srcSpanFile Span
rsp)
      , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"boot" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fs
      -> do
          Bool
itExists <- IO Bool -> MaybeT m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> MaybeT m Bool) -> IO Bool -> MaybeT m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist FilePath
fs
          if Bool
itExists
              then m (Maybe [Location]) -> MaybeT m [Location]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe [Location]) -> MaybeT m [Location])
-> m (Maybe [Location]) -> MaybeT m [Location]
forall a b. (a -> b) -> a -> b
$ Maybe [Location] -> m (Maybe [Location])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe [Location] -> m (Maybe [Location]))
-> Maybe [Location] -> m (Maybe [Location])
forall a b. (a -> b) -> a -> b
$ (Location -> [Location]) -> Maybe Location -> Maybe [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> [Location]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Location -> Maybe [Location])
-> Maybe Location -> Maybe [Location]
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Location
srcSpanToLocation SrcSpan
sp
              -- When reusing .hie files from a cloud cache,
              -- the paths may not match the local file system.
              -- Let's fall back to the hiedb in case it contains local paths
              else SrcSpan -> MaybeT m [Location]
fallbackToDb SrcSpan
sp
    SrcSpan
sp -> SrcSpan -> MaybeT m [Location]
fallbackToDb SrcSpan
sp
  where
    fallbackToDb :: SrcSpan -> MaybeT m [Location]
fallbackToDb SrcSpan
sp = do
      Bool -> MaybeT m ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (SrcSpan
sp SrcSpan -> SrcSpan -> Bool
forall a. Eq a => a -> a -> Bool
/= SrcSpan
wiredInSrcSpan)
      -- This case usually arises when the definition is in an external package.
      -- In this case the interface files contain garbage source spans
      -- so we instead read the .hie files to get useful source spans.
      Module
mod <- m (Maybe Module) -> MaybeT m Module
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe Module) -> MaybeT m Module)
-> m (Maybe Module) -> MaybeT m Module
forall a b. (a -> b) -> a -> b
$ Maybe Module -> m (Maybe Module)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Module -> m (Maybe Module))
-> Maybe Module -> m (Maybe Module)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Module
nameModule_maybe Name
name
      [Res DefRow]
erow <- IO [Res DefRow] -> MaybeT m [Res DefRow]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Res DefRow] -> MaybeT m [Res DefRow])
-> IO [Res DefRow] -> MaybeT m [Res DefRow]
forall a b. (a -> b) -> a -> b
$ HieDb
-> OccName -> Maybe ModuleName -> Maybe Unit -> IO [Res DefRow]
findDef HieDb
hiedb (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod) (Unit -> Maybe Unit
forall a. a -> Maybe a
Just (Unit -> Maybe Unit) -> Unit -> Maybe Unit
forall a b. (a -> b) -> a -> b
$ Module -> Unit
moduleUnitId Module
mod)
      case [Res DefRow]
erow of
        [] -> do
          -- If the lookup failed, try again without specifying a unit-id.
          -- This is a hack to make find definition work better with ghcide's nascent multi-component support,
          -- where names from a component that has been indexed in a previous session but not loaded in this
          -- session may end up with different unit ids
          [Res DefRow]
erow <- IO [Res DefRow] -> MaybeT m [Res DefRow]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Res DefRow] -> MaybeT m [Res DefRow])
-> IO [Res DefRow] -> MaybeT m [Res DefRow]
forall a b. (a -> b) -> a -> b
$ HieDb
-> OccName -> Maybe ModuleName -> Maybe Unit -> IO [Res DefRow]
findDef HieDb
hiedb (Name -> OccName
nameOccName Name
name) (ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just (ModuleName -> Maybe ModuleName) -> ModuleName -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Module -> ModuleName
moduleName Module
mod) Maybe Unit
forall a. Maybe a
Nothing
          case [Res DefRow]
erow of
            [] -> m (Maybe [Location]) -> MaybeT m [Location]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe [Location]) -> MaybeT m [Location])
-> m (Maybe [Location]) -> MaybeT m [Location]
forall a b. (a -> b) -> a -> b
$ Maybe [Location] -> m (Maybe [Location])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Location]
forall a. Maybe a
Nothing
            [Res DefRow]
xs -> m [Location] -> MaybeT m [Location]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Location] -> MaybeT m [Location])
-> m [Location] -> MaybeT m [Location]
forall a b. (a -> b) -> a -> b
$ (Res DefRow -> m (Maybe Location)) -> [Res DefRow] -> m [Location]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (MaybeT m Location -> m (Maybe Location)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Location -> m (Maybe Location))
-> (Res DefRow -> MaybeT m Location)
-> Res DefRow
-> m (Maybe Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LookupModule m -> Res DefRow -> MaybeT m Location
forall (m :: * -> *).
Monad m =>
LookupModule m -> Res DefRow -> MaybeT m Location
defRowToLocation LookupModule m
lookupModule) [Res DefRow]
xs
        [Res DefRow]
xs -> m [Location] -> MaybeT m [Location]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Location] -> MaybeT m [Location])
-> m [Location] -> MaybeT m [Location]
forall a b. (a -> b) -> a -> b
$ (Res DefRow -> m (Maybe Location)) -> [Res DefRow] -> m [Location]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (MaybeT m Location -> m (Maybe Location)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Location -> m (Maybe Location))
-> (Res DefRow -> MaybeT m Location)
-> Res DefRow
-> m (Maybe Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LookupModule m -> Res DefRow -> MaybeT m Location
forall (m :: * -> *).
Monad m =>
LookupModule m -> Res DefRow -> MaybeT m Location
defRowToLocation LookupModule m
lookupModule) [Res DefRow]
xs

defRowToLocation :: Monad m => LookupModule m -> Res DefRow -> MaybeT m Location
defRowToLocation :: LookupModule m -> Res DefRow -> MaybeT m Location
defRowToLocation LookupModule m
lookupModule (DefRow
row:.ModuleInfo
info) = do
  let start :: Position
start = Int -> Int -> Position
Position (DefRow -> Int
defSLine DefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (DefRow -> Int
defSCol DefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      end :: Position
end   = Int -> Int -> Position
Position (DefRow -> Int
defELine DefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (DefRow -> Int
defECol DefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      range :: Range
range = Position -> Position -> Range
Range Position
start Position
end
  Uri
file <- case ModuleInfo -> Maybe FilePath
modInfoSrcFile ModuleInfo
info of
    Just FilePath
src -> Uri -> MaybeT m Uri
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Uri -> MaybeT m Uri) -> Uri -> MaybeT m Uri
forall a b. (a -> b) -> a -> b
$ FilePath -> Uri
toUri FilePath
src
    Maybe FilePath
Nothing -> LookupModule m
lookupModule (DefRow -> FilePath
defSrc DefRow
row) (ModuleInfo -> ModuleName
modInfoName ModuleInfo
info) (ModuleInfo -> Unit
modInfoUnit ModuleInfo
info) (ModuleInfo -> Bool
modInfoIsBoot ModuleInfo
info)
  pure $ Uri -> Range -> Location
Location Uri
file Range
range

toUri :: FilePath -> Uri
toUri :: FilePath -> Uri
toUri = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri)
-> (FilePath -> NormalizedUri) -> FilePath -> Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> NormalizedUri
filePathToUri' (NormalizedFilePath -> NormalizedUri)
-> (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> NormalizedFilePath
toNormalizedFilePath'

defRowToSymbolInfo :: Res DefRow -> Maybe SymbolInformation
defRowToSymbolInfo :: Res DefRow -> Maybe SymbolInformation
defRowToSymbolInfo (DefRow{Int
FilePath
OccName
defNameOcc :: DefRow -> OccName
defECol :: Int
defELine :: Int
defSCol :: Int
defSLine :: Int
defNameOcc :: OccName
defSrc :: FilePath
defSrc :: DefRow -> FilePath
defECol :: DefRow -> Int
defELine :: DefRow -> Int
defSCol :: DefRow -> Int
defSLine :: DefRow -> Int
..}:.(ModuleInfo -> Maybe FilePath
modInfoSrcFile -> Just FilePath
srcFile))
  = SymbolInformation -> Maybe SymbolInformation
forall a. a -> Maybe a
Just (SymbolInformation -> Maybe SymbolInformation)
-> SymbolInformation -> Maybe SymbolInformation
forall a b. (a -> b) -> a -> b
$ Text
-> SymbolKind
-> Maybe (List SymbolTag)
-> Maybe Bool
-> Location
-> Maybe Text
-> SymbolInformation
SymbolInformation (OccName -> Text
forall a. Outputable a => a -> Text
showGhc OccName
defNameOcc) SymbolKind
kind Maybe (List SymbolTag)
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Location
loc Maybe Text
forall a. Maybe a
Nothing
  where
    kind :: SymbolKind
kind
      | OccName -> Bool
isVarOcc OccName
defNameOcc = SymbolKind
SkVariable
      | OccName -> Bool
isDataOcc OccName
defNameOcc = SymbolKind
SkConstructor
      | OccName -> Bool
isTcOcc OccName
defNameOcc = SymbolKind
SkStruct
      | Bool
otherwise = Scientific -> SymbolKind
SkUnknown Scientific
1
    loc :: Location
loc   = Uri -> Range -> Location
Location Uri
file Range
range
    file :: Uri
file  = NormalizedUri -> Uri
fromNormalizedUri (NormalizedUri -> Uri)
-> (FilePath -> NormalizedUri) -> FilePath -> Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> NormalizedUri
filePathToUri' (NormalizedFilePath -> NormalizedUri)
-> (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> NormalizedFilePath
toNormalizedFilePath' (FilePath -> Uri) -> FilePath -> Uri
forall a b. (a -> b) -> a -> b
$ FilePath
srcFile
    range :: Range
range = Position -> Position -> Range
Range Position
start Position
end
    start :: Position
start = Int -> Int -> Position
Position (Int
defSLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
defSCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    end :: Position
end   = Int -> Int -> Position
Position (Int
defELine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
defECol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
defRowToSymbolInfo Res DefRow
_ = Maybe SymbolInformation
forall a. Maybe a
Nothing

pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand :: HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs t
hf Position
pos HieAST t -> a
k =
    [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a]) -> [Maybe a] -> [a]
forall a b. (a -> b) -> a -> b
$ Map FastString (Maybe a) -> [Maybe a]
forall k a. Map k a -> [a]
M.elems (Map FastString (Maybe a) -> [Maybe a])
-> Map FastString (Maybe a) -> [Maybe a]
forall a b. (a -> b) -> a -> b
$ ((FastString -> HieAST t -> Maybe a)
 -> Map FastString (HieAST t) -> Map FastString (Maybe a))
-> Map FastString (HieAST t)
-> (FastString -> HieAST t -> Maybe a)
-> Map FastString (Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FastString -> HieAST t -> Maybe a)
-> Map FastString (HieAST t) -> Map FastString (Maybe a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (HieASTs t -> Map FastString (HieAST t)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts HieASTs t
hf) ((FastString -> HieAST t -> Maybe a) -> Map FastString (Maybe a))
-> (FastString -> HieAST t -> Maybe a) -> Map FastString (Maybe a)
forall a b. (a -> b) -> a -> b
$ \FastString
fs HieAST t
ast ->
      case Span -> HieAST t -> Maybe (HieAST t)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining (FastString -> Span
sp FastString
fs) HieAST t
ast of
        Maybe (HieAST t)
Nothing   -> Maybe a
forall a. Maybe a
Nothing
        Just HieAST t
ast' -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ HieAST t -> a
k HieAST t
ast'
 where
   sloc :: FastString -> RealSrcLoc
sloc FastString
fs = FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
fs (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int
chaInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
   sp :: FastString -> Span
sp FastString
fs = RealSrcLoc -> RealSrcLoc -> Span
mkRealSrcSpan (FastString -> RealSrcLoc
sloc FastString
fs) (FastString -> RealSrcLoc
sloc FastString
fs)
   line :: Int
line = Position -> Int
_line Position
pos
   cha :: Int
cha = Position -> Int
_character Position
pos

-- In ghc9, nodeInfo is monomorphic, so we need a case split here
nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a
nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a
nodeInfoH (HieFromDisk HieFile
_) = HieAST a -> NodeInfo a
forall a. Ord a => HieAST a -> NodeInfo a
nodeInfo'
nodeInfoH HieKind a
HieFresh        = HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo