{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE TypeOperators              #-}

module Language.LSP.Types.Diagnostic where

import           Control.DeepSeq
import qualified Data.Aeson                                 as A
import           Data.Aeson.TH
import           Data.Text
import           GHC.Generics
import           Language.LSP.Types.Common
import           Language.LSP.Types.Location
import           Language.LSP.Types.Uri
import           Language.LSP.Types.Utils

-- ---------------------------------------------------------------------

data DiagnosticSeverity
  = DsError   -- ^ Error = 1,
  | DsWarning -- ^ Warning = 2,
  | DsInfo    -- ^ Info = 3,
  | DsHint    -- ^ Hint = 4
  deriving (DiagnosticSeverity -> DiagnosticSeverity -> Bool
(DiagnosticSeverity -> DiagnosticSeverity -> Bool)
-> (DiagnosticSeverity -> DiagnosticSeverity -> Bool)
-> Eq DiagnosticSeverity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
$c/= :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
== :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
$c== :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
Eq,Eq DiagnosticSeverity
Eq DiagnosticSeverity
-> (DiagnosticSeverity -> DiagnosticSeverity -> Ordering)
-> (DiagnosticSeverity -> DiagnosticSeverity -> Bool)
-> (DiagnosticSeverity -> DiagnosticSeverity -> Bool)
-> (DiagnosticSeverity -> DiagnosticSeverity -> Bool)
-> (DiagnosticSeverity -> DiagnosticSeverity -> Bool)
-> (DiagnosticSeverity -> DiagnosticSeverity -> DiagnosticSeverity)
-> (DiagnosticSeverity -> DiagnosticSeverity -> DiagnosticSeverity)
-> Ord DiagnosticSeverity
DiagnosticSeverity -> DiagnosticSeverity -> Bool
DiagnosticSeverity -> DiagnosticSeverity -> Ordering
DiagnosticSeverity -> DiagnosticSeverity -> DiagnosticSeverity
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DiagnosticSeverity -> DiagnosticSeverity -> DiagnosticSeverity
$cmin :: DiagnosticSeverity -> DiagnosticSeverity -> DiagnosticSeverity
max :: DiagnosticSeverity -> DiagnosticSeverity -> DiagnosticSeverity
$cmax :: DiagnosticSeverity -> DiagnosticSeverity -> DiagnosticSeverity
>= :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
$c>= :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
> :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
$c> :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
<= :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
$c<= :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
< :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
$c< :: DiagnosticSeverity -> DiagnosticSeverity -> Bool
compare :: DiagnosticSeverity -> DiagnosticSeverity -> Ordering
$ccompare :: DiagnosticSeverity -> DiagnosticSeverity -> Ordering
$cp1Ord :: Eq DiagnosticSeverity
Ord,Int -> DiagnosticSeverity -> ShowS
[DiagnosticSeverity] -> ShowS
DiagnosticSeverity -> String
(Int -> DiagnosticSeverity -> ShowS)
-> (DiagnosticSeverity -> String)
-> ([DiagnosticSeverity] -> ShowS)
-> Show DiagnosticSeverity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiagnosticSeverity] -> ShowS
$cshowList :: [DiagnosticSeverity] -> ShowS
show :: DiagnosticSeverity -> String
$cshow :: DiagnosticSeverity -> String
showsPrec :: Int -> DiagnosticSeverity -> ShowS
$cshowsPrec :: Int -> DiagnosticSeverity -> ShowS
Show,ReadPrec [DiagnosticSeverity]
ReadPrec DiagnosticSeverity
Int -> ReadS DiagnosticSeverity
ReadS [DiagnosticSeverity]
(Int -> ReadS DiagnosticSeverity)
-> ReadS [DiagnosticSeverity]
-> ReadPrec DiagnosticSeverity
-> ReadPrec [DiagnosticSeverity]
-> Read DiagnosticSeverity
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DiagnosticSeverity]
$creadListPrec :: ReadPrec [DiagnosticSeverity]
readPrec :: ReadPrec DiagnosticSeverity
$creadPrec :: ReadPrec DiagnosticSeverity
readList :: ReadS [DiagnosticSeverity]
$creadList :: ReadS [DiagnosticSeverity]
readsPrec :: Int -> ReadS DiagnosticSeverity
$creadsPrec :: Int -> ReadS DiagnosticSeverity
Read, (forall x. DiagnosticSeverity -> Rep DiagnosticSeverity x)
-> (forall x. Rep DiagnosticSeverity x -> DiagnosticSeverity)
-> Generic DiagnosticSeverity
forall x. Rep DiagnosticSeverity x -> DiagnosticSeverity
forall x. DiagnosticSeverity -> Rep DiagnosticSeverity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiagnosticSeverity x -> DiagnosticSeverity
$cfrom :: forall x. DiagnosticSeverity -> Rep DiagnosticSeverity x
Generic)

