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.Protocol.Lens (HasVersion (version))
import Language.LSP.Protocol.Types
import Language.LSP.Server (LspT, getVersionedTextDoc, publishDiagnostics)
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 CodeDescription
-> Maybe Text
-> Text
-> Maybe [DiagnosticTag]
-> Maybe [DiagnosticRelatedInformation]
-> Maybe Value
-> Diagnostic
Diagnostic
Range
range
(forall a. a -> Maybe a
Just DiagnosticSeverity
severity)
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
Maybe Text
diagnosticSource
Text
msg
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
forall a. Maybe a
Nothing
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 -> Maybe Int32 -> DiagnosticsBySource -> m ()
publishDiagnostics
Int
maxDiagnostic
(Uri -> NormalizedUri
toNormalizedUri Uri
uri)
(forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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)
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) =
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)
[ Range -> DiagnosticSeverity -> Text -> Diagnostic
mkDiagnostic
(SrcLoc -> Range
rangeFromSrcLoc SrcLoc
srcloc)
DiagnosticSeverity
DiagnosticSeverity_Warning
(forall a. Doc a -> Text
docText Doc a
msg)
]
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
NoLoc Doc ()
_) = forall a. Monoid a => a
mempty
onDiag (ProgError loc :: Loc
loc@(Loc Pos
pos Pos
_) Doc ()
msg) =
forall k a. k -> a -> Map k a
M.singleton
(Pos -> Uri
posToUri Pos
pos)
[ Range -> DiagnosticSeverity -> Text -> Diagnostic
mkDiagnostic
(Loc -> Range
rangeFromLoc Loc
loc)
DiagnosticSeverity
DiagnosticSeverity_Error
(forall a. Doc a -> Text
docText Doc ()
msg)
]
onDiag (ProgWarning Loc
NoLoc Doc ()
_) = forall a. Monoid a => a
mempty
onDiag (ProgWarning loc :: Loc
loc@(Loc Pos
pos Pos
_) Doc ()
msg) =
forall k a. k -> a -> Map k a
M.singleton
(Pos -> Uri
posToUri Pos
pos)
[ Range -> DiagnosticSeverity -> Text -> Diagnostic
mkDiagnostic
(Loc -> Range
rangeFromLoc Loc
loc)
DiagnosticSeverity
DiagnosticSeverity_Error
(forall a. Doc a -> Text
docText Doc ()
msg)
]
maxDiagnostic :: Int
maxDiagnostic :: Int
maxDiagnostic = Int
100
diagnosticSource :: Maybe T.Text
diagnosticSource :: Maybe Text
diagnosticSource = forall a. a -> Maybe a
Just Text
"futhark"