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

-- | 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
  ) where

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

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

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

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           Data.List
import qualified Data.Text as T
import qualified Data.Map as M

import Data.Either
import Data.List.Extra (dropEnd1)

documentHighlight
  :: Monad m
  => HieASTs Type
  -> RefMap
  -> Position
  -> MaybeT m [DocumentHighlight]
documentHighlight :: HieASTs Type -> RefMap -> Position -> MaybeT m [DocumentHighlight]
documentHighlight HieASTs Type
hf RefMap
rf Position
pos = m (Maybe [DocumentHighlight]) -> MaybeT m [DocumentHighlight]
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (m (Maybe [DocumentHighlight]) -> MaybeT m [DocumentHighlight])
-> m (Maybe [DocumentHighlight]) -> MaybeT m [DocumentHighlight]
forall a b. (a -> b) -> a -> b
$ Maybe [DocumentHighlight] -> m (Maybe [DocumentHighlight])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([DocumentHighlight] -> Maybe [DocumentHighlight]
forall a. a -> Maybe a
Just [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 Type -> Position -> (HieAST Type -> [Name]) -> [[Name]]
forall a. HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
pointCommand HieASTs Type
hf Position
pos ([Either ModuleName Name] -> [Name]
forall a b. [Either a b] -> [b]
rights ([Either ModuleName Name] -> [Name])
-> (HieAST Type -> [Either ModuleName Name])
-> HieAST Type
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map (Either ModuleName Name) (IdentifierDetails Type)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys (Map (Either ModuleName Name) (IdentifierDetails Type)
 -> [Either ModuleName Name])
-> (HieAST Type
    -> Map (Either ModuleName Name) (IdentifierDetails Type))
-> HieAST Type
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo Type
-> Map (Either ModuleName Name) (IdentifierDetails Type)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Type
 -> Map (Either ModuleName Name) (IdentifierDetails Type))
-> (HieAST Type -> NodeInfo Type)
-> HieAST Type
-> Map (Either ModuleName Name) (IdentifierDetails Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Type -> NodeInfo Type
forall a. HieAST a -> NodeInfo a
nodeInfo)
    highlights :: [DocumentHighlight]
highlights = do
      Name
n <- [Name]
ns
      (Span, IdentifierDetails Type)
ref <- [(Span, IdentifierDetails Type)]
-> ([(Span, IdentifierDetails Type)]
    -> [(Span, IdentifierDetails Type)])
-> Maybe [(Span, IdentifierDetails Type)]
-> [(Span, IdentifierDetails Type)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [(Span, IdentifierDetails Type)]
-> [(Span, IdentifierDetails Type)]
forall a. a -> a
id (Either ModuleName Name
-> RefMap -> Maybe [(Span, IdentifierDetails Type)]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Name -> Either ModuleName Name
forall a b. b -> Either a b
Right Name
n) RefMap
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 Type) -> DocumentHighlight
forall a. (Span, IdentifierDetails a) -> DocumentHighlight
makeHighlight (Span, IdentifierDetails Type)
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
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
  -> HieASTs Type
  -> Position
  -> MaybeT m [Location]
gotoTypeDefinition :: (Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions -> HieASTs Type -> Position -> MaybeT m [Location]
gotoTypeDefinition Module -> MaybeT m (HieFile, FilePath)
getHieFile IdeOptions
ideOpts HieASTs Type
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
$ (Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions -> Position -> HieASTs Type -> m [Location]
forall (m :: * -> *).
MonadIO m =>
(Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions -> Position -> HieASTs Type -> m [Location]
typeLocationsAtPoint Module -> MaybeT m (HieFile, FilePath)
getHieFile IdeOptions
ideOpts Position
pos HieASTs Type
srcSpans

-- | Locate the definition of the name at a given position.
gotoDefinition
  :: MonadIO m
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
  -> M.Map ModuleName NormalizedFilePath
  -> HieASTs Type
  -> Position
  -> MaybeT m Location
gotoDefinition :: (Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> HieASTs Type
-> Position
-> MaybeT m Location
gotoDefinition Module -> MaybeT m (HieFile, FilePath)
getHieFile IdeOptions
ideOpts Map ModuleName NormalizedFilePath
imports HieASTs Type
srcSpans Position
pos
  = 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
$ ([Location] -> Maybe Location)
-> m [Location] -> m (Maybe Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Location] -> Maybe Location
forall a. [a] -> Maybe a
listToMaybe (m [Location] -> m (Maybe Location))
-> m [Location] -> m (Maybe Location)
forall a b. (a -> b) -> a -> b
$ (Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs Type
-> m [Location]
forall (m :: * -> *).
MonadIO m =>
(Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs Type
-> m [Location]
locationsAtPoint Module -> MaybeT m (HieFile, FilePath)
getHieFile IdeOptions
ideOpts Map ModuleName NormalizedFilePath
imports Position
pos HieASTs Type
srcSpans

-- | Synopsis for the name at a given position.
atPoint
  :: IdeOptions
  -> HieASTs Type
  -> DocAndKindMap
  -> Position
  -> Maybe (Maybe Range, [T.Text])
atPoint :: IdeOptions
-> HieASTs Type
-> DocAndKindMap
-> Position
-> Maybe (Maybe Range, [Text])
atPoint IdeOptions{} HieASTs Type
hf (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 Type
-> Position
-> (HieAST Type -> (Maybe Range, [Text]))
-> [(Maybe Range, [Text])]
forall a. HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
pointCommand HieASTs Type
hf Position
pos HieAST Type -> (Maybe Range, [Text])
hoverInfo
  where
    -- Hover info for values/data
    hoverInfo :: HieAST Type -> (Maybe Range, [Text])
hoverInfo HieAST Type
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
          | [(Either ModuleName Name, IdentifierDetails Type)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Either ModuleName Name, IdentifierDetails Type)]
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 Type -> Span
forall a. HieAST a -> Span
nodeSpan HieAST Type
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 Type
info = HieAST Type -> NodeInfo Type
forall a. HieAST a -> NodeInfo a
nodeInfo HieAST Type
ast
        names :: [(Either ModuleName Name, IdentifierDetails Type)]
names = Map (Either ModuleName Name) (IdentifierDetails Type)
-> [(Either ModuleName Name, IdentifierDetails Type)]
forall k a. Map k a -> [(k, a)]
M.assocs (Map (Either ModuleName Name) (IdentifierDetails Type)
 -> [(Either ModuleName Name, IdentifierDetails Type)])
-> Map (Either ModuleName Name) (IdentifierDetails Type)
-> [(Either ModuleName Name, IdentifierDetails Type)]
forall a b. (a -> b) -> a -> b
$ NodeInfo Type
-> Map (Either ModuleName Name) (IdentifierDetails Type)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers NodeInfo Type
info
        types :: [Type]
types = NodeInfo Type -> [Type]
forall a. NodeInfo a -> [a]
nodeType NodeInfo Type
info

        prettyNames :: [T.Text]
        prettyNames :: [Text]
prettyNames = ((Either ModuleName Name, IdentifierDetails Type) -> Text)
-> [(Either ModuleName Name, IdentifierDetails Type)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Either ModuleName Name, IdentifierDetails Type) -> Text
forall a.
Outputable a =>
(Either a Name, IdentifierDetails Type) -> Text
prettyName [(Either ModuleName Name, IdentifierDetails Type)]
names
        prettyName :: (Either a Name, IdentifierDetails Type) -> Text
prettyName (Right Name
n, IdentifierDetails Type
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 -> (Type -> Text) -> Maybe Type -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" ((Text
" :: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Type -> Text) -> Type -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Text
forall a. Outputable a => a -> Text
prettyType) (IdentifierDetails Type -> Maybe Type
forall a. IdentifierDetails a -> Maybe a
identType IdentifierDetails Type
dets Maybe Type -> Maybe Type -> Maybe Type
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Type
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 Type
maybeKind = 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 a
m,IdentifierDetails Type
_) = a -> Text
forall a. Outputable a => a -> Text
showName a
m

        prettyTypes :: [Text]
prettyTypes = (Type -> Text) -> [Type] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text
"_ :: "Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Type -> Text) -> Type -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Text
forall a. Outputable a => a -> Text
prettyType) [Type]
types
        prettyType :: a -> Text
prettyType a
t = a -> Text
forall a. Outputable a => a -> Text
showName a
t

        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
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
  -> Position
  -> HieASTs Type
  -> m [Location]
typeLocationsAtPoint :: (Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions -> Position -> HieASTs Type -> m [Location]
typeLocationsAtPoint Module -> MaybeT m (HieFile, FilePath)
getHieFile IdeOptions
_ideOptions Position
pos HieASTs Type
ast =
  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 Type -> Position -> (HieAST Type -> [Type]) -> [[Type]]
forall a. HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
pointCommand HieASTs Type
ast Position
pos (NodeInfo Type -> [Type]
forall a. NodeInfo a -> [a]
nodeType (NodeInfo Type -> [Type])
-> (HieAST Type -> NodeInfo Type) -> HieAST Type -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Type -> NodeInfo Type
forall a. HieAST a -> NodeInfo a
nodeInfo)
      ns :: [Name]
ns = ((Type -> Maybe Name) -> [Type] -> [Name])
-> [Type] -> (Type -> Maybe Name) -> [Name]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Type -> Maybe Name) -> [Type] -> [Name]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Type]
ts ((Type -> Maybe Name) -> [Name]) -> (Type -> Maybe Name) -> [Name]
forall a b. (a -> b) -> a -> b
$ \case
        TyConApp TyCon
tc [Type]
_ -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ TyCon -> Name
tyConName TyCon
tc
        TyVarTy Var
n -> Name -> Maybe Name
forall a. a -> Maybe a
Just (Name -> Maybe Name) -> Name -> Maybe Name
forall a b. (a -> b) -> a -> b
$ Var -> Name
Var.varName Var
n
        Type
_ -> Maybe Name
forall a. Maybe a
Nothing
    in (Name -> m (Maybe Location)) -> [Name] -> m [Location]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM ((Module -> MaybeT m (HieFile, FilePath))
-> Name -> m (Maybe Location)
forall (f :: * -> *).
Monad f =>
(Module -> MaybeT f (HieFile, FilePath))
-> Name -> f (Maybe Location)
nameToLocation Module -> MaybeT m (HieFile, FilePath)
getHieFile) [Name]
ns

locationsAtPoint
  :: forall m
   . MonadIO m
  => (Module -> MaybeT m (HieFile, FilePath))
  -> IdeOptions
  -> M.Map ModuleName NormalizedFilePath
  -> Position
  -> HieASTs Type
  -> m [Location]
locationsAtPoint :: (Module -> MaybeT m (HieFile, FilePath))
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> Position
-> HieASTs Type
-> m [Location]
locationsAtPoint Module -> MaybeT m (HieFile, FilePath)
getHieFile IdeOptions
_ideOptions Map ModuleName NormalizedFilePath
imports Position
pos HieASTs Type
ast =
  let ns :: [Either ModuleName Name]
ns = [[Either ModuleName Name]] -> [Either ModuleName Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either ModuleName Name]] -> [Either ModuleName Name])
-> [[Either ModuleName Name]] -> [Either ModuleName Name]
forall a b. (a -> b) -> a -> b
$ HieASTs Type
-> Position
-> (HieAST Type -> [Either ModuleName Name])
-> [[Either ModuleName Name]]
forall a. HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
pointCommand HieASTs Type
ast Position
pos (Map (Either ModuleName Name) (IdentifierDetails Type)
-> [Either ModuleName Name]
forall k a. Map k a -> [k]
M.keys (Map (Either ModuleName Name) (IdentifierDetails Type)
 -> [Either ModuleName Name])
-> (HieAST Type
    -> Map (Either ModuleName Name) (IdentifierDetails Type))
-> HieAST Type
-> [Either ModuleName Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeInfo Type
-> Map (Either ModuleName Name) (IdentifierDetails Type)
forall a. NodeInfo a -> NodeIdentifiers a
nodeIdentifiers (NodeInfo Type
 -> Map (Either ModuleName Name) (IdentifierDetails Type))
-> (HieAST Type -> NodeInfo Type)
-> HieAST Type
-> Map (Either ModuleName Name) (IdentifierDetails Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieAST Type -> NodeInfo Type
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 -> 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 (Either ModuleName Name -> m (Maybe Location))
-> [Either ModuleName Name] -> m [Location]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM ((ModuleName -> m (Maybe Location))
-> (Name -> m (Maybe Location))
-> Either ModuleName Name
-> 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))
 -> Either ModuleName Name -> m (Maybe Location))
-> (Name -> m (Maybe Location))
-> Either ModuleName Name
-> m (Maybe Location)
forall a b. (a -> b) -> a -> b
$ (Module -> MaybeT m (HieFile, FilePath))
-> Name -> m (Maybe Location)
forall (f :: * -> *).
Monad f =>
(Module -> MaybeT f (HieFile, FilePath))
-> Name -> f (Maybe Location)
nameToLocation Module -> MaybeT m (HieFile, FilePath)
getHieFile) [Either ModuleName Name]
ns

-- | Given a 'Name' attempt to find the location where it is defined.
nameToLocation :: Monad f => (Module -> MaybeT f (HieFile, String)) -> Name -> f (Maybe Location)
nameToLocation :: (Module -> MaybeT f (HieFile, FilePath))
-> Name -> f (Maybe Location)
nameToLocation Module -> MaybeT f (HieFile, FilePath)
getHieFile Name
name = (Maybe SrcSpan -> Maybe Location)
-> f (Maybe SrcSpan) -> f (Maybe Location)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SrcSpan -> Maybe Location
srcSpanToLocation (SrcSpan -> Maybe Location) -> Maybe SrcSpan -> Maybe Location
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (f (Maybe SrcSpan) -> f (Maybe Location))
-> f (Maybe SrcSpan) -> f (Maybe Location)
forall a b. (a -> b) -> a -> b
$
  case Name -> SrcSpan
nameSrcSpan Name
name of
    sp :: SrcSpan
sp@(RealSrcSpan Span
_) -> Maybe SrcSpan -> f (Maybe SrcSpan)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SrcSpan -> f (Maybe SrcSpan))
-> Maybe SrcSpan -> f (Maybe SrcSpan)
forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe SrcSpan
forall a. a -> Maybe a
Just SrcSpan
sp
    sp :: SrcSpan
sp@(UnhelpfulSpan FastString
_) -> MaybeT f SrcSpan -> f (Maybe SrcSpan)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT f SrcSpan -> f (Maybe SrcSpan))
-> MaybeT f SrcSpan -> f (Maybe SrcSpan)
forall a b. (a -> b) -> a -> b
$ do
      Bool -> MaybeT f ()
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 <- f (Maybe Module) -> MaybeT f Module
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (f (Maybe Module) -> MaybeT f Module)
-> f (Maybe Module) -> MaybeT f Module
forall a b. (a -> b) -> a -> b
$ Maybe Module -> f (Maybe Module)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Module -> f (Maybe Module))
-> Maybe Module -> f (Maybe Module)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Module
nameModule_maybe Name
name
      (HieFile
hieFile, FilePath
srcPath) <- Module -> MaybeT f (HieFile, FilePath)
getHieFile Module
mod
      (SrcSpan, Name)