instance NFData DiagnosticSeverity

instance A.ToJSON DiagnosticSeverity where
  toJSON :: DiagnosticSeverity -> Value
toJSON DiagnosticSeverity
DsError   = Scientific -> Value
A.Number Scientific
1
  toJSON DiagnosticSeverity
DsWarning = Scientific -> Value
A.Number Scientific
2
  toJSON DiagnosticSeverity
DsInfo    = Scientific -> Value
A.Number Scientific
3
  toJSON DiagnosticSeverity
DsHint    = Scientific -> Value
A.Number Scientific
4

instance A.FromJSON DiagnosticSeverity where
  parseJSON :: Value -> Parser DiagnosticSeverity
parseJSON (A.Number Scientific
1) = DiagnosticSeverity -> Parser DiagnosticSeverity
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiagnosticSeverity
DsError
  parseJSON (A.Number Scientific
2) = DiagnosticSeverity -> Parser DiagnosticSeverity
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiagnosticSeverity
DsWarning
  parseJSON (A.Number Scientific
3) = DiagnosticSeverity -> Parser DiagnosticSeverity
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiagnosticSeverity
DsInfo
  parseJSON (A.Number Scientific
4) = DiagnosticSeverity -> Parser DiagnosticSeverity
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiagnosticSeverity
DsHint
  parseJSON Value
_            = Parser DiagnosticSeverity
forall a. Monoid a => a
mempty

data DiagnosticTag
  -- | Unused or unnecessary code.
  --
  -- Clients are allowed to render diagnostics with this tag faded out
  -- instead of having an error squiggle.
  = DtUnnecessary
  -- | Deprecated or obsolete code.
  --
  -- Clients are allowed to rendered diagnostics with this tag strike
  -- through.
  | DtDeprecated
  deriving (DiagnosticTag -> DiagnosticTag -> Bool
(DiagnosticTag -> DiagnosticTag -> Bool)
-> (DiagnosticTag -> DiagnosticTag -> Bool) -> Eq DiagnosticTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiagnosticTag -> DiagnosticTag -> Bool
$c/= :: DiagnosticTag -> DiagnosticTag -> Bool
== :: DiagnosticTag -> DiagnosticTag -> Bool
$c== :: DiagnosticTag -> DiagnosticTag -> Bool
Eq, Eq DiagnosticTag
Eq DiagnosticTag
-> (DiagnosticTag -> DiagnosticTag -> Ordering)
-> (DiagnosticTag -> DiagnosticTag -> Bool)
-> (DiagnosticTag -> DiagnosticTag -> Bool)
-> (DiagnosticTag -> DiagnosticTag -> Bool)
-> (DiagnosticTag -> DiagnosticTag -> Bool)
-> (DiagnosticTag -> DiagnosticTag -> DiagnosticTag)
-> (DiagnosticTag -> DiagnosticTag -> DiagnosticTag)
-> Ord DiagnosticTag
DiagnosticTag -> DiagnosticTag -> Bool
DiagnosticTag -> DiagnosticTag -> Ordering
DiagnosticTag -> DiagnosticTag -> DiagnosticTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DiagnosticTag -> DiagnosticTag -> DiagnosticTag
$cmin :: DiagnosticTag -> DiagnosticTag -> DiagnosticTag
max :: DiagnosticTag -> DiagnosticTag -> DiagnosticTag
$cmax :: DiagnosticTag -> DiagnosticTag -> DiagnosticTag
>= :: DiagnosticTag -> DiagnosticTag -> Bool
$c>= :: DiagnosticTag -> DiagnosticTag -> Bool
> :: DiagnosticTag -> DiagnosticTag -> Bool
$c> :: DiagnosticTag -> DiagnosticTag -> Bool
<= :: DiagnosticTag -> DiagnosticTag -> Bool
$c<= :: DiagnosticTag -> DiagnosticTag -> Bool
< :: DiagnosticTag -> DiagnosticTag -> Bool
$c< :: DiagnosticTag -> DiagnosticTag -> Bool
compare :: DiagnosticTag -> DiagnosticTag -> Ordering
$ccompare :: DiagnosticTag -> DiagnosticTag -> Ordering
$cp1Ord :: Eq DiagnosticTag
Ord, Int -> DiagnosticTag -> ShowS
[DiagnosticTag] -> ShowS
DiagnosticTag -> String
(Int -> DiagnosticTag -> ShowS)
-> (DiagnosticTag -> String)
-> ([DiagnosticTag] -> ShowS)
-> Show DiagnosticTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiagnosticTag] -> ShowS
$cshowList :: [DiagnosticTag] -> ShowS
show :: DiagnosticTag -> String
$cshow :: DiagnosticTag -> String
showsPrec :: Int -> DiagnosticTag -> ShowS
$cshowsPrec :: Int -> DiagnosticTag -> ShowS
Show, ReadPrec [DiagnosticTag]
ReadPrec DiagnosticTag
Int -> ReadS DiagnosticTag
ReadS [DiagnosticTag]
(Int -> ReadS DiagnosticTag)
-> ReadS [DiagnosticTag]
-> ReadPrec DiagnosticTag
-> ReadPrec [DiagnosticTag]
-> Read DiagnosticTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DiagnosticTag]
$creadListPrec :: ReadPrec [DiagnosticTag]
readPrec :: ReadPrec DiagnosticTag
$creadPrec :: ReadPrec DiagnosticTag
readList :: ReadS [DiagnosticTag]
$creadList :: ReadS [DiagnosticTag]
readsPrec :: Int -> ReadS DiagnosticTag
$creadsPrec :: Int -> ReadS DiagnosticTag
Read, (forall x. DiagnosticTag -> Rep DiagnosticTag x)
-> (forall x. Rep DiagnosticTag x -> DiagnosticTag)
-> Generic DiagnosticTag
forall x. Rep DiagnosticTag x -> DiagnosticTag
forall x. DiagnosticTag -> Rep DiagnosticTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiagnosticTag x -> DiagnosticTag
$cfrom :: forall x. DiagnosticTag -> Rep DiagnosticTag x
Generic)

