{-# LANGUAGE RankNTypes   #-}
{-# LANGUAGE TypeFamilies #-}
module Development.IDE.Core.Actions
( getAtPoint
, getDefinition
, getTypeDefinition
, highlightAtPoint
, refsAtPoint
, workspaceSymbols
, lookupMod
) where

import           Control.Monad.Extra                  (mapMaybeM)
import           Control.Monad.Reader
import           Control.Monad.Trans.Maybe
import qualified Data.HashMap.Strict                  as HM
import           Data.Maybe
import qualified Data.Text                            as T
import           Data.Tuple.Extra
import           Development.IDE.Core.OfInterest
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.PositionMapping
import           Development.IDE.Core.RuleTypes
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake
import           Development.IDE.GHC.Compat           hiding (writeHieFile)
import           Development.IDE.Graph
import qualified Development.IDE.Spans.AtPoint        as AtPoint
import           Development.IDE.Types.HscEnvEq       (hscEnv)
import           Development.IDE.Types.Location
import qualified HieDb
import           Language.LSP.Protocol.Types          (DocumentHighlight (..),
                                                       SymbolInformation (..),
                                                       normalizedFilePathToUri,
                                                       uriToNormalizedFilePath)


-- | Eventually this will lookup/generate URIs for files in dependencies, but not in the
-- project. Right now, this is just a stub.
lookupMod
  :: HieDbWriter -- ^ access the database
  -> FilePath -- ^ The `.hie` file we got from the database
  -> ModuleName
  -> Unit
  -> Bool -- ^ Is this file a boot file?
  -> MaybeT IdeAction Uri
lookupMod :: HieDbWriter
-> FilePath -> ModuleName -> Unit -> Bool -> MaybeT IdeAction Uri
lookupMod HieDbWriter
_dbchan FilePath
_hie_f ModuleName
_mod Unit
_uid Bool
_boot = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing


-- IMPORTANT NOTE : make sure all rules `useWithStaleFastMT`d by these have a "Persistent Stale" rule defined,
-- so we can quickly answer as soon as the IDE is opened
-- Even if we don't have persistent information on disk for these rules, the persistent rule
-- should just return an empty result
-- It is imperative that the result of the persistent rule succeed in such a case, or we will
-- block waiting for the rule to be properly computed.

-- | Try to get hover text for the name under point.
getAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe (Maybe Range, [T.Text]))
getAtPoint :: NormalizedFilePath
-> Position -> IdeAction (Maybe (Maybe Range, [Text]))
getAtPoint NormalizedFilePath
file Position
pos = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
  ShakeExtras
ide <- forall r (m :: * -> *). MonadReader r m => m r
ask
  IdeOptions
opts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
ide

  (HieAstResult
hf, PositionMapping
mapping) <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GetHieAst
GetHieAst NormalizedFilePath
file
  HscEnv
env <- HscEnvEq -> HscEnv
hscEnv forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GhcSession
GhcSession NormalizedFilePath
file
  DocAndKindMap
dkMap <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (DocMap -> KindMap -> DocAndKindMap
DKMap forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GetDocMap
GetDocMap NormalizedFilePath
file)

  !Position
pos' <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
  forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a a' b. (a -> a') -> (a, b) -> (a', b)
first (PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
mapping forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IdeOptions
-> HieAstResult
-> DocAndKindMap
-> HscEnv
-> Position
-> IO (Maybe (Maybe Range, [Text]))
AtPoint.atPoint IdeOptions
opts HieAstResult
hf DocAndKindMap
dkMap HscEnv
env Position
pos'

-- | For each Location, determine if we have the PositionMapping
-- for the correct file. If not, get the correct position mapping
-- and then apply the position mapping to the location.
toCurrentLocations
  :: PositionMapping
  -> NormalizedFilePath
  -> [Location]
  -> IdeAction [Location]
toCurrentLocations :: PositionMapping
-> NormalizedFilePath -> [Location] -> IdeAction [Location]
toCurrentLocations PositionMapping
mapping NormalizedFilePath
file = forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM Location -> IdeAction (Maybe Location)
go
  where
    go :: Location -> IdeAction (Maybe Location)
    go :: Location -> IdeAction (Maybe Location)
go (Location Uri
uri Range
range) =
      -- The Location we are going to might be in a different
      -- file than the one we are calling gotoDefinition from.
      -- So we check that the location file matches the file
      -- we are in.
      if NormalizedUri
nUri forall a. Eq a => a -> a -> Bool
== NormalizedFilePath -> NormalizedUri
normalizedFilePathToUri NormalizedFilePath
file
      -- The Location matches the file, so use the PositionMapping
      -- we have.
      then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uri -> Range -> Location
Location Uri
uri forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
mapping Range
range
      -- The Location does not match the file, so get the correct
      -- PositionMapping and use that instead.
      else do
        Maybe PositionMapping
otherLocationMapping <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
          NormalizedFilePath
otherLocationFile <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ NormalizedUri -> Maybe NormalizedFilePath
uriToNormalizedFilePath NormalizedUri
nUri
          forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GetHieAst
GetHieAst NormalizedFilePath
otherLocationFile
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Uri -> Range -> Location
Location Uri
uri forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b c. (a -> b -> c) -> b -> a -> c
flip PositionMapping -> Range -> Maybe Range
toCurrentRange Range
range forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe PositionMapping
otherLocationMapping)
      where
        nUri :: NormalizedUri
        nUri :: NormalizedUri
nUri = Uri -> NormalizedUri
toNormalizedUri Uri
uri

-- | Goto Definition.
getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getDefinition NormalizedFilePath
file Position
pos = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    ide :: ShakeExtras
ide@ShakeExtras{ WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb :: WithHieDb
withHieDb, HieDbWriter
$sel:hiedbWriter:ShakeExtras :: ShakeExtras -> HieDbWriter
hiedbWriter :: HieDbWriter
hiedbWriter } <- forall r (m :: * -> *). MonadReader r m => m r
ask
    IdeOptions
opts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
ide
    (HAR Module
_ HieASTs a
hf RefMap a
_ Map Name [RealSrcSpan]
_ HieKind a
_, PositionMapping
mapping) <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GetHieAst
GetHieAst NormalizedFilePath
file
    (ImportMap Map ModuleName NormalizedFilePath
imports, PositionMapping
_) <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GetImportMap
GetImportMap NormalizedFilePath
file
    !Position
pos' <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
    [Location]
locations <- forall (m :: * -> *) a.
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> Map ModuleName NormalizedFilePath
-> HieASTs a
-> Position
-> MaybeT m [Location]
AtPoint.gotoDefinition WithHieDb
withHieDb (HieDbWriter
-> FilePath -> ModuleName -> Unit -> Bool -> MaybeT IdeAction Uri
lookupMod HieDbWriter
hiedbWriter) IdeOptions
opts Map ModuleName NormalizedFilePath
imports HieASTs a
hf Position
pos'
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping
-> NormalizedFilePath -> [Location] -> IdeAction [Location]
toCurrentLocations PositionMapping
mapping NormalizedFilePath
file [Location]
locations

getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getTypeDefinition :: NormalizedFilePath -> Position -> IdeAction (Maybe [Location])
getTypeDefinition NormalizedFilePath
file Position
pos = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    ide :: ShakeExtras
ide@ShakeExtras{ WithHieDb
withHieDb :: WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb, HieDbWriter
hiedbWriter :: HieDbWriter
$sel:hiedbWriter:ShakeExtras :: ShakeExtras -> HieDbWriter
hiedbWriter } <- forall r (m :: * -> *). MonadReader r m => m r
ask
    IdeOptions
opts <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO ShakeExtras
ide
    (HieAstResult
hf, PositionMapping
mapping) <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GetHieAst
GetHieAst NormalizedFilePath
file
    !Position
pos' <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
    [Location]
locations <- forall (m :: * -> *).
MonadIO m =>
WithHieDb
-> LookupModule m
-> IdeOptions
-> HieAstResult
-> Position
-> MaybeT m [Location]
AtPoint.gotoTypeDefinition WithHieDb
withHieDb (HieDbWriter
-> FilePath -> ModuleName -> Unit -> Bool -> MaybeT IdeAction Uri
lookupMod HieDbWriter
hiedbWriter) IdeOptions
opts HieAstResult
hf Position
pos'
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping
-> NormalizedFilePath -> [Location] -> IdeAction [Location]
toCurrentLocations PositionMapping
mapping NormalizedFilePath
file [Location]
locations

highlightAtPoint :: NormalizedFilePath -> Position -> IdeAction (Maybe [DocumentHighlight])
highlightAtPoint :: NormalizedFilePath
-> Position -> IdeAction (Maybe [DocumentHighlight])
highlightAtPoint NormalizedFilePath
file Position
pos = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
    (HAR Module
_ HieASTs a
hf RefMap a
rf Map Name [RealSrcSpan]
_ HieKind a
_,PositionMapping
mapping) <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useWithStaleFastMT GetHieAst
GetHieAst NormalizedFilePath
file
    !Position
pos' <- forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PositionMapping -> Position -> Maybe Position
fromCurrentPosition PositionMapping
mapping Position
pos)
    let toCurrentHighlight :: DocumentHighlight -> Maybe DocumentHighlight
