{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Language.LSP.Protocol.Internal.Types.LSPErrorCodes where
import Control.DeepSeq
import Data.Hashable
import GHC.Generics
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
import qualified Data.Aeson as Aeson
import qualified Data.Row.Aeson as Aeson
import qualified Data.Row.Hashable as Hashable
import qualified Data.Set
import qualified Data.String
import qualified Language.LSP.Protocol.Types.Common
import qualified Language.LSP.Protocol.Types.LspEnum
data LSPErrorCodes =
LSPErrorCodes_RequestFailed
|
LSPErrorCodes_ServerCancelled
|
LSPErrorCodes_ContentModified
|
LSPErrorCodes_RequestCancelled
| LSPErrorCodes_Custom Language.LSP.Protocol.Types.Common.Int32
deriving stock (Int -> LSPErrorCodes -> ShowS
[LSPErrorCodes] -> ShowS
LSPErrorCodes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LSPErrorCodes] -> ShowS
$cshowList :: [LSPErrorCodes] -> ShowS
show :: LSPErrorCodes -> String
$cshow :: LSPErrorCodes -> String
showsPrec :: Int -> LSPErrorCodes -> ShowS
$cshowsPrec :: Int -> LSPErrorCodes -> ShowS
Show, LSPErrorCodes -> LSPErrorCodes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LSPErrorCodes -> LSPErrorCodes -> Bool
$c/= :: LSPErrorCodes -> LSPErrorCodes -> Bool
== :: LSPErrorCodes -> LSPErrorCodes -> Bool
$c== :: LSPErrorCodes -> LSPErrorCodes -> Bool
Eq, Eq LSPErrorCodes
LSPErrorCodes -> LSPErrorCodes -> Bool
LSPErrorCodes -> LSPErrorCodes -> Ordering
LSPErrorCodes -> LSPErrorCodes -> LSPErrorCodes
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 :: LSPErrorCodes -> LSPErrorCodes -> LSPErrorCodes
$cmin :: LSPErrorCodes -> LSPErrorCodes -> LSPErrorCodes
max :: LSPErrorCodes -> LSPErrorCodes -> LSPErrorCodes
$cmax :: LSPErrorCodes -> LSPErrorCodes -> LSPErrorCodes
>= :: LSPErrorCodes -> LSPErrorCodes -> Bool
$c>= :: LSPErrorCodes -> LSPErrorCodes -> Bool
> :: LSPErrorCodes -> LSPErrorCodes -> Bool
$c> :: LSPErrorCodes -> LSPErrorCodes -> Bool
<= :: LSPErrorCodes -> LSPErrorCodes -> Bool
$c<= :: LSPErrorCodes -> LSPErrorCodes -> Bool
< :: LSPErrorCodes -> LSPErrorCodes -> Bool
$c< :: LSPErrorCodes -> LSPErrorCodes -> Bool
compare :: LSPErrorCodes -> LSPErrorCodes -> Ordering
$ccompare :: LSPErrorCodes -> LSPErrorCodes -> Ordering
Ord, forall x. Rep LSPErrorCodes x -> LSPErrorCodes
forall x. LSPErrorCodes -> Rep LSPErrorCodes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LSPErrorCodes x -> LSPErrorCodes
$cfrom :: forall x. LSPErrorCodes -> Rep LSPErrorCodes x
Generic)
deriving anyclass (LSPErrorCodes -> ()
forall a. (a -> ()) -> NFData a
rnf :: LSPErrorCodes -> ()
$crnf :: LSPErrorCodes -> ()
NFData, Eq LSPErrorCodes
Int -> LSPErrorCodes -> Int
LSPErrorCodes -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: LSPErrorCodes -> Int
$chash :: LSPErrorCodes -> Int
hashWithSalt :: Int -> LSPErrorCodes -> Int
$chashWithSalt :: Int -> LSPErrorCodes -> Int
Hashable)
deriving ( [LSPErrorCodes] -> Encoding
[LSPErrorCodes] -> Value
LSPErrorCodes -> Encoding
LSPErrorCodes -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LSPErrorCodes] -> Encoding
$ctoEncodingList :: [LSPErrorCodes] -> Encoding
toJSONList :: [LSPErrorCodes] -> Value
$ctoJSONList :: [LSPErrorCodes] -> Value
toEncoding :: LSPErrorCodes -> Encoding
$ctoEncoding :: LSPErrorCodes -> Encoding
toJSON :: LSPErrorCodes -> Value
$ctoJSON :: LSPErrorCodes -> Value
Aeson.ToJSON
, Value -> Parser [LSPErrorCodes]
Value -> Parser LSPErrorCodes
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [LSPErrorCodes]
$cparseJSONList :: Value -> Parser [LSPErrorCodes]
parseJSON :: Value -> Parser LSPErrorCodes
$cparseJSON :: Value -> Parser LSPErrorCodes
Aeson.FromJSON ) via (Language.LSP.Protocol.Types.LspEnum.AsLspEnum LSPErrorCodes Language.LSP.Protocol.Types.Common.Int32)
deriving forall ann. [LSPErrorCodes] -> Doc ann
forall ann. LSPErrorCodes -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [LSPErrorCodes] -> Doc ann
$cprettyList :: forall ann. [LSPErrorCodes] -> Doc ann
pretty :: forall ann. LSPErrorCodes -> Doc ann
$cpretty :: forall ann. LSPErrorCodes -> Doc ann
Pretty via (ViaJSON LSPErrorCodes)
instance Language.LSP.Protocol.Types.LspEnum.LspEnum LSPErrorCodes where
knownValues :: Set LSPErrorCodes
knownValues = forall a. Ord a => [a] -> Set a
Data.Set.fromList [LSPErrorCodes
LSPErrorCodes_RequestFailed
,LSPErrorCodes
LSPErrorCodes_ServerCancelled
,LSPErrorCodes
LSPErrorCodes_ContentModified
,LSPErrorCodes
LSPErrorCodes_RequestCancelled]
type EnumBaseType LSPErrorCodes = Language.LSP.Protocol.Types.Common.Int32
toEnumBaseType :: LSPErrorCodes -> EnumBaseType LSPErrorCodes
toEnumBaseType LSPErrorCodes
LSPErrorCodes_RequestFailed = Int32
-32803
toEnumBaseType LSPErrorCodes
LSPErrorCodes_ServerCancelled = Int32
-32802
toEnumBaseType LSPErrorCodes
LSPErrorCodes_ContentModified = Int32
-32801
toEnumBaseType LSPErrorCodes
LSPErrorCodes_RequestCancelled = Int32
-32800
toEnumBaseType (LSPErrorCodes_Custom Int32
arg) = Int32
arg
instance Language.LSP.Protocol.Types.LspEnum.LspOpenEnum LSPErrorCodes where
fromOpenEnumBaseType :: EnumBaseType LSPErrorCodes -> LSPErrorCodes
fromOpenEnumBaseType EnumBaseType LSPErrorCodes
-32803 = LSPErrorCodes
LSPErrorCodes_RequestFailed
fromOpenEnumBaseType EnumBaseType LSPErrorCodes
-32802 = LSPErrorCodes
LSPErrorCodes_ServerCancelled
fromOpenEnumBaseType EnumBaseType LSPErrorCodes
-32801 = LSPErrorCodes
LSPErrorCodes_ContentModified
fromOpenEnumBaseType EnumBaseType LSPErrorCodes
-32800 = LSPErrorCodes
LSPErrorCodes_RequestCancelled
fromOpenEnumBaseType EnumBaseType LSPErrorCodes
arg = Int32 -> LSPErrorCodes
LSPErrorCodes_Custom EnumBaseType LSPErrorCodes
arg