instance NFData DiagnosticTag

instance A.ToJSON DiagnosticTag where
  toJSON :: DiagnosticTag -> Value
toJSON DiagnosticTag
DtUnnecessary = Scientific -> Value
A.Number Scientific
1
  toJSON DiagnosticTag
DtDeprecated  = Scientific -> Value
A.Number Scientific
2

instance A.FromJSON DiagnosticTag where
  parseJSON :: Value -> Parser DiagnosticTag
parseJSON (A.Number Scientific
1) = DiagnosticTag -> Parser DiagnosticTag
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiagnosticTag
DtUnnecessary
  parseJSON (A.Number Scientific
2) = DiagnosticTag -> Parser DiagnosticTag
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiagnosticTag
DtDeprecated
  parseJSON Value
_            = Parser DiagnosticTag
forall a. Monoid a => a
mempty

-- ---------------------------------------------------------------------

data DiagnosticRelatedInformation =
  DiagnosticRelatedInformation
    { DiagnosticRelatedInformation -> Location
_location :: Location
    , DiagnosticRelatedInformation -> Text
_message  :: Text
    } deriving (Int -> DiagnosticRelatedInformation -> ShowS
[DiagnosticRelatedInformation] -> ShowS
DiagnosticRelatedInformation -> String
(Int -> DiagnosticRelatedInformation -> ShowS)
-> (DiagnosticRelatedInformation -> String)
-> ([DiagnosticRelatedInformation] -> ShowS)
-> Show DiagnosticRelatedInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiagnosticRelatedInformation] -> ShowS
$cshowList :: [DiagnosticRelatedInformation] -> ShowS
show :: DiagnosticRelatedInformation -> String
$cshow :: DiagnosticRelatedInformation -> String
showsPrec :: Int -> DiagnosticRelatedInformation -> ShowS
$cshowsPrec :: Int -> DiagnosticRelatedInformation -> ShowS
Show, ReadPrec [DiagnosticRelatedInformation]
ReadPrec DiagnosticRelatedInformation
Int -> ReadS DiagnosticRelatedInformation
ReadS [DiagnosticRelatedInformation]
(Int -> ReadS DiagnosticRelatedInformation)
-> ReadS [DiagnosticRelatedInformation]
-> ReadPrec DiagnosticRelatedInformation
-> ReadPrec [DiagnosticRelatedInformation]
-> Read DiagnosticRelatedInformation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DiagnosticRelatedInformation]
$creadListPrec :: ReadPrec [DiagnosticRelatedInformation]
readPrec :: ReadPrec DiagnosticRelatedInformation
$creadPrec :: ReadPrec DiagnosticRelatedInformation
readList :: ReadS [DiagnosticRelatedInformation]
$creadList :: ReadS [DiagnosticRelatedInformation]
readsPrec :: Int -> ReadS DiagnosticRelatedInformation
$creadsPrec :: Int -> ReadS DiagnosticRelatedInformation
Read, DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
(DiagnosticRelatedInformation
 -> DiagnosticRelatedInformation -> Bool)
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> Bool)
-> Eq DiagnosticRelatedInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
$c/= :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
== :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
$c== :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
Eq, Eq DiagnosticRelatedInformation
Eq DiagnosticRelatedInformation
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> Ordering)
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> Bool)
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> Bool)
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> Bool)
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> Bool)
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> DiagnosticRelatedInformation)
-> (DiagnosticRelatedInformation
    -> DiagnosticRelatedInformation -> DiagnosticRelatedInformation)
