-- Copyright (c) 2019 The DAML Authors. All rights reserved.

-- SPDX-License-Identifier: Apache-2.0


{-# LANGUAGE GADTs #-}
{-# LANGUAGE CPP #-}
#include "ghc-api-version.h"

-- | 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
  ) 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.GHC.Compat
import Development.IDE.Types.Options
import Development.IDE.Spans.Common
import Development.IDE.Core.RuleTypes
import Development.IDE.Core.PositionMapping

-- GHC API imports

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

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

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

import HieDb hiding (pointCommand)

-- | 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 -> UnitId -> 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 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
          names :: [Name]
names = [[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
. NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo a -> Map Identifier (IdentifierDetails a))
-> (HieAST a -> NodeInfo a)
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo)
          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
          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
        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)

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 UnitId
-> [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) (UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ Module -> UnitId
moduleUnitId Module
mod) [FilePath]
exclude
         [Location] -> m [Location]
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 (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 UnitId
-> [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) (UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ Module -> UnitId
moduleUnitId Module
mod) [FilePath]
exclude
        [Location] -> m [Location]
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 (f :: * -> *) a. Applicative f => a -> f a
pure []
  [Location] -> m [Location]
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 = 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
  Location -> Maybe Location
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 = 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
. NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo a -> Map Identifier (IdentifierDetails a))
-> (HieAST a -> NodeInfo a)
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo)
    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 (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
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
  -> Position
  -> Maybe (Maybe Range, [T.Text])
atPoint :: IdeOptions
-> HieAstResult
-> DocAndKindMap
-> 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) 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
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 = HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo 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]
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

        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. 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. 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_GHC_API_VERSION(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]
            HFunTy Int
a Int
b -> [Int] -> [Name]
getTypes [Int
a,Int
b]
            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
. NodeInfo a -> Map Identifier (IdentifierDetails a)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo a -> Map Identifier (IdentifierDetails a))
-> (HieAST a -> NodeInfo a)
-> HieAST a
-> Map Identifier (IdentifierDetails a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST a -> NodeInfo a
forall a. HieAST a -> NodeInfo a
nodeInfo)
      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@(RealSrcSpan Span
rsp)
      -- Lookup in the db if we got a location in a boot file

      | 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` FastString -> FilePath
unpackFS (Span -> FastString
srcSpanFile Span
rsp) -> 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
    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 UnitId -> 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) (UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just (UnitId -> Maybe UnitId) -> UnitId -> Maybe UnitId
forall a b. (a -> b) -> a -> b
$ Module -> UnitId
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 UnitId -> 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 UnitId
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 -> UnitId
modInfoUnit ModuleInfo
info) (ModuleInfo -> Bool
modInfoIsBoot ModuleInfo
info)
  Location -> MaybeT m Location
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
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 Bool
-> Location
-> Maybe Text
-> SymbolInformation
SymbolInformation (OccName -> Text
forall a. Outputable a => a -> Text
showGhc OccName
defNameOcc) SymbolKind
kind 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