{- ORMOLU_DISABLE -}
{- HLINT ignore -}
-- THIS IS A GENERATED FILE, DO NOT EDIT

{-# OPTIONS_GHC -Wno-unused-imports #-}
{-# OPTIONS_GHC -Wno-unused-matches #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
module Language.LSP.Protocol.Internal.Types.SignatureHelp 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 Language.LSP.Protocol.Internal.Types.SignatureInformation
import qualified Language.LSP.Protocol.Types.Common

{-|
Signature help represents the signature of something
callable. There can be multiple signature but only one
active and only one active parameter.
-}
data SignatureHelp = SignatureHelp 
  { {-|
  One or more signatures.
  -}
  SignatureHelp -> [SignatureInformation]
_signatures :: [Language.LSP.Protocol.Internal.Types.SignatureInformation.SignatureInformation]
  , {-|
  The active signature. If omitted or the value lies outside the
  range of `signatures` the value defaults to zero or is ignored if
  the `SignatureHelp` has no signatures.

  Whenever possible implementors should make an active decision about
  the active signature and shouldn't rely on a default value.

  In future version of the protocol this property might become
  mandatory to better express this.
  -}
  SignatureHelp -> Maybe UInt
_activeSignature :: (Maybe Language.LSP.Protocol.Types.Common.UInt)
  , {-|
  The active parameter of the active signature. If omitted or the value
  lies outside the range of `signatures[activeSignature].parameters`
  defaults to 0 if the active signature has parameters. If
  the active signature has no parameters it is ignored.
  In future version of the protocol this property might become
  mandatory to better express the active parameter if the
  active signature does have any.
  -}
  SignatureHelp -> Maybe UInt
_activeParameter :: (Maybe Language.LSP.Protocol.Types.Common.UInt)
  }
  deriving stock (Int -> SignatureHelp -> ShowS
[SignatureHelp] -> ShowS
SignatureHelp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureHelp] -> ShowS
$cshowList :: [SignatureHelp] -> ShowS
show :: SignatureHelp -> String
$cshow :: SignatureHelp -> String
showsPrec :: Int -> SignatureHelp -> ShowS
$cshowsPrec :: Int -> SignatureHelp -> ShowS
Show, SignatureHelp -> SignatureHelp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureHelp -> SignatureHelp -> Bool
$c/= :: SignatureHelp -> SignatureHelp -> Bool
== :: SignatureHelp -> SignatureHelp -> Bool
$c== :: SignatureHelp -> SignatureHelp -> Bool
Eq, Eq SignatureHelp
SignatureHelp -> SignatureHelp -> Bool
SignatureHelp -> SignatureHelp -> Ordering
SignatureHelp -> SignatureHelp -> SignatureHelp
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 :: SignatureHelp -> SignatureHelp -> SignatureHelp
$cmin :: SignatureHelp -> SignatureHelp -> SignatureHelp
max :: SignatureHelp -> SignatureHelp -> SignatureHelp
$cmax :: SignatureHelp -> SignatureHelp -> SignatureHelp
>= :: SignatureHelp -> SignatureHelp -> Bool
$c>= :: SignatureHelp -> SignatureHelp -> Bool
> :: SignatureHelp -> SignatureHelp -> Bool
$c> :: SignatureHelp -> SignatureHelp -> Bool
<= :: SignatureHelp -> SignatureHelp -> Bool
$c<= :: SignatureHelp -> SignatureHelp -> Bool
< :: SignatureHelp -> SignatureHelp -> Bool
$c< :: SignatureHelp -> SignatureHelp -> Bool
compare :: SignatureHelp -> SignatureHelp -> Ordering
$ccompare :: SignatureHelp -> SignatureHelp -> Ordering
Ord, forall x. Rep SignatureHelp x -> SignatureHelp
forall x. SignatureHelp -> Rep SignatureHelp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SignatureHelp x -> SignatureHelp
$cfrom :: forall x. SignatureHelp -> Rep SignatureHelp x
Generic)
  deriving anyclass (SignatureHelp -> ()
forall a. (a -> ()) -> NFData a
rnf :: SignatureHelp -> ()
$crnf :: SignatureHelp -> ()
NFData, Eq SignatureHelp
Int -> SignatureHelp -> Int
SignatureHelp -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SignatureHelp -> Int
$chash :: SignatureHelp -> Int
hashWithSalt :: Int -> SignatureHelp -> Int
$chashWithSalt :: Int -> SignatureHelp -> Int
Hashable)
  deriving forall ann. [SignatureHelp] -> Doc ann
forall ann. SignatureHelp -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [SignatureHelp] -> Doc ann
$cprettyList :: forall ann. [SignatureHelp] -> Doc ann
pretty :: forall ann. SignatureHelp -> Doc ann
$cpretty :: forall ann. SignatureHelp -> Doc ann
Pretty via (ViaJSON SignatureHelp)

instance Aeson.ToJSON SignatureHelp where
  toJSON :: SignatureHelp -> Value
toJSON (SignatureHelp [SignatureInformation]
arg0 Maybe UInt
arg1 Maybe UInt
arg2) = [Pair] -> Value
Aeson.object forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$  [[Key
"signatures" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= [SignatureInformation]
arg0]
    ,String
"activeSignature" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe UInt
arg1
    ,String
"activeParameter" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe UInt
arg2]

instance Aeson.FromJSON SignatureHelp where
  parseJSON :: Value -> Parser SignatureHelp
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SignatureHelp" forall a b. (a -> b) -> a -> b
$ \Object
arg -> [SignatureInformation] -> Maybe UInt -> Maybe UInt -> SignatureHelp
SignatureHelp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"signatures" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"activeSignature" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"activeParameter"