InlayHint.hs

module LSP.Handlers.InlayHint where

import Control.Concurrent.MVar
import Control.Lens (to, (^.))
import Control.Monad (void)
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, sendRequest)
import Language.LSP.VFS
import Zwirn.Language.Compiler
import Zwirn.Language.LSP.InlayHints (Hint (..), getHints)

inlayHintHandler :: MVar Environment -> Handlers LSP
inlayHintHandler envMV = requestHandler LSP.SMethod_TextDocumentInlayHint $ \req responder -> do
  let doc = req ^. LSP.params . LSP.textDocument . LSP.uri . to LSP.toNormalizedUri

  mdoc <- getVirtualFile doc
  env <- liftIO $ readMVar envMV
  psHints <- case mdoc of
    Just vf -> do
      hci <- liftIO $ runCI env (getHints (virtualFileText vf))
      case hci of
        Right hs -> return $ map mkHint hs
        _ -> return []
    Nothing -> return []

  responder $ Right $ LSP.InL psHints

mkHint :: Hint -> LSP.InlayHint
mkHint (Hint pos ct desc) = LSP.InlayHint (toLSPPos pos) (LSP.InL ct) Nothing Nothing (Just $ LSP.InL desc) Nothing Nothing Nothing

refreshHints :: LSP ()
refreshHints = void $ sendRequest LSP.SMethod_WorkspaceInlayHintRefresh Nothing (const $ return ())