-> Ord DiagnosticRelatedInformation
DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Ordering
DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> DiagnosticRelatedInformation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> DiagnosticRelatedInformation
$cmin :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> DiagnosticRelatedInformation
max :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> DiagnosticRelatedInformation
$cmax :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> DiagnosticRelatedInformation
>= :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
$c>= :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
> :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
$c> :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
<= :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
$c<= :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
< :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
$c< :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Bool
compare :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Ordering
$ccompare :: DiagnosticRelatedInformation
-> DiagnosticRelatedInformation -> Ordering
$cp1Ord :: Eq DiagnosticRelatedInformation
Ord, (forall x.
 DiagnosticRelatedInformation -> Rep DiagnosticRelatedInformation x)
-> (forall x.
    Rep DiagnosticRelatedInformation x -> DiagnosticRelatedInformation)
-> Generic DiagnosticRelatedInformation
forall x.
Rep DiagnosticRelatedInformation x -> DiagnosticRelatedInformation
forall x.
DiagnosticRelatedInformation -> Rep DiagnosticRelatedInformation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DiagnosticRelatedInformation x -> DiagnosticRelatedInformation
$cfrom :: forall x.
DiagnosticRelatedInformation -> Rep DiagnosticRelatedInformation x
Generic)

instance NFData DiagnosticRelatedInformation

deriveJSON lspOptions ''DiagnosticRelatedInformation

-- ---------------------------------------------------------------------