avail <- f (Maybe (SrcSpan, Name)) -> MaybeT f (SrcSpan, Name)
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (f (Maybe (SrcSpan, Name)) -> MaybeT f (SrcSpan, Name))
-> f (Maybe (SrcSpan, Name)) -> MaybeT f (SrcSpan, Name)
forall a b. (a -> b) -> a -> b
$ Maybe (SrcSpan, Name) -> f (Maybe (SrcSpan, Name))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SrcSpan, Name) -> f (Maybe (SrcSpan, Name)))
-> Maybe (SrcSpan, Name) -> f (Maybe (SrcSpan, Name))
forall a b. (a -> b) -> a -> b
$ ((SrcSpan, Name) -> Bool)
-> [(SrcSpan, Name)] -> Maybe (SrcSpan, Name)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Name -> Name -> Bool
eqName Name
name (Name -> Bool)
-> ((SrcSpan, Name) -> Name) -> (SrcSpan, Name) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan, Name) -> Name
forall a b. (a, b) -> b
snd) ([(SrcSpan, Name)] -> Maybe (SrcSpan, Name))
-> [(SrcSpan, Name)] -> Maybe (SrcSpan, Name)
forall a b. (a -> b) -> a -> b
$ HieFile -> [(SrcSpan, Name)]
hieExportNames HieFile
hieFile
      -- The location will point to the source file used during compilation.
      -- This file might no longer exists and even if it does the path will be relative
      -- to the compilation directory which we don’t know.
      let span :: SrcSpan
