Hover.hs

module LSP.Handlers.Hover where

import Control.Concurrent.MVar
import Control.Lens (to, (^.))
import Control.Monad.IO.Class
import LSP.Util
import qualified Language.LSP.Protocol.Lens as LSP
import qualified Language.LSP.Protocol.Message as LSP
import Language.LSP.Protocol.Types ()
import qualified Language.LSP.Protocol.Types as LSP
import Language.LSP.Server (Handlers, getVirtualFile, requestHandler)
import Language.LSP.VFS
import Zwirn.Language.Compiler
import Zwirn.Language.LSP.Hover

hoverHandler :: MVar Environment -> Handlers LSP
hoverHandler envMV = requestHandler
  LSP.SMethod_TextDocumentHover
  $ \req responder -> do
    let doc = req ^. LSP.params . LSP.textDocument . LSP.uri . to LSP.toNormalizedUri
        pos = req ^. LSP.params . LSP.position . to fromLSPPos
    mdoc <- getVirtualFile doc
    env <- liftIO $ readMVar envMV
    case mdoc of
      Just vf -> do
        mci <- liftIO $ runCI env (parseAndGetInfoAt (virtualFileText vf) pos)
        case mci of
          Right (Just (info, rng)) -> responder . Right . LSP.maybeToNull $ Just $ LSP.Hover (LSP.InL $ LSP.mkMarkdown info) (Just (toLSP rng))
          _ -> return ()
      Nothing -> return ()