-- | Handling of diagnostics in the language server - things like
-- warnings and errors.
module Futhark.LSP.Diagnostic
  ( publishWarningDiagnostics,
    publishErrorDiagnostics,
    diagnosticSource,
    maxDiagnostic,
  )
where

import Colog.Core (logStringStderr, (<&))
import Control.Lens ((^.))
import Data.Foldable (for_)
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Text qualified as T
import Futhark.Compiler.Program (ProgError (..))
import Futhark.LSP.Tool (posToUri, rangeFromLoc, rangeFromSrcLoc)
import Futhark.Util.Loc (Loc (..), SrcLoc, locOf)
import Futhark.Util.Pretty (Doc, docText)
import Language.LSP.Diagnostics (partitionBySource)
import Language.LSP.Server (LspT, getVersionedTextDoc, publishDiagnostics)
import Language.LSP.Types
  ( Diagnostic (Diagnostic),
    DiagnosticSeverity (DsError, DsWarning),
    Range,
    TextDocumentIdentifier (TextDocumentIdentifier),
    Uri,
    toNormalizedUri,
  )
import Language.LSP.Types.Lens (HasVersion (version))

mkDiagnostic :: Range -> DiagnosticSeverity -> T.Text -> Diagnostic
mkDiagnostic :: Range -> DiagnosticSeverity -> Text -> Diagnostic
mkDiagnostic Range
range DiagnosticSeverity
severity Text
msg = Range
-> Maybe DiagnosticSeverity
-> Maybe (Int32 |? Text)
-> Maybe Text
-> Text
-> Maybe (List DiagnosticTag)
-> Maybe (List DiagnosticRelatedInformation)
-> Diagnostic
Diagnostic Range
range (forall a. a -> Maybe a
Just DiagnosticSeverity
severity) forall a. Maybe a
Nothing Maybe Text
diagnosticSource Text
msg forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Publish diagnostics from a Uri to Diagnostics mapping.
publish :: [(Uri, [Diagnostic])] -> LspT () IO ()
publish :: [(Uri, [Diagnostic])] -> LspT () IO ()
publish [(Uri, [Diagnostic])]
uri_diags_map = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(Uri, [Diagnostic])]
uri_diags_map forall a b. (a -> b) -> a -> b
$ \(Uri
uri, [Diagnostic]
diags) -> do
  VersionedTextDocumentIdentifier
doc <- forall config (m :: * -> *).
MonadLsp config m =>
TextDocumentIdentifier -> m VersionedTextDocumentIdentifier
getVersionedTextDoc forall a b. (a -> b) -> a -> b
$ Uri -> TextDocumentIdentifier
TextDocumentIdentifier Uri
uri
  forall (m :: * -> *). MonadIO m => LogAction m [Char]
logStringStderr
    forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& ([Char]
"Publishing diagnostics for " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Uri
uri forall a. [a] -> [a] -> [a]
++ [Char]
" Version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (VersionedTextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasVersion s a => Lens' s a
version))
  forall config (m :: * -> *).
MonadLsp config m =>
Int
-> NormalizedUri
-> TextDocumentVersion
-> DiagnosticsBySource
-> m ()
publishDiagnostics Int
maxDiagnostic (Uri -> NormalizedUri
toNormalizedUri Uri
uri) (VersionedTextDocumentIdentifier
doc forall s a. s -> Getting a s a -> a
^. forall s a. HasVersion s a => Lens' s a
version) ([Diagnostic] -> DiagnosticsBySource
partitionBySource [Diagnostic]
diags)

-- | Send warning diagnostics to the client.
publishWarningDiagnostics :: [(SrcLoc, Doc a)] -> LspT () IO ()
publishWarningDiagnostics :: forall a. [(SrcLoc, Doc a)] -> LspT () IO ()
publishWarningDiagnostics [(SrcLoc, Doc a)]
warnings = do
  [(Uri, [Diagnostic])] -> LspT () IO ()
publish forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.assocs forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (SrcLoc, Doc a) -> Map Uri [Diagnostic]
onWarn [(SrcLoc, Doc a)]
warnings
  where
    onWarn :: (SrcLoc, Doc a) -> Map Uri [Diagnostic]
onWarn (SrcLoc
srcloc, Doc a
msg) =
      let diag :: Diagnostic
diag = Range -> DiagnosticSeverity -> Text -> Diagnostic
mkDiagnostic (SrcLoc -> Range
rangeFromSrcLoc SrcLoc
srcloc) DiagnosticSeverity
DsWarning (forall a. Doc a -> Text
docText Doc a
msg)
       in case forall a. Located a => a -> Loc
locOf SrcLoc
srcloc of
            Loc
NoLoc -> forall a. Monoid a => a
mempty
            Loc Pos
pos Pos
_ -> forall k a. k -> a -> Map k a
M.singleton (Pos -> Uri
posToUri Pos
pos) [Diagnostic
diag]

-- | Send error diagnostics to the client.
publishErrorDiagnostics :: NE.NonEmpty ProgError -> LspT () IO ()
publishErrorDiagnostics :: NonEmpty ProgError -> LspT () IO ()
publishErrorDiagnostics NonEmpty ProgError
errors =
  [(Uri, [Diagnostic])] -> LspT () IO ()
publish forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.assocs forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith forall a. [a] -> [a] -> [a]
(++) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ProgError -> Map Uri [Diagnostic]
onDiag forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList NonEmpty ProgError
errors
  where
    onDiag :: ProgError -> Map Uri [Diagnostic]
onDiag (ProgError Loc
loc Doc ()
msg) =
      let diag :: Diagnostic
diag = Range -> DiagnosticSeverity -> Text -> Diagnostic
mkDiagnostic (Loc -> Range
rangeFromLoc Loc
loc) DiagnosticSeverity
DsError (forall a. Doc a -> Text
docText Doc ()
msg)
       in case Loc
loc of
            Loc
NoLoc -> forall a. Monoid a => a
mempty
            Loc Pos
pos Pos
_ -> forall k a. k -> a -> Map k a
M.singleton (Pos -> Uri
posToUri Pos
pos) [Diagnostic
diag]
    onDiag (ProgWarning Loc
loc Doc ()
msg) =
      let diag :: Diagnostic
diag = Range -> DiagnosticSeverity -> Text -> Diagnostic
mkDiagnostic (Loc -> Range
rangeFromLoc Loc
loc) DiagnosticSeverity
DsError (forall a. Doc a -> Text
docText Doc ()
msg)
       in case Loc
loc of
            Loc
NoLoc -> forall a. Monoid a => a
mempty
            Loc Pos
pos Pos
_ -> forall k a. k -> a -> Map k a
M.singleton (Pos -> Uri
posToUri Pos
pos) [Diagnostic
diag]

-- | The maximum number of diagnostics to report.
maxDiagnostic :: Int
maxDiagnostic :: Int
maxDiagnostic = Int
100

-- | The source of the diagnostics.  (That is, the Futhark compiler,
-- but apparently the client must be told such things...)
diagnosticSource :: Maybe T.Text
diagnosticSource :: Maybe Text
diagnosticSource = forall a. a -> Maybe a
Just Text
"futhark"