module StaticLS.IDE.References (findRefs) where

import Control.Monad (join)
import Control.Monad.IO.Class
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.Maybe (catMaybes, fromMaybe)
import qualified GHC.Plugins as GHC
import qualified HieDb
import qualified Language.LSP.Protocol.Types as LSP
import StaticLS.Except
import StaticLS.HIE
import StaticLS.HIE.File
import StaticLS.Maybe
import StaticLS.StaticEnv

findRefs :: (HasStaticEnv m, MonadIO m) => LSP.TextDocumentIdentifier -> LSP.Position -> m [LSP.Location]
findRefs :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> Position -> m [Location]
findRefs TextDocumentIdentifier
tdi Position
position = do
    Maybe [Location]
mLocList <- 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
$ do
        HieFile
hieFile <- TextDocumentIdentifier -> MaybeT m HieFile
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> MaybeT m HieFile
getHieFileFromTdi TextDocumentIdentifier
tdi
        let hiedbPosition :: HieDbCoords
hiedbPosition = Position -> HieDbCoords
lspPositionToHieDbCoords Position
position
            names :: [Name]
names = HieFile -> HieDbCoords -> [Name]
namesAtPoint HieFile
hieFile HieDbCoords
hiedbPosition
            occNamesAndModNamesAtPoint :: [(OccName, Maybe ModuleName)]
occNamesAndModNamesAtPoint =
                (\Name
name -> (Name -> OccName
forall name. HasOccName name => name -> OccName
GHC.occName Name
name, (GenModule Unit -> ModuleName)
-> Maybe (GenModule Unit) -> Maybe ModuleName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName (Maybe (GenModule Unit) -> Maybe ModuleName)
-> (Name -> Maybe (GenModule Unit)) -> Name -> Maybe ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Maybe (GenModule Unit)
GHC.nameModule_maybe (Name -> Maybe ModuleName) -> Name -> Maybe ModuleName
forall a b. (a -> b) -> a -> b
$ Name
name))
                    (Name -> (OccName, Maybe ModuleName))
-> [Name] -> [(OccName, Maybe ModuleName)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
names
        [Res RefRow]
refResRows <-
            m [Res RefRow] -> MaybeT m [Res RefRow]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Res RefRow] -> MaybeT m [Res RefRow])
-> m [Res RefRow] -> MaybeT m [Res RefRow]
forall a b. (a -> b) -> a -> b
$ (Maybe [Res RefRow] -> [Res RefRow])
-> m (Maybe [Res RefRow]) -> m [Res RefRow]
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Res RefRow] -> Maybe [Res RefRow] -> [Res RefRow]
forall a. a -> Maybe a -> a
fromMaybe []) (m (Maybe [Res RefRow]) -> m [Res RefRow])
-> m (Maybe [Res RefRow]) -> m [Res RefRow]
forall a b. (a -> b) -> a -> b
$ MaybeT m [Res RefRow] -> m (Maybe [Res RefRow])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m [Res RefRow] -> m (Maybe [Res RefRow]))
-> MaybeT m [Res RefRow] -> m (Maybe [Res RefRow])
forall a b. (a -> b) -> a -> b
$ (HieDb -> IO [Res RefRow]) -> MaybeT m [Res RefRow]
forall (m :: * -> *) a.
(HasStaticEnv m, MonadIO m) =>
(HieDb -> IO a) -> MaybeT m a
runHieDbMaybeT ((HieDb -> IO [Res RefRow]) -> MaybeT m [Res RefRow])
-> (HieDb -> IO [Res RefRow]) -> MaybeT m [Res RefRow]
forall a b. (a -> b) -> a -> b
$ \HieDb
hieDb -> do
                [[Res RefRow]] -> [Res RefRow]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join
                    ([[Res RefRow]] -> [Res RefRow])