span = FilePath -> SrcSpan -> SrcSpan
setFileName FilePath
srcPath (SrcSpan -> SrcSpan) -> SrcSpan -> SrcSpan
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Name) -> SrcSpan
forall a b. (a, b) -> a
fst (SrcSpan, Name)
avail
      SrcSpan -> MaybeT f SrcSpan
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcSpan
span
  where
    -- We ignore uniques and source spans and only compare the name and the module.
    eqName :: Name -> Name -> Bool
    eqName :: Name -> Name -> Bool
eqName Name
n Name
n' = Name -> OccName
nameOccName Name
n OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> OccName
nameOccName Name
n' Bool -> Bool -> Bool
&& Name -> Maybe Module
nameModule_maybe Name
n Maybe Module -> Maybe Module -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Maybe Module
nameModule_maybe Name
n'
    setFileName :: FilePath -> SrcSpan -> SrcSpan
setFileName FilePath
f (RealSrcSpan Span
span) = Span -> SrcSpan
RealSrcSpan (Span
span { srcSpanFile :: FastString
srcSpanFile = FilePath -> FastString
mkFastString FilePath
f })
    setFileName FilePath
_ span :: SrcSpan
span@(UnhelpfulSpan FastString
_) = SrcSpan
span

pointCommand :: HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
pointCommand :: HieASTs Type -> Position -> (HieAST Type -> a) -> [a]
pointCommand HieASTs Type
hf Position
pos HieAST Type -> 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 Type -> Maybe a)
 -> Map FastString (HieAST Type) -> Map FastString (Maybe a))
-> Map FastString (HieAST Type)
-> (FastString -> HieAST Type -> Maybe a)
-> Map FastString (Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (FastString -> HieAST Type -> Maybe a)
-> Map FastString (HieAST Type) -> Map FastString (Maybe a)
forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey (HieASTs Type -> Map FastString (HieAST Type)
forall a. HieASTs a -> Map FastString (HieAST a)
getAsts HieASTs Type
hf) ((FastString -> HieAST Type -> Maybe a)
 -> Map FastString (Maybe a))
-> (FastString -> HieAST Type -> Maybe a)
-> Map FastString (Maybe a)
forall a b. (a -> b) -> a -> b
$ \FastString
fs HieAST Type
ast ->
      case Span -> HieAST Type -> Maybe (HieAST Type)
forall a. Span -> HieAST a -> Maybe (HieAST a)
selectSmallestContaining (FastString -> Span
sp FastString
fs) HieAST Type
ast of
        Maybe (HieAST Type)
Nothing -> Maybe a
forall a. Maybe a
Nothing
        Just HieAST Type
ast' -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ HieAST Type -> a
k HieAST Type
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