module StaticLS.IDE.Hover (
    retrieveHover,
)
where

import Control.Monad.IO.Class
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.Maybe
import Data.Text (Text, intercalate)
import qualified GHC.Iface.Ext.Types as GHC
import GHC.Plugins as GHC
import HieDb (pointCommand)
import Language.LSP.Protocol.Types (
    Hover (..),
    MarkupContent (..),
    MarkupKind (..),
    Position,
    Range (..),
    TextDocumentIdentifier,
    sectionSeparator,
    type (|?) (..),
 )
import StaticLS.HI
import StaticLS.HI.File
import StaticLS.HIE
import StaticLS.HIE.File
import StaticLS.IDE.Hover.Info
import StaticLS.Maybe
import StaticLS.StaticEnv

-- | Retrieve hover information.
retrieveHover :: (HasCallStack, HasStaticEnv m, MonadIO m) => TextDocumentIdentifier -> Position -> m (Maybe Hover)
retrieveHover :: forall (m :: * -> *).
(HasCallStack, HasStaticEnv m, MonadIO m) =>
TextDocumentIdentifier -> Position -> m (Maybe Hover)
retrieveHover TextDocumentIdentifier
identifier Position
position = do
    MaybeT m Hover -> m (Maybe Hover)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT m Hover -> m (Maybe Hover))
-> MaybeT m Hover -> m (Maybe Hover)
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
identifier
        [NameDocs]
docs <- HieFile -> Position -> MaybeT m [NameDocs]
forall (m :: * -> *).
(HasCallStack, HasStaticEnv m, MonadIO m) =>
HieFile -> Position -> m [NameDocs]
docsAtPoint HieFile
hieFile Position
position
        let info :: Maybe (Maybe Range, [Text])
info =
                [(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
$
                    HieFile
-> (Int, Int)
-> Maybe (Int, Int)
-> (HieAST Int -> (Maybe Range, [Text]))
-> [(Maybe Range, [Text])]
forall a.
HieFile
-> (Int, Int) -> Maybe (Int, Int) -> (HieAST Int -> a) -> [a]
pointCommand
                        HieFile
hieFile
                        (Position -> (Int, Int)
lspPositionToHieDbCoords Position
position)
                        Maybe (Int, Int)
forall a. Maybe a
Nothing
                        (Array Int HieTypeFlat
-> [NameDocs] -> HieAST Int -> (Maybe Range, [Text])
hoverInfo (HieFile -> Array Int HieTypeFlat
GHC.hie_types HieFile
hieFile) [NameDocs]
docs)
        Maybe Hover -> MaybeT m Hover
forall (f :: * -> *) (g :: * -> *) a.
(Functor f, Foldable f, Alternative g) =>
f a -> g a
toAlt (Maybe Hover -> MaybeT m Hover) -> Maybe Hover -> MaybeT m Hover
forall a b. (a -> b) -> a -> b
$ (Maybe Range, [Text]) -> Hover
hoverInfoToHover ((Maybe Range, [Text]) -> Hover)
-> Maybe (Maybe Range, [Text]) -> Maybe Hover
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Maybe Range, [Text])
info
  where
    hoverInfoToHover :: (Maybe Range, [Text]) -> Hover
    hoverInfoToHover :: (Maybe Range, [Text]) -> Hover
hoverInfoToHover (Maybe Range
mRange, [Text]
contents) =
        Hover
            { $sel:_range:Hover :: Maybe Range
_range = Maybe Range
mRange
            , $sel:_contents:Hover :: MarkupContent |? (MarkedString |? [MarkedString])
_contents = MarkupContent -> MarkupContent |? (MarkedString |? [MarkedString])
forall a b. a -> a |? b
InL (MarkupContent
 -> MarkupContent |? (MarkedString |? [MarkedString]))
-> MarkupContent
-> MarkupContent |? (MarkedString |? [MarkedString])
forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MarkupKind_Markdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate Text
sectionSeparator [Text]
contents
            }

docsAtPoint :: (HasCallStack, HasStaticEnv m, MonadIO m) => GHC.HieFile -> Position -> m [NameDocs]
docsAtPoint :: forall (m :: * -> *).
(HasCallStack, HasStaticEnv m, MonadIO m) =>
HieFile -> Position -> m [NameDocs]
docsAtPoint HieFile
hieFile Position
position = do
    let names :: [Name]
names = HieFile -> (Int, Int) -> [Name]
namesAtPoint HieFile
hieFile (Position -> (Int, Int)
lspPositionToHieDbCoords Position
position)
        modNames :: [ModuleName]
modNames = (GenModule Unit -> ModuleName) -> [GenModule Unit] -> [ModuleName]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap GenModule Unit -> ModuleName
forall unit. GenModule unit -> ModuleName
GHC.moduleName ([GenModule Unit] -> [ModuleName])
-> ([Name] -> [GenModule Unit]) -> [Name] -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> Maybe (GenModule Unit)) -> [Name] -> [GenModule Unit]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Name -> Maybe (GenModule Unit)
GHC.nameModule_maybe ([Name] -> [ModuleName]) -> [Name] -> [ModuleName]
forall a b. (a -> b) -> a -> b
$ [Name]
names
    [HiFilePath]
modIfaceFiles <- [HiFilePath] -> Maybe [HiFilePath] -> [HiFilePath]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [HiFilePath] -> [HiFilePath])
-> m (Maybe [HiFilePath]) -> m [HiFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MaybeT m [HiFilePath] -> m (Maybe [HiFilePath])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT ((ModuleName -> MaybeT m HiFilePath)
-> [ModuleName] -> MaybeT m [HiFilePath]
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 ModuleName -> MaybeT m HiFilePath
forall (m :: * -> *).
(HasStaticEnv m, MonadIO m) =>
ModuleName -> MaybeT m HiFilePath
modToHiFile [ModuleName]
modNames)
    [ModIface]
modIfaces <- [Maybe ModIface] -> [ModIface]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ModIface] -> [ModIface])
-> m [Maybe ModIface] -> m [ModIface]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HiFilePath -> m (Maybe ModIface))
-> [HiFilePath] -> m [Maybe ModIface]
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 HiFilePath -> m (Maybe ModIface)
forall (m :: * -> *). MonadIO m => HiFilePath -> m (Maybe ModIface)
readHiFile [HiFilePath]
modIfaceFiles
    let docs :: [NameDocs]
docs = [Name] -> ModIface -> [NameDocs]
getDocsBatch [Name]
names (ModIface -> [NameDocs]) -> [ModIface] -> [NameDocs]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ModIface]
modIfaces
    [NameDocs] -> m [NameDocs]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [NameDocs]
docs