module StaticLS.IDE.Hover (
    retrieveHover,
)
where

import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)
import Data.Maybe (listToMaybe)
import Data.Text (Text, intercalate)
import qualified GHC.Iface.Ext.Types as GHC
import GHC.Stack (HasCallStack)
import HieDb (pointCommand)
import Language.LSP.Types (
    Hover (..),
    HoverContents (..),
    MarkupContent (..),
    MarkupKind (..),
    Position,
    Range (..),
    TextDocumentIdentifier,
    sectionSeparator,
 )
import StaticLS.HIE
import StaticLS.HIE.File
import StaticLS.IDE.Hover.Info
import StaticLS.Maybe
import StaticLS.StaticEnv

-- | Retrive hover information. Incomplete
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
        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 -> HieAST Int -> (Maybe Range, [Text])
hoverInfo (HieFile -> Array Int HieTypeFlat
GHC.hie_types HieFile
hieFile))
        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 :: HoverContents
_contents = MarkupContent -> HoverContents
HoverContents (MarkupContent -> HoverContents) -> MarkupContent -> HoverContents
forall a b. (a -> b) -> a -> b
$ MarkupKind -> Text -> MarkupContent
MarkupContent MarkupKind
MkMarkdown (Text -> MarkupContent) -> Text -> MarkupContent
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
intercalate Text
sectionSeparator [Text]
contents
            }