Diagnostic.hs

module LSP.Diagnostic where

import qualified Data.Text as T
import LSP.Util
import Language.LSP.Diagnostics
import Language.LSP.Protocol.Types ()
import qualified Language.LSP.Protocol.Types as LSP
import Language.LSP.Server
import Zwirn.Language.Compiler
import Zwirn.Language.Location (Located (..), SrcLoc (..))
import Zwirn.Language.Rotate (RotationError (..))
import Zwirn.Language.TypeCheck.Constraint (TypeError (..))
import Zwirn.Language.TypeCheck.Types (Predicate (..))

type TextDocumentVersion = LSP.Int32

maxDiagnostics :: Int
maxDiagnostics = 16

publishDiags :: LSP.NormalizedUri -> Maybe TextDocumentVersion -> [LSP.Diagnostic] -> LSP ()
publishDiags doc version = publishDiagnostics maxDiagnostics doc version . partitionBySource

refreshDiagnostics :: LSP ()
refreshDiagnostics = flushDiagnosticsBySource maxDiagnostics (Just "zwirn-lsp")

makeErrorDiagnostic :: ErrorType -> [LSP.Diagnostic]
makeErrorDiagnostic (ParseErr msg r) =
  pure $
    LSP.Diagnostic
      (toLSP r)
      (Just LSP.DiagnosticSeverity_Error) -- severity
      Nothing -- code
      Nothing -- code description
      (Just "zwirn-lsp") -- source
      (T.pack msg)
      Nothing -- tags
      (Just []) -- related info
      Nothing -- data
makeErrorDiagnostic err@(RotErr (RotationError (SrcLoc r))) =
  pure $
    LSP.Diagnostic
      (toLSP r)
      (Just LSP.DiagnosticSeverity_Error)
      Nothing
      Nothing
      (Just "zwirn-lsp")
      (T.pack $ show err)
      Nothing
      (Just [])
      Nothing
makeErrorDiagnostic err@(TypeErr (NoInstance (Located (SrcLoc r) (IsIn _ _)))) =
  pure $
    LSP.Diagnostic
      (toLSP r)
      (Just LSP.DiagnosticSeverity_Error)
      Nothing
      Nothing
      (Just "zwirn-lsp")
      (T.pack $ show err)
      Nothing
      (Just [])
      Nothing
makeErrorDiagnostic err@(TypeErr (UnboundVariable (Located (SrcLoc r) _))) =
  pure $
    LSP.Diagnostic
      (toLSP r)
      (Just LSP.DiagnosticSeverity_Error)
      Nothing
      Nothing
      (Just "zwirn-lsp")
      (T.pack $ show err)
      Nothing
      (Just [])
      Nothing
makeErrorDiagnostic err@(TypeErr (UnificationFail (Located (SrcLoc r) _))) =
  pure $
    LSP.Diagnostic
      (toLSP r)
      (Just LSP.DiagnosticSeverity_Error)
      Nothing
      Nothing
      (Just "zwirn-lsp")
      (T.pack (show err))
      Nothing
      (Just [])
      Nothing
makeErrorDiagnostic (ManyErr errs) = concatMap makeErrorDiagnostic errs
makeErrorDiagnostic _ = []