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

module Language.Haskell.LSP.Types.Diagnostic where

import           Control.DeepSeq
import qualified Data.Aeson                                 as A
import           Data.Aeson.TH
import           Data.Scientific
import           Data.Text
import           GHC.Generics
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Location

-- ---------------------------------------------------------------------
{-
The protocol currently supports the following diagnostic severities:

enum DiagnosticSeverity {
    /**
     * Reports an error.
     */
    Error = 1,
    /**
     * Reports a warning.
     */
    Warning = 2,
    /**
     * Reports an information.
     */
    Information = 3,
    /**
     * Reports a hint.
     */
    Hint = 4
}
-}
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

{-
The diagnostic tags.

export namespace DiagnosticTag {
    /**
     * Unused or unnecessary code.
     *
     * Clients are allowed to render diagnostics with this tag faded out instead of having
     * an error squiggle.
     */
    export const Unnecessary: 1;
    /**
     * Deprecated or obsolete code.
     *
     * Clients are allowed to rendered diagnostics with this tag strike through.
     */
    export const Deprecated: 2;
}
-}
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

-- ---------------------------------------------------------------------
{-
Represents a related message and source code location for a diagnostic. This should be
used to point to code locations that cause or related to a diagnostics, e.g when duplicating
a symbol in a scope.

export interface DiagnosticRelatedInformation {
  /**
   * The location of this related diagnostic information.
   */
  location: Location;

  /**
   * The message of this related diagnostic information.
   */
  message: string;
}
-}

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

-- ---------------------------------------------------------------------
{-
Diagnostic

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#diagnostic

Represents a diagnostic, such as a compiler error or warning. Diagnostic objects
are only valid in the scope of a resource.

interface Diagnostic {
    /**
     * The range at which the message applies.
     */
    range: Range;

    /**
     * The diagnostic's severity. Can be omitted. If omitted it is up to the
     * client to interpret diagnostics as error, warning, info or hint.
     */
    severity?: number;

    /**
     * The diagnostic's code. Can be omitted.
     */
    code?: number | string;

    /**
     * A human-readable string describing the source of this
     * diagnostic, e.g. 'typescript' or 'super lint'.
     */
    source?: string;

    /**
     * The diagnostic's message.
     */
    message: string;

    /**
     * Additional metadata about the diagnostic.
     *
     * @since 3.15.0
     */
    tags?: DiagnosticTag[];

    /**
     * An array of related diagnostic information, e.g. when symbol-names within
     * a scope collide all definitions can be marked via this property.
     */
    relatedInformation?: DiagnosticRelatedInformation[];
}
-}

data NumberOrString =
  NumberValue Scientific
  | StringValue Text
  deriving (Int -> NumberOrString -> ShowS
[NumberOrString] -> ShowS
NumberOrString -> String
(Int -> NumberOrString -> ShowS)
-> (NumberOrString -> String)
-> ([NumberOrString] -> ShowS)
-> Show NumberOrString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumberOrString] -> ShowS
$cshowList :: [NumberOrString] -> ShowS
show :: NumberOrString -> String
$cshow :: NumberOrString -> String
showsPrec :: Int -> NumberOrString -> ShowS
$cshowsPrec :: Int -> NumberOrString -> ShowS
Show, ReadPrec [NumberOrString]
ReadPrec NumberOrString
Int -> ReadS NumberOrString
ReadS [NumberOrString]
(Int -> ReadS NumberOrString)
-> ReadS [NumberOrString]
-> ReadPrec NumberOrString
-> ReadPrec [NumberOrString]
-> Read NumberOrString
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NumberOrString]
$creadListPrec :: ReadPrec [NumberOrString]
readPrec :: ReadPrec NumberOrString
$creadPrec :: ReadPrec NumberOrString
readList :: ReadS [NumberOrString]
$creadList :: ReadS [NumberOrString]
readsPrec :: Int -> ReadS NumberOrString
$creadsPrec :: Int -> ReadS NumberOrString
Read, NumberOrString -> NumberOrString -> Bool
(NumberOrString -> NumberOrString -> Bool)
-> (NumberOrString -> NumberOrString -> Bool) -> Eq NumberOrString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumberOrString -> NumberOrString -> Bool
$c/= :: NumberOrString -> NumberOrString -> Bool
== :: NumberOrString -> NumberOrString -> Bool
$c== :: NumberOrString -> NumberOrString -> Bool
Eq, Eq NumberOrString
Eq NumberOrString
-> (NumberOrString -> NumberOrString -> Ordering)
-> (NumberOrString -> NumberOrString -> Bool)
-> (NumberOrString -> NumberOrString -> Bool)
-> (NumberOrString -> NumberOrString -> Bool)
-> (NumberOrString -> NumberOrString -> Bool)
-> (NumberOrString -> NumberOrString -> NumberOrString)
-> (NumberOrString -> NumberOrString -> NumberOrString)
-> Ord NumberOrString
NumberOrString -> NumberOrString -> Bool
NumberOrString -> NumberOrString -> Ordering
NumberOrString -> NumberOrString -> NumberOrString
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 :: NumberOrString -> NumberOrString -> NumberOrString
$cmin :: NumberOrString -> NumberOrString -> NumberOrString
max :: NumberOrString -> NumberOrString -> NumberOrString
$cmax :: NumberOrString -> NumberOrString -> NumberOrString
>= :: NumberOrString -> NumberOrString -> Bool
$c>= :: NumberOrString -> NumberOrString -> Bool
> :: NumberOrString -> NumberOrString -> Bool
$c> :: NumberOrString -> NumberOrString -> Bool
<= :: NumberOrString -> NumberOrString -> Bool
$c<= :: NumberOrString -> NumberOrString -> Bool
< :: NumberOrString -> NumberOrString -> Bool
$c< :: NumberOrString -> NumberOrString -> Bool
compare :: NumberOrString -> NumberOrString -> Ordering
$ccompare :: NumberOrString -> NumberOrString -> Ordering
$cp1Ord :: Eq NumberOrString
Ord, (forall x. NumberOrString -> Rep NumberOrString x)
-> (forall x. Rep NumberOrString x -> NumberOrString)
-> Generic NumberOrString
forall x. Rep NumberOrString x -> NumberOrString
forall x. NumberOrString -> Rep NumberOrString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NumberOrString x -> NumberOrString
$cfrom :: forall x. NumberOrString -> Rep NumberOrString x
Generic)

instance NFData NumberOrString

deriveJSON lspOptions { sumEncoding = A.UntaggedValue } ''NumberOrString

type DiagnosticSource = Text
data Diagnostic =
  Diagnostic
    { Diagnostic -> Range
_range              :: Range
    , Diagnostic -> Maybe DiagnosticSeverity
_severity           :: Maybe DiagnosticSeverity
    , Diagnostic -> Maybe NumberOrString
_code               :: Maybe NumberOrString
    , 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