toCurrentHighlight (DocumentHighlight Range
range Maybe DocumentHighlightKind
t) = forall a b c. (a -> b -> c) -> b -> a -> c
flip Range -> Maybe DocumentHighlightKind -> DocumentHighlight
DocumentHighlight Maybe DocumentHighlightKind
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
mapping Range
range
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DocumentHighlight -> Maybe DocumentHighlight
toCurrentHighlight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>forall (m :: * -> *) a.
Monad m =>
HieASTs a -> RefMap a -> Position -> MaybeT m [DocumentHighlight]
AtPoint.documentHighlight HieASTs a
hf RefMap a
rf Position
pos'

-- Refs are not an IDE action, so it is OK to be slow and (more) accurate
refsAtPoint :: NormalizedFilePath -> Position -> Action [Location]
refsAtPoint :: NormalizedFilePath -> Position -> Action [Location]
refsAtPoint NormalizedFilePath
file Position
pos = do
    ShakeExtras{WithHieDb
withHieDb :: WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb} <- Action ShakeExtras
getShakeExtras
    [NormalizedFilePath]
fs <- forall k v. HashMap k v -> [k]
HM.keys forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Action (HashMap NormalizedFilePath FileOfInterestStatus)
getFilesOfInterestUntracked
    HashMap NormalizedFilePath (HieAstResult, PositionMapping)
asts <- forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [NormalizedFilePath]
fs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) k v.
(Traversable f, IdeRule k v) =>
k
-> f NormalizedFilePath -> Action (f (Maybe (v, PositionMapping)))
usesWithStale GetHieAst
GetHieAst [NormalizedFilePath]
fs
    forall (m :: * -> *).
MonadIO m =>
WithHieDb
-> NormalizedFilePath -> Position -> FOIReferences -> m [Location]
AtPoint.referencesAtPoint WithHieDb
withHieDb NormalizedFilePath
file Position
pos (HashMap NormalizedFilePath (HieAstResult, PositionMapping)
-> FOIReferences
AtPoint.FOIReferences HashMap NormalizedFilePath (HieAstResult, PositionMapping)
asts)

workspaceSymbols :: T.Text -> IdeAction (Maybe [SymbolInformation])
workspaceSymbols :: Text -> IdeAction (Maybe [SymbolInformation])
workspaceSymbols Text
query = forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT forall a b. (a -> b) -> a -> b
$ do
  ShakeExtras{WithHieDb
withHieDb :: WithHieDb
$sel:withHieDb:ShakeExtras :: ShakeExtras -> WithHieDb
withHieDb} <- forall r (m :: * -> *). MonadReader r m => m r
ask
  [Res DefRow]
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ WithHieDb
withHieDb (\HieDb
hieDb -> HieDb -> FilePath -> IO [Res DefRow]
HieDb.searchDef HieDb
hieDb forall a b. (a -> b) -> a -> b
$ Text -> FilePath
T.unpack Text
query)
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Res DefRow -> Maybe SymbolInformation
AtPoint.defRowToSymbolInfo [Res DefRow]
res