type DiagnosticSource = Text
data Diagnostic =
  Diagnostic
    { Diagnostic -> Range
_range              :: Range
    , Diagnostic -> Maybe DiagnosticSeverity
_severity           :: Maybe DiagnosticSeverity
    , Diagnostic -> Maybe (Int |? Text)
_code               :: Maybe (Int |? Text)
    , Diagnostic -> Maybe Text
_source             :: Maybe DiagnosticSource
    , Diagnostic -> Text
_message            :: Text
    , Diagnostic -> Maybe (List DiagnosticTag)
_tags               :: Maybe (List DiagnosticTag)
    , Diagnostic -> Maybe (List DiagnosticRelatedInformation)
_relatedInformation :: Maybe (List DiagnosticRelatedInformation)
    } deriving (Int -> Diagnostic -> ShowS
[Diagnostic] -> ShowS
Diagnostic -> String
(Int -> Diagnostic -> ShowS)
-> (Diagnostic -> String)
-> ([Diagnostic] -> ShowS)
-> Show Diagnostic
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diagnostic] -> ShowS
$cshowList :: [Diagnostic] -> ShowS
show :: Diagnostic -> String
$cshow :: Diagnostic -> String
showsPrec :: Int -> Diagnostic -> ShowS
$cshowsPrec :: Int -> Diagnostic -> ShowS
Show, ReadPrec [Diagnostic]
ReadPrec Diagnostic
Int -> ReadS Diagnostic
ReadS [Diagnostic]
(Int -> ReadS Diagnostic)
-> ReadS [Diagnostic]
-> ReadPrec Diagnostic
-> ReadPrec [Diagnostic]
-> Read Diagnostic
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Diagnostic]
$creadListPrec :: ReadPrec [Diagnostic]
readPrec :: ReadPrec Diagnostic
$creadPrec :: ReadPrec Diagnostic
readList :: ReadS [Diagnostic]
$creadList :: ReadS [Diagnostic]
readsPrec :: Int -> ReadS Diagnostic
$creadsPrec :: Int -> ReadS Diagnostic
Read, Diagnostic -> Diagnostic -> Bool
(Diagnostic -> Diagnostic -> Bool)
-> (Diagnostic -> Diagnostic -> Bool) -> Eq Diagnostic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diagnostic -> Diagnostic -> Bool
$c/= :: Diagnostic -> Diagnostic -> Bool
== :: Diagnostic -> Diagnostic -> Bool
$c== :: Diagnostic -> Diagnostic -> Bool
Eq, Eq Diagnostic
Eq Diagnostic
-> (Diagnostic -> Diagnostic -> Ordering)
-> (Diagnostic -> Diagnostic -> Bool)
-> (Diagnostic -> Diagnostic -> Bool)
-> (Diagnostic -> Diagnostic -> Bool)
-> (Diagnostic -> Diagnostic -> Bool)
-> (Diagnostic -> Diagnostic -> Diagnostic)
-> (Diagnostic -> Diagnostic -> Diagnostic)
-> Ord Diagnostic
Diagnostic -> Diagnostic -> Bool
Diagnostic -> Diagnostic -> Ordering
Diagnostic -> Diagnostic -> Diagnostic
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Diagnostic -> Diagnostic -> Diagnostic
$cmin :: Diagnostic -> Diagnostic -> Diagnostic
max :: Diagnostic -> Diagnostic -> Diagnostic
$cmax :: Diagnostic -> Diagnostic -> Diagnostic
>= :: Diagnostic -> Diagnostic -> Bool
$c>= :: Diagnostic -> Diagnostic -> Bool
> :: Diagnostic -> Diagnostic -> Bool
$c> :: Diagnostic -> Diagnostic -> Bool
<= :: Diagnostic -> Diagnostic -> Bool
$c<= :: Diagnostic -> Diagnostic -> Bool
< :: Diagnostic -> Diagnostic -> Bool
$c< :: Diagnostic -> Diagnostic -> Bool
compare :: Diagnostic -> Diagnostic -> Ordering
$ccompare :: Diagnostic -> Diagnostic -> Ordering
$cp1Ord :: Eq Diagnostic
Ord, (forall x. Diagnostic -> Rep Diagnostic x)
-> (forall x. Rep Diagnostic x -> Diagnostic) -> Generic Diagnostic
forall x. Rep Diagnostic x -> Diagnostic
forall x. Diagnostic -> Rep Diagnostic x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Diagnostic x -> Diagnostic
$cfrom :: forall x. Diagnostic -> Rep Diagnostic x
Generic)

instance NFData Diagnostic

deriveJSON lspOptions ''Diagnostic

-- -------------------------------------

