{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
module Development.IDE.Spans.AtPoint (
atPoint
, gotoDefinition
, gotoTypeDefinition
, documentHighlight
, pointCommand
, referencesAtPoint
, computeTypeReferences
, FOIReferences(..)
, defRowToSymbolInfo
, getNamesAtPoint
, toCurrentLocation
, rowToLoc
, nameToLocation
, LookupModule
) where
import Development.IDE.GHC.Error
import Development.IDE.GHC.Orphans ()
import Development.IDE.Types.Location
import Language.LSP.Protocol.Types hiding
(SemanticTokenAbsolute (..))
import Prelude hiding (mod)
import Development.IDE.Core.PositionMapping
import Development.IDE.Core.RuleTypes
import Development.IDE.GHC.Compat
import qualified Development.IDE.GHC.Compat.Util as Util
import Development.IDE.GHC.Util (printOutputable)
import Development.IDE.Spans.Common
import Development.IDE.Types.Options
import Control.Applicative
import Control.Monad.Extra
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.Trans.Maybe
import Data.Coerce (coerce)
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 Development.IDE.Types.Shake (WithHieDb)
import HieDb hiding (pointCommand,
withHieDb)
import System.Directory (doesFileExist)
type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri
newtype FOIReferences = FOIReferences (HM.HashMap NormalizedFilePath (HieAstResult, PositionMapping))
computeTypeReferences :: Foldable f => f (HieAST Type) -> M.Map Name [Span]
computeTypeReferences :: forall (f :: * -> *).
Foldable f =>
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 a b. (a -> b -> b) -> b -> f a -> b
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 a b. Maybe a -> Maybe b -> Maybe b
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
nodeInfo HieAST Type
ast
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]
getNamesAtPoint 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
goMapping) [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)] -> [Location])
-> [[(Span, IdentifierDetails a)]] -> [Location]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Span, IdentifierDetails a) -> Maybe Location)
-> [(Span, IdentifierDetails a)] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
goMapping (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))
((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] -> [Location]) -> [[Span]] -> [Location]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Span -> Maybe Location) -> [Span] -> [Location]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (PositionMapping -> Location -> Maybe Location
toCurrentLocation PositionMapping
goMapping (Location -> Maybe Location)
-> (Span -> Location) -> Span -> Maybe Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Span -> Location
realSrcSpanToLocation))
((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)
getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name]
getNamesAtPoint :: forall a. HieASTs a -> Position -> PositionMapping -> [Name]
getNamesAtPoint 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 -> Map Identifier (IdentifierDetails 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
=> WithHieDb
-> NormalizedFilePath
-> Position
-> FOIReferences
-> m [Location]
referencesAtPoint :: forall (m :: * -> *).
MonadIO m =>
WithHieDb
-> NormalizedFilePath -> Position -> FOIReferences -> m [Location]
referencesAtPoint WithHieDb
withHieDb NormalizedFilePath
nfp Position
pos FOIReferences
refs = do
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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Just Module
mod -> do
[Res RefRow]
rows <- IO [Res RefRow] -> m [Res RefRow]
forall a. IO a -> m a
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 -> IO [Res RefRow]) -> IO [Res RefRow]
WithHieDb
withHieDb (\HieDb
hieDb -> 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
forall unit. GenModule unit -> 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
forall unit. GenModule unit -> unit
moduleUnit Module
mod) [FilePath]
exclude)
[Location] -> m [Location]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> m [Location]) -> [Location] -> m [Location]
forall a b. (a -> b) -> a -> b
$ (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 a. IO a -> m a
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 -> IO [Res TypeRef]) -> IO [Res TypeRef]
WithHieDb
withHieDb (\HieDb
hieDb -> 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
forall unit. GenModule unit -> 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
forall unit. GenModule unit -> unit
moduleUnit Module
mod) [FilePath]
exclude)
[Location] -> m [Location]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> m [Location]) -> [Location] -> m [Location]
forall a b. (a -> b) -> a -> b
$ (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 a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
[Location] -> m [Location]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> m [Location]) -> [Location] -> m [Location]
forall a b. (a -> b) -> a -> b
$ [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 = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ RefRow -> Int
refSLine RefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ RefRow -> Int
refSCol RefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
end :: Position
end = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ RefRow -> Int
refELine RefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ 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
Location -> Maybe Location
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Location -> Maybe Location) -> Location -> Maybe Location
forall a b. (a -> b) -> a -> b
$ 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 = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ TypeRef -> Int
typeRefSLine TypeRef
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ TypeRef -> Int
typeRefSCol TypeRef
row Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
end :: Position
end = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ TypeRef -> Int
typeRefELine TypeRef
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *) a.
Monad m =>
HieASTs a -> RefMap a -> Position -> MaybeT m [DocumentHighlight]
documentHighlight HieASTs a
hf RefMap a
rf Position
pos = [DocumentHighlight] -> MaybeT m [DocumentHighlight]
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [DocumentHighlight]
highlights
where
notEvidence :: IdentifierDetails a -> Bool
notEvidence = Bool -> Bool
not (Bool -> Bool)
-> (IdentifierDetails a -> Bool) -> IdentifierDetails a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceContext (Set ContextInfo -> Bool)
-> (IdentifierDetails a -> Set ContextInfo)
-> IdentifierDetails a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo
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
. (IdentifierDetails a -> Bool)
-> Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter IdentifierDetails a -> Bool
forall {a}. IdentifierDetails a -> Bool
notEvidence (Map Identifier (IdentifierDetails a)
-> Map Identifier (IdentifierDetails a))
-> (HieAST a -> Map Identifier (IdentifierDetails a))
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> Map Identifier (IdentifierDetails a)
forall a. HieAST a -> Map Identifier (IdentifierDetails a)
getSourceNodeIds)
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)
DocumentHighlight -> [DocumentHighlight]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DocumentHighlight -> [DocumentHighlight])
-> DocumentHighlight -> [DocumentHighlight]
forall a b. (a -> b) -> a -> b
$ (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
DocumentHighlightKind_Write
else DocumentHighlightKind
DocumentHighlightKind_Read
gotoTypeDefinition
:: MonadIO m
=> WithHieDb
-> LookupModule m
-> IdeOptions
-> HieAstResult
-> Position
-> MaybeT m [Location]
gotoTypeDefinition :: forall (m :: * -> *).
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> HieAstResult
-> Position
-> MaybeT m [Location]
gotoTypeDefinition WithHieDb
withHieDb LookupModule m
lookupModule IdeOptions
ideOpts HieAstResult
srcSpans Position
pos
= m [Location] -> MaybeT m [Location]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
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
$ WithHieDb
-> LookupModule m
-> IdeOptions
-> Position
-> HieAstResult
-> m [Location]
forall (m :: * -> *).
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> Position
-> HieAstResult
-> m [Location]
typeLocationsAtPoint (HieDb -> IO a) -> IO a
WithHieDb
withHieDb LookupModule m
lookupModule IdeOptions
ideOpts Position
pos HieAstResult
srcSpans
gotoDefinition
:: MonadIO m
=> WithHieDb
-> LookupModule m
-> IdeOptions
-> M.Map ModuleName NormalizedFilePath
-> HieASTs a
-> Position
-> MaybeT m [Location]
gotoDefinition :: forall (m :: * -> *) a.
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> HieASTs a
-> Position
-> MaybeT m [Location]
gotoDefinition WithHieDb
withHieDb LookupModule m
getHieFile IdeOptions
ideOpts Map ModuleName NormalizedFilePath
imports HieASTs a
srcSpans Position
pos
= m [Location] -> MaybeT m [Location]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
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
$ WithHieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs a
-> m [Location]
forall (m :: * -> *) a.
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs a
-> m [Location]
locationsAtPoint (HieDb -> IO a) -> IO a
WithHieDb
withHieDb LookupModule m
getHieFile IdeOptions
ideOpts Map ModuleName NormalizedFilePath
imports Position
pos HieASTs a
srcSpans
atPoint
:: IdeOptions
-> HieAstResult
-> DocAndTyThingMap
-> HscEnv
-> Position
-> IO (Maybe (Maybe Range, [T.Text]))
atPoint :: IdeOptions
-> HieAstResult
-> DocAndTyThingMap
-> HscEnv
-> Position
-> IO (Maybe (Maybe Range, [Text]))
atPoint IdeOptions{} (HAR Module
_ HieASTs a
hf RefMap a
_ Map Name [Span]
_ (HieKind a
kind :: HieKind hietype)) (DKMap DocMap
dm TyThingMap
km) HscEnv
env Position
pos =
[(Maybe Range, [Text])] -> Maybe (Maybe Range, [Text])
forall a. [a] -> Maybe a
listToMaybe ([(Maybe Range, [Text])] -> Maybe (Maybe Range, [Text]))
-> IO [(Maybe Range, [Text])] -> IO (Maybe (Maybe Range, [Text]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO (Maybe Range, [Text])] -> IO [(Maybe Range, [Text])]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (HieASTs a
-> Position
-> (HieAST a -> IO (Maybe Range, [Text]))
-> [IO (Maybe Range, [Text])]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
hf Position
pos HieAST a -> IO (Maybe Range, [Text])
hoverInfo)
where
hoverInfo :: HieAST hietype -> IO (Maybe Range, [T.Text])
hoverInfo :: HieAST a -> IO (Maybe Range, [Text])
hoverInfo HieAST a
ast = do
[Text]
prettyNames <- ((Identifier, IdentifierDetails a) -> IO Text)
-> [(Identifier, IdentifierDetails a)] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Identifier, IdentifierDetails a) -> IO Text
prettyName [(Identifier, IdentifierDetails a)]
filteredNames
(Maybe Range, [Text]) -> IO (Maybe Range, [Text])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 :: [T.Text]
pTypes :: [Text]
pTypes
| [(Identifier, IdentifierDetails a)] -> Int
forall a. [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
wrapHaskell [Text]
prettyTypes
| Bool
otherwise = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
wrapHaskell [Text]
prettyTypes
range :: Range
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 :: T.Text -> T.Text
wrapHaskell :: Text -> Text
wrapHaskell Text
x = Text
"\n```haskell\n"Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
xText -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"\n```\n"
info :: NodeInfo hietype
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 hietype)]
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
isInternal :: (Identifier, IdentifierDetails a) -> Bool
isInternal :: forall a. (Identifier, IdentifierDetails a) -> Bool
isInternal (Right Name
_, IdentifierDetails a
dets) =
(ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ContextInfo -> Bool
isEvidenceContext (Set ContextInfo -> Bool) -> Set ContextInfo -> Bool
forall a b. (a -> b) -> a -> b
$ IdentifierDetails a -> Set ContextInfo
forall a. IdentifierDetails a -> Set ContextInfo
identInfo IdentifierDetails a
dets
isInternal (Left ModuleName
_, IdentifierDetails a
_) = Bool
False
filteredNames :: [(Identifier, IdentifierDetails hietype)]
filteredNames :: [(Identifier, IdentifierDetails a)]
filteredNames = ((Identifier, IdentifierDetails a) -> Bool)
-> [(Identifier, IdentifierDetails a)]
-> [(Identifier, IdentifierDetails a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((Identifier, IdentifierDetails a) -> Bool)
-> (Identifier, IdentifierDetails a)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identifier, IdentifierDetails a) -> Bool
forall a. (Identifier, IdentifierDetails a) -> Bool
isInternal) [(Identifier, IdentifierDetails a)]
names
prettyName :: (Either ModuleName Name, IdentifierDetails hietype) -> IO T.Text
prettyName :: (Identifier, IdentifierDetails a) -> IO Text
prettyName (Right Name
n, IdentifierDetails a
dets) = Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
Text -> Text
wrapHaskell (Name -> Text
forall a. Outputable a => a -> Text
printOutputable 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
" :: " <>) ((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 a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
maybeKind))
Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Maybe Text -> [Text]
forall a. Maybe a -> [a]
maybeToList (Maybe Text -> Maybe Text -> Maybe Text
forall {a}.
(Semigroup a, IsString a) =>
Maybe a -> Maybe a -> Maybe a
pretty (Name -> Maybe Text
definedAt Name
n) (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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> Text
forall a. Outputable a => a -> Text
printOutputable (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
=<< TyThingMap -> Name -> Maybe TyThing
forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv TyThingMap
km Name
n
pretty :: Maybe a -> Maybe a -> Maybe a
pretty Maybe a
Nothing Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
pretty (Just a
define) Maybe a
Nothing = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
define a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\n"
pretty Maybe a
Nothing (Just a
pkgName) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
pkgName a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\n"
pretty (Just a
define) (Just a
pkgName) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
define a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
pkgName a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\n"
prettyName (Left ModuleName
m,IdentifierDetails a
_) = ModuleName -> IO Text
packageNameForImportStatement ModuleName
m
prettyPackageName :: Name -> Maybe T.Text
prettyPackageName :: Name -> Maybe Text
prettyPackageName Name
n = do
Module
m <- Name -> Maybe Module
nameModule_maybe Name
n
Text
pkgTxt <- Module -> Maybe Text
packageNameWithVersion Module
m
Text -> Maybe Text
forall a. a -> Maybe a
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
pkgTxt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")*"
packageNameForImportStatement :: ModuleName -> IO T.Text
packageNameForImportStatement :: ModuleName -> IO Text
packageNameForImportStatement ModuleName
mod = do
Maybe Module
mpkg <- HscEnv -> ModuleName -> IO (Maybe Module)
findImportedModule HscEnv
env ModuleName
mod :: IO (Maybe Module)
let moduleName :: Text
moduleName = ModuleName -> Text
forall a. Outputable a => a -> Text
printOutputable ModuleName
mod
case Maybe Module
mpkg Maybe Module -> (Module -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Module -> Maybe Text
packageNameWithVersion of
Maybe Text
Nothing -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
moduleName
Just Text
pkgWithVersion -> Text -> IO Text
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> IO Text) -> Text -> IO Text
forall a b. (a -> b) -> a -> b
$ Text
moduleName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
pkgWithVersion
packageNameWithVersion :: Module -> Maybe T.Text
packageNameWithVersion :: Module -> Maybe Text
packageNameWithVersion Module
m = do
let pid :: Unit
pid = Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m
UnitInfo
conf <- HscEnv -> Unit -> Maybe UnitInfo
lookupUnit HscEnv
env Unit
pid
let pkgName :: Text
pkgName = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ UnitInfo -> FilePath
forall u. GenUnitInfo u -> FilePath
unitPackageNameString UnitInfo
conf
version :: Text
version = FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Version -> FilePath
showVersion (UnitInfo -> Version
forall srcpkgid srcpkgname uid modulename mod.
GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Version
unitPackageVersion UnitInfo
conf)
Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ 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
types :: [hietype]
types :: [a]
types = NodeInfo a -> [a]
forall a. NodeInfo a -> [a]
nodeType NodeInfo a
info
prettyTypes :: [T.Text]
prettyTypes :: [Text]
prettyTypes = (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"_ :: "<>) (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
prettyType) [a]
types
prettyType :: hietype -> T.Text
prettyType :: a -> Text
prettyType a
t = case HieKind a
kind of
HieKind a
HieFresh -> a -> Text
forall a. Outputable a => a -> Text
printOutputable a
t
HieFromDisk HieFile
full_file -> IfaceType -> Text
forall a. Outputable a => a -> Text
printOutputable (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 -> Maybe T.Text
definedAt :: Name -> Maybe Text
definedAt Name
name =
case Name -> SrcLoc
nameSrcLoc Name
name of
UnhelpfulLoc {} | Name -> Bool
isInternalName Name
name Bool -> Bool -> Bool
|| Name -> Bool
isSystemName Name
name -> Maybe Text
forall a. Maybe a
Nothing
SrcLoc
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
"*Defined " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> SDoc -> Text
forall a. Outputable a => a -> Text
printOutputable (Name -> SDoc
pprNameDefnLoc Name
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"*"
typeLocationsAtPoint
:: forall m
. MonadIO m
=> WithHieDb
-> LookupModule m
-> IdeOptions
-> Position
-> HieAstResult
-> m [Location]
typeLocationsAtPoint :: forall (m :: * -> *).
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> Position
-> HieAstResult
-> m [Location]
typeLocationsAtPoint WithHieDb
withHieDb 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 :: [Int]
ts = [[Int]] -> [Int]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Int]] -> [Int]) -> [[Int]] -> [Int]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> (HieAST a -> [Int]) -> [[Int]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
ast Position
pos HieAST a -> [Int]
HieAST Int -> [Int]
getts
unfold :: [Int] -> [HieTypeFlat]
unfold = (Int -> HieTypeFlat) -> [Int] -> [HieTypeFlat]
forall a b. (a -> b) -> [a] -> [b]
map (Array Int HieTypeFlat
arr A.!)
getts :: HieAST Int -> [Int]
getts HieAST Int
x = NodeInfo Int -> [Int]
forall a. NodeInfo a -> [a]
nodeType NodeInfo Int
ni [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ ((IdentifierDetails Int -> Maybe Int)
-> [IdentifierDetails Int] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IdentifierDetails Int -> Maybe Int
forall a. IdentifierDetails a -> Maybe a
identType ([IdentifierDetails Int] -> [Int])
-> [IdentifierDetails Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ Map Identifier (IdentifierDetails Int) -> [IdentifierDetails Int]
forall k a. Map k a -> [a]
M.elems (Map Identifier (IdentifierDetails Int) -> [IdentifierDetails Int])
-> Map Identifier (IdentifierDetails Int)
-> [IdentifierDetails Int]
forall a b. (a -> b) -> a -> b
$ NodeInfo Int -> Map Identifier (IdentifierDetails Int)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo Int
ni)
where ni :: NodeInfo Int
ni = HieAST Int -> NodeInfo Int
nodeInfo' HieAST Int
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]
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)
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), ForAllTyFlag)
_ Int
a -> [Int] -> [Name]
getTypes' [Int
a]
HFunTy Int
a Int
b Int
c -> [Int] -> [Name]
getTypes' [Int
a,Int
b,Int
c]
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 a b. (a -> b) -> m a -> m b
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 a b. (a -> b) -> m a -> m b
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
. WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
forall (m :: * -> *).
MonadIO m =>
WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation (HieDb -> IO a) -> IO a
WithHieDb
withHieDb LookupModule m
lookupModule) ([Int] -> [Name]
getTypes' [Int]
ts)
HieKind a
HieFresh ->
let ts :: [Type]
ts = [[Type]] -> [Type]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Type]] -> [Type]) -> [[Type]] -> [Type]
forall a b. (a -> b) -> a -> b
$ HieASTs a -> Position -> (HieAST a -> [Type]) -> [[Type]]
forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs a
ast Position
pos HieAST a -> [Type]
HieAST Type -> [Type]
getts
getts :: HieAST Type -> [Type]
getts HieAST Type
x = NodeInfo Type -> [Type]
forall a. NodeInfo a -> [a]
nodeType NodeInfo Type
ni [Type] -> [Type] -> [Type]
forall a. [a] -> [a] -> [a]
++ ((IdentifierDetails Type -> Maybe Type)
-> [IdentifierDetails Type] -> [Type]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IdentifierDetails Type -> Maybe Type
forall a. IdentifierDetails a -> Maybe a
identType ([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
ni)
where ni :: NodeInfo Type
ni = HieAST Type -> NodeInfo Type
nodeInfo HieAST Type
x
in ([Location] -> [Location]) -> m [Location] -> m [Location]
forall a b. (a -> b) -> m a -> m b
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 a b. (a -> b) -> m a -> m b
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
. WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
forall (m :: * -> *).
MonadIO m =>
WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation (HieDb -> IO a) -> IO a
WithHieDb
withHieDb LookupModule m
lookupModule) ([Type] -> [Name]
getTypes [Type]
ts)
namesInType :: Type -> [Name]
namesInType :: Type -> [Name]
namesInType (TyVarTy Var
n) = [Var -> Name
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 ForAllTyBinder
b Type
t) = Var -> Name
varName (ForAllTyBinder -> Var
forall tv argf. VarBndr tv argf -> tv
binderVar ForAllTyBinder
b) Name -> [Name] -> [Name]
forall a. a -> [a] -> [a]
: Type -> [Name]
namesInType Type
t
namesInType (FunTy FunTyFlag
_ 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
=> WithHieDb
-> LookupModule m
-> IdeOptions
-> M.Map ModuleName NormalizedFilePath
-> Position
-> HieASTs a
-> m [Location]
locationsAtPoint :: forall (m :: * -> *) a.
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs a
-> m [Location]
locationsAtPoint WithHieDb
withHieDb 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 -> Map Identifier (IdentifierDetails a)
getNodeIds)
zeroPos :: Position
zeroPos = UInt -> UInt -> Position
Position UInt
0 UInt
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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\NormalizedFilePath
fs -> Location -> [Location]
forall a. a -> [a]
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 a b. (a -> b) -> m a -> m b
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 a. a -> m a
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
$ WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
forall (m :: * -> *).
MonadIO m =>
WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation (HieDb -> IO a) -> IO a
WithHieDb
withHieDb LookupModule m
lookupModule) [Identifier]
ns
nameToLocation :: MonadIO m => WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation :: forall (m :: * -> *).
MonadIO m =>
WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
nameToLocation WithHieDb
withHieDb 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@(RealSrcSpan Span
rsp Maybe BufSpan
_)
| FilePath
fs <- FastString -> FilePath
Util.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 a. IO a -> MaybeT m a
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 a. a -> m a
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 a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Location -> [Location]
forall a. a -> [a]
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
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)
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 a. a -> m a
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 a. IO a -> MaybeT m a
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 -> IO [Res DefRow]) -> IO [Res DefRow]
WithHieDb
withHieDb (\HieDb
hieDb -> 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
forall unit. GenModule unit -> 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
forall unit. GenModule unit -> unit
moduleUnit Module
mod))
case [Res DefRow]
erow of
[] -> do
[Res DefRow]
erow' <- IO [Res DefRow] -> MaybeT m [Res DefRow]
forall a. IO a -> MaybeT m a
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 -> IO [Res DefRow]) -> IO [Res DefRow]
WithHieDb
withHieDb (\HieDb
hieDb -> 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
forall unit. GenModule unit -> 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 a. a -> m a
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 (m :: * -> *) a. Monad m => m a -> MaybeT m a
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 (m :: * -> *) a. Monad m => m a -> MaybeT m a
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 :: forall (m :: * -> *).
Monad m =>
LookupModule m -> Res DefRow -> MaybeT m Location
defRowToLocation LookupModule m
lookupModule (DefRow
row:.ModuleInfo
info) = do
let start :: Position
start = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ DefRow -> Int
defSLine DefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ DefRow -> Int
defSCol DefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
end :: Position
end = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ DefRow -> Int
defELine DefRow
row Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ 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 a. a -> MaybeT m a
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)
Location -> MaybeT m Location
forall a. a -> MaybeT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Location -> MaybeT m Location) -> Location -> MaybeT m Location
forall a b. (a -> b) -> a -> b
$ 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
defSLine :: DefRow -> Int
defSCol :: DefRow -> Int
defELine :: DefRow -> Int
defECol :: DefRow -> Int
defSrc :: DefRow -> FilePath
defSrc :: FilePath
defNameOcc :: OccName
defSLine :: Int
defSCol :: Int
defELine :: Int
defECol :: Int
defNameOcc :: DefRow -> OccName
..}:.(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 [SymbolTag]
-> Maybe Text
-> Maybe Bool
-> Location
-> SymbolInformation
SymbolInformation (OccName -> Text
forall a. Outputable a => a -> Text
printOutputable OccName
defNameOcc) SymbolKind
kind Maybe [SymbolTag]
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Location
loc
where
kind :: SymbolKind
kind
| OccName -> Bool
isVarOcc OccName
defNameOcc = SymbolKind
SymbolKind_Variable
| OccName -> Bool
isDataOcc OccName
defNameOcc = SymbolKind
SymbolKind_Constructor
| OccName -> Bool
isTcOcc OccName
defNameOcc = SymbolKind
SymbolKind_Struct
| Bool
otherwise = SymbolKind
SymbolKind_File
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 = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Int
defSLine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Int
defSCol Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
end :: Position
end = UInt -> UInt -> Position
Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ Int
defELine Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UInt) -> Int -> UInt
forall a b. (a -> b) -> a -> b
$ 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 :: forall t a. HieASTs t -> Position -> (HieAST t -> a) -> [a]
pointCommand HieASTs t
hf Position
pos HieAST t -> a
k =
Map HiePath a -> [a]
forall k a. Map k a -> [a]
M.elems (Map HiePath a -> [a]) -> Map HiePath a -> [a]
forall a b. (a -> b) -> a -> b
$ ((HiePath -> HieAST t -> Maybe a)
-> Map HiePath (HieAST t) -> Map HiePath a)
-> Map HiePath (HieAST t)
-> (HiePath -> HieAST t -> Maybe a)
-> Map HiePath a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (HiePath -> HieAST t -> Maybe a)
-> Map HiePath (HieAST t) -> Map HiePath a
forall k a b. (k -> a -> Maybe b) -> Map k a -> Map k b
M.mapMaybeWithKey (HieASTs t -> Map HiePath (HieAST t)
forall a. HieASTs a -> Map HiePath (HieAST a)
getAsts HieASTs t
hf) ((HiePath -> HieAST t -> Maybe a) -> Map HiePath a)
-> (HiePath -> HieAST t -> Maybe a) -> Map HiePath a
forall a b. (a -> b) -> a -> b
$ \HiePath
fs HieAST t
ast ->
case Span -> HieAST t -> Maybe (HieAST t)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining (FastString -> Span
sp (FastString -> Span) -> FastString -> Span
forall a b. (a -> b) -> a -> b
$ HiePath -> FastString
forall a b. Coercible a b => a -> b
coerce HiePath
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 (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
lineUInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+UInt
1) (UInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UInt -> Int) -> UInt -> Int
forall a b. (a -> b) -> a -> b
$ UInt
chaUInt -> UInt -> UInt
forall a. Num a => a -> a -> a
+UInt
1)
sp :: FastString -> Span
sp FastString
fs = RealSrcLoc -> RealSrcLoc -> Span
mkRealSrcSpan (FastString -> RealSrcLoc
sloc FastString
fs) (FastString -> RealSrcLoc
sloc FastString
fs)
line :: UInt
line :: UInt
line = Position -> UInt
_line Position
pos
cha :: UInt
cha = Position -> UInt
_character Position
pos
nodeInfoH :: HieKind a -> HieAST a -> NodeInfo a
nodeInfoH :: forall a. HieKind a -> HieAST a -> NodeInfo a
nodeInfoH (HieFromDisk HieFile
_) = HieAST a -> NodeInfo a
HieAST Int -> NodeInfo Int
nodeInfo'
nodeInfoH HieKind a
HieFresh = HieAST a -> NodeInfo a
HieAST Type -> NodeInfo Type
nodeInfo