-> IO [[Res RefRow]] -> IO [Res RefRow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((OccName, Maybe ModuleName) -> IO [Res RefRow])
-> [(OccName, Maybe ModuleName)] -> IO [[Res RefRow]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                        ( \(OccName
occ, Maybe ModuleName
mModName) -> do
                            HieDb
-> Bool
-> OccName
-> Maybe ModuleName
-> Maybe Unit
-> [FilePath]
-> IO [Res RefRow]
HieDb.findReferences HieDb
hieDb Bool
False OccName
occ Maybe ModuleName
mModName Maybe Unit
forall a. Maybe a
Nothing []
                        )
                        [(OccName, Maybe ModuleName)]
occNamesAndModNamesAtPoint
        m [Location] -> MaybeT m [Location]
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m [Location] -> MaybeT m [Location])
-> m [Location] -> MaybeT m [Location]
forall a b. (a -> b) -> a -> b
$ [Maybe Location] -> [Location]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Location] -> [Location])
-> m [Maybe Location] -> m [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Res RefRow -> m (Maybe Location))
-> [Res RefRow] -> m [Maybe Location]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (MaybeT m Location -> m (Maybe Location)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Location -> m (Maybe Location))
-> (Res RefRow -> MaybeT m Location)
-> Res RefRow
-> m (Maybe Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Res RefRow -> MaybeT m Location
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
Res RefRow -> MaybeT m Location
refRowToLocation) [Res RefRow]
refResRows
    [Location] -> m [Location]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Location] -> m [Location]) -> [Location] -> m [Location]
forall a b. (a -> b) -> a -> b
$ [Location] -> Maybe [Location] -> [Location]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [Location]
mLocList

refRowToLocation :: (HasStaticEnv m, MonadIO m) => HieDb.Res HieDb.RefRow -> MaybeT m LSP.Location
refRowToLocation :: forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
Res RefRow -> MaybeT m Location
refRowToLocation (RefRow
refRow HieDb.:. ModuleInfo
_) = do
    let start :: Maybe Position
start = Except UIntConversionException Position -> Maybe Position
forall a b. Except a b -> Maybe b
exceptToMaybe (Except UIntConversionException Position -> Maybe Position)
-> Except UIntConversionException Position -> Maybe Position
forall a b. (a -> b) -> a -> b
$ HieDbCoords -> Except UIntConversionException Position
forall (m :: * -> *).
Monad m =>
HieDbCoords -> ExceptT UIntConversionException m Position
hiedbCoordsToLspPosition (RefRow
refRow.refSLine, RefRow
refRow.refSCol)
        end :: Maybe Position
end = Except UIntConversionException Position -> Maybe Position
forall a b. Except a b -> Maybe b
exceptToMaybe (Except UIntConversionException Position -> Maybe Position)
-> Except UIntConversionException Position -> Maybe Position
forall a b. (a -> b) -> a -> b
$ HieDbCoords -> Except UIntConversionException Position
forall (m :: * -> *).
Monad m =>
HieDbCoords -> ExceptT UIntConversionException m Position
hiedbCoordsToLspPosition (RefRow
refRow.refELine, RefRow
refRow.refECol)
        range :: Maybe Range
range = Position -> Position -> Range
LSP.Range (Position -> Position -> Range)
-> Maybe Position -> Maybe (Position -> Range)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Position
start Maybe (Position -> Range) -> Maybe Position -> Maybe Range
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Position
end
        hieFilePath :: FilePath
hieFilePath = RefRow
refRow.refSrc
    FilePath
file <- FilePath -> MaybeT m FilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
FilePath -> MaybeT m FilePath
hieFilePathToSrcFilePath FilePath
hieFilePath
    let lspUri :: Uri
lspUri = NormalizedUri -> Uri
LSP.fromNormalizedUri (NormalizedUri -> Uri)
-> (FilePath -> NormalizedUri) -> FilePath -> Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NormalizedFilePath -> NormalizedUri
LSP.normalizedFilePathToUri (NormalizedFilePath -> NormalizedUri)
-> (FilePath -> NormalizedFilePath) -> FilePath -> NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> NormalizedFilePath
LSP.toNormalizedFilePath (FilePath -> Uri) -> FilePath -> Uri
forall a b. (a -> b) -> a -> b
$ FilePath
file
    Maybe Location -> MaybeT m Location
forall (f :: * -> *) (g :: * -> *) a.
(Functor f, Foldable f, Alternative g) =>
f a -> g a
toAlt (Maybe Location -> MaybeT m Location)
-> Maybe Location -> MaybeT m Location
forall a b. (a -> b) -> a -> b
$ Uri -> Range -> Location
LSP.Location Uri
lspUri (Range -> Location) -> Maybe Range -> Maybe Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Range
range