data PublishDiagnosticsTagsClientCapabilities =
  PublishDiagnosticsTagsClientCapabilities
    { -- | The tags supported by the client.
      PublishDiagnosticsTagsClientCapabilities -> List DiagnosticTag
_valueSet :: List DiagnosticTag
    } deriving (Int -> PublishDiagnosticsTagsClientCapabilities -> ShowS
[PublishDiagnosticsTagsClientCapabilities] -> ShowS
PublishDiagnosticsTagsClientCapabilities -> String
(Int -> PublishDiagnosticsTagsClientCapabilities -> ShowS)
-> (PublishDiagnosticsTagsClientCapabilities -> String)
-> ([PublishDiagnosticsTagsClientCapabilities] -> ShowS)
-> Show PublishDiagnosticsTagsClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishDiagnosticsTagsClientCapabilities] -> ShowS
$cshowList :: [PublishDiagnosticsTagsClientCapabilities] -> ShowS
show :: PublishDiagnosticsTagsClientCapabilities -> String
$cshow :: PublishDiagnosticsTagsClientCapabilities -> String
showsPrec :: Int -> PublishDiagnosticsTagsClientCapabilities -> ShowS
$cshowsPrec :: Int -> PublishDiagnosticsTagsClientCapabilities -> ShowS
Show, ReadPrec [PublishDiagnosticsTagsClientCapabilities]
ReadPrec PublishDiagnosticsTagsClientCapabilities
Int -> ReadS PublishDiagnosticsTagsClientCapabilities
ReadS [PublishDiagnosticsTagsClientCapabilities]
(Int -> ReadS PublishDiagnosticsTagsClientCapabilities)
-> ReadS [PublishDiagnosticsTagsClientCapabilities]
-> ReadPrec PublishDiagnosticsTagsClientCapabilities
-> ReadPrec [PublishDiagnosticsTagsClientCapabilities]
-> Read PublishDiagnosticsTagsClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublishDiagnosticsTagsClientCapabilities]
$creadListPrec :: ReadPrec [PublishDiagnosticsTagsClientCapabilities]
readPrec :: ReadPrec PublishDiagnosticsTagsClientCapabilities
$creadPrec :: ReadPrec PublishDiagnosticsTagsClientCapabilities
readList :: ReadS [PublishDiagnosticsTagsClientCapabilities]
$creadList :: ReadS [PublishDiagnosticsTagsClientCapabilities]
readsPrec :: Int -> ReadS PublishDiagnosticsTagsClientCapabilities
$creadsPrec :: Int -> ReadS PublishDiagnosticsTagsClientCapabilities
Read, PublishDiagnosticsTagsClientCapabilities
-> PublishDiagnosticsTagsClientCapabilities -> Bool
(PublishDiagnosticsTagsClientCapabilities
 -> PublishDiagnosticsTagsClientCapabilities -> Bool)
-> (PublishDiagnosticsTagsClientCapabilities
    -> PublishDiagnosticsTagsClientCapabilities -> Bool)
-> Eq PublishDiagnosticsTagsClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishDiagnosticsTagsClientCapabilities
-> PublishDiagnosticsTagsClientCapabilities -> Bool
$c/= :: PublishDiagnosticsTagsClientCapabilities
-> PublishDiagnosticsTagsClientCapabilities -> Bool
== :: PublishDiagnosticsTagsClientCapabilities
-> PublishDiagnosticsTagsClientCapabilities -> Bool
$c== :: PublishDiagnosticsTagsClientCapabilities
-> PublishDiagnosticsTagsClientCapabilities -> Bool
Eq)

deriveJSON lspOptions ''PublishDiagnosticsTagsClientCapabilities

data PublishDiagnosticsClientCapabilities =
  PublishDiagnosticsClientCapabilities
    { -- | Whether the clients accepts diagnostics with related information.
      PublishDiagnosticsClientCapabilities -> Maybe Bool
_relatedInformation :: Maybe Bool
      -- | Client supports the tag property to provide metadata about a
      -- diagnostic.
      --
      -- Clients supporting tags have to handle unknown tags gracefully.
      -- 
      -- Since LSP 3.15.0
    , PublishDiagnosticsClientCapabilities
-> Maybe PublishDiagnosticsTagsClientCapabilities
_tagSupport :: Maybe PublishDiagnosticsTagsClientCapabilities
      -- | Whether the client interprets the version property of the
      -- @textDocument/publishDiagnostics@ notification's parameter.
      -- 
      -- Since LSP 3.15.0
    , PublishDiagnosticsClientCapabilities -> Maybe Bool
_versionSupport :: Maybe Bool
    } deriving (Int -> PublishDiagnosticsClientCapabilities -> ShowS
[PublishDiagnosticsClientCapabilities] -> ShowS
PublishDiagnosticsClientCapabilities -> String
(Int -> PublishDiagnosticsClientCapabilities -> ShowS)
-> (PublishDiagnosticsClientCapabilities -> String)
-> ([PublishDiagnosticsClientCapabilities] -> ShowS)
-> Show PublishDiagnosticsClientCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishDiagnosticsClientCapabilities] -> ShowS
$cshowList :: [PublishDiagnosticsClientCapabilities] -> ShowS
show :: PublishDiagnosticsClientCapabilities -> String
$cshow :: PublishDiagnosticsClientCapabilities -> String
showsPrec :: Int -> PublishDiagnosticsClientCapabilities -> ShowS
$cshowsPrec :: Int -> PublishDiagnosticsClientCapabilities -> ShowS
Show, ReadPrec [PublishDiagnosticsClientCapabilities]
ReadPrec PublishDiagnosticsClientCapabilities
Int -> ReadS PublishDiagnosticsClientCapabilities
ReadS [PublishDiagnosticsClientCapabilities]
(Int -> ReadS PublishDiagnosticsClientCapabilities)
-> ReadS [PublishDiagnosticsClientCapabilities]
-> ReadPrec PublishDiagnosticsClientCapabilities
-> ReadPrec [PublishDiagnosticsClientCapabilities]
-> Read PublishDiagnosticsClientCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublishDiagnosticsClientCapabilities]
$creadListPrec :: ReadPrec [PublishDiagnosticsClientCapabilities]
readPrec :: ReadPrec PublishDiagnosticsClientCapabilities
$creadPrec :: ReadPrec PublishDiagnosticsClientCapabilities
readList :: ReadS [PublishDiagnosticsClientCapabilities]
$creadList :: ReadS [PublishDiagnosticsClientCapabilities]
readsPrec :: Int -> ReadS PublishDiagnosticsClientCapabilities
$creadsPrec :: Int -> ReadS PublishDiagnosticsClientCapabilities
Read, PublishDiagnosticsClientCapabilities
-> PublishDiagnosticsClientCapabilities -> Bool
(PublishDiagnosticsClientCapabilities
 -> PublishDiagnosticsClientCapabilities -> Bool)
-> (PublishDiagnosticsClientCapabilities
    -> PublishDiagnosticsClientCapabilities -> Bool)
-> Eq PublishDiagnosticsClientCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishDiagnosticsClientCapabilities
-> PublishDiagnosticsClientCapabilities -> Bool
$c/= :: PublishDiagnosticsClientCapabilities
-> PublishDiagnosticsClientCapabilities -> Bool
== :: PublishDiagnosticsClientCapabilities
-> PublishDiagnosticsClientCapabilities -> Bool
$c== :: PublishDiagnosticsClientCapabilities
-> PublishDiagnosticsClientCapabilities -> Bool
Eq)

deriveJSON lspOptions ''PublishDiagnosticsClientCapabilities

data PublishDiagnosticsParams =
  PublishDiagnosticsParams
    { -- | The URI for which diagnostic information is reported.
      PublishDiagnosticsParams -> Uri
_uri         :: Uri
      -- | Optional the version number of the document the diagnostics are
      -- published for.
      -- 
      -- Since LSP 3.15.0
    , PublishDiagnosticsParams -> Maybe Int
_version     :: Maybe Int
      -- | An array of diagnostic information items.
    , PublishDiagnosticsParams -> List Diagnostic
_diagnostics :: List Diagnostic
    } deriving (ReadPrec [PublishDiagnosticsParams]
ReadPrec PublishDiagnosticsParams
Int -> ReadS PublishDiagnosticsParams
ReadS [PublishDiagnosticsParams]
(Int -> ReadS PublishDiagnosticsParams)
-> ReadS [PublishDiagnosticsParams]
-> ReadPrec PublishDiagnosticsParams
-> ReadPrec [PublishDiagnosticsParams]
-> Read PublishDiagnosticsParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublishDiagnosticsParams]
$creadListPrec :: ReadPrec [PublishDiagnosticsParams]
readPrec :: ReadPrec PublishDiagnosticsParams
$creadPrec :: ReadPrec PublishDiagnosticsParams
readList :: ReadS [PublishDiagnosticsParams]
$creadList :: ReadS [PublishDiagnosticsParams]
readsPrec :: Int -> ReadS PublishDiagnosticsParams
$creadsPrec :: Int -> ReadS PublishDiagnosticsParams
Read,Int -> PublishDiagnosticsParams -> ShowS
[PublishDiagnosticsParams] -> ShowS
PublishDiagnosticsParams -> String
(Int -> PublishDiagnosticsParams -> ShowS)
-> (PublishDiagnosticsParams -> String)
-> ([PublishDiagnosticsParams] -> ShowS)
-> Show PublishDiagnosticsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishDiagnosticsParams] -> ShowS
$cshowList :: [PublishDiagnosticsParams] -> ShowS
show :: PublishDiagnosticsParams -> String
$cshow :: PublishDiagnosticsParams -> String
showsPrec :: Int -> PublishDiagnosticsParams -> ShowS
$cshowsPrec :: Int -> PublishDiagnosticsParams -> ShowS
Show,PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
(PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool)
-> (PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool)
-> Eq PublishDiagnosticsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
$c/= :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
== :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
$c== :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
Eq)

deriveJSON lspOptions ''PublishDiagnosticsParams