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

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.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.Types                   (DocumentHighlight (..),
                                                       SymbolInformation (..))


-- | 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 `useE`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)
useE 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)
useE 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)
useE 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 (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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
-> Maybe (Maybe Range, [Text])
AtPoint.atPoint IdeOptions
opts HieAstResult
hf DocAndKindMap
dkMap HscEnv
env Position
pos'

toCurrentLocations :: PositionMapping -> [Location] -> [Location]
toCurrentLocations :: PositionMapping -> [Location] -> [Location]
toCurrentLocations PositionMapping
mapping = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Location -> Maybe Location
go
  where
    go :: Location -> Maybe Location
go (Location Uri
uri Range
range) = 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

-- | useE is useful to implement functions that aren’t rules but need shortcircuiting
-- e.g. getDefinition.
useE :: IdeRule k v => k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE :: forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE k
k = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast k
k

useNoFileE :: IdeRule k v => IdeState -> k -> MaybeT IdeAction v
useNoFileE :: forall k v. IdeRule k v => IdeState -> k -> MaybeT IdeAction v
useNoFileE IdeState
_ide k
k = 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)
useE k
k NormalizedFilePath
emptyFilePath

usesE :: IdeRule k v => k -> [NormalizedFilePath] -> MaybeT IdeAction [(v,PositionMapping)]
usesE :: forall k v.
IdeRule k v =>
k
-> [NormalizedFilePath] -> MaybeT IdeAction [(v, PositionMapping)]
usesE k
k = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> IdeAction (Maybe (v, PositionMapping))
useWithStaleFast k
k)

-- | 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)
useE GetHieAst
GetHieAst NormalizedFilePath
file
    (ImportMap Map ModuleName NormalizedFilePath
imports, PositionMapping
_) <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> MaybeT IdeAction (v, PositionMapping)
useE 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)
    PositionMapping -> [Location] -> [Location]
toCurrentLocations PositionMapping
mapping forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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'

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)
useE 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)
    PositionMapping -> [Location] -> [Location]
toCurrentLocations PositionMapping
mapping forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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'

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