File.hs

module LSP.Handlers.File where

import Control.Concurrent.MVar
import Control.Lens (to, (^.))
import Control.Monad.IO.Class
import LSP.Diagnostic
import LSP.Util
import qualified Language.LSP.Protocol.Lens as LSP
import Language.LSP.Protocol.Message
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, notificationHandler)
import Language.LSP.VFS
import Zwirn.Language.Compiler
import Zwirn.Language.LSP.Diagnostics

didSaveHandler :: MVar Environment -> Handlers LSP
didSaveHandler envMV = notificationHandler LSP.SMethod_TextDocumentDidSave $ \msg -> do
  let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri
      mcont = msg ^. LSP.params . LSP.text
  case mcont of
    Just content -> do
      env <- liftIO $ readMVar envMV
      errs <- liftIO $ validateCode env content
      case errs of
        Just err -> publishDiags (LSP.toNormalizedUri doc) Nothing (makeErrorDiagnostic err)
        Nothing -> refreshDiagnostics
    Nothing -> return ()

didOpenHandler :: MVar Environment -> Handlers LSP
didOpenHandler envMV = notificationHandler LSP.SMethod_TextDocumentDidOpen $ \msg -> do
  let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri
      content = msg ^. LSP.params . LSP.textDocument . LSP.text
  env <- liftIO $ readMVar envMV
  errs <- liftIO $ validateCode env content
  case errs of
    Just err -> publishDiags (LSP.toNormalizedUri doc) Nothing (makeErrorDiagnostic err)
    Nothing -> refreshDiagnostics

didCloseHandler :: Handlers LSP
didCloseHandler = notificationHandler LSP.SMethod_TextDocumentDidClose $ const $ return ()

didChangeHandler :: MVar Environment -> Handlers LSP
didChangeHandler envMV = notificationHandler LSP.SMethod_TextDocumentDidChange $ \msg -> do
  let doc = msg ^. LSP.params . LSP.textDocument . LSP.uri . to LSP.toNormalizedUri
  mdoc <- getVirtualFile doc
  case mdoc of
    Just vf@(VirtualFile _ version _rope) -> do
      env <- liftIO $ readMVar envMV
      errs <- liftIO $ validateCode env (virtualFileText vf)
      case errs of
        Just err -> publishDiags doc (Just (fromIntegral version)) (makeErrorDiagnostic err)
        Nothing -> refreshDiagnostics
    _ -> debug "No virtual file found!"

cancelationHandler :: Handlers LSP
cancelationHandler = notificationHandler SMethod_CancelRequest $ \_ -> return ()