{- 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.CompletionContext 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.Text
import qualified Language.LSP.Protocol.Internal.Types.CompletionTriggerKind
import qualified Language.LSP.Protocol.Types.Common

{-|
Contains additional information about the context in which a completion request is triggered.
-}
data CompletionContext = CompletionContext 
  { {-|
  How the completion was triggered.
  -}
  CompletionContext -> CompletionTriggerKind
_triggerKind :: Language.LSP.Protocol.Internal.Types.CompletionTriggerKind.CompletionTriggerKind
  , {-|
  The trigger character (a single character) that has trigger code complete.
  Is undefined if `triggerKind !== CompletionTriggerKind.TriggerCharacter`
  -}
  CompletionContext -> Maybe Text
_triggerCharacter :: (Maybe Data.Text.Text)
  }
  deriving stock (Int -> CompletionContext -> ShowS
[CompletionContext] -> ShowS
CompletionContext -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionContext] -> ShowS
$cshowList :: [CompletionContext] -> ShowS
show :: CompletionContext -> String
$cshow :: CompletionContext -> String
showsPrec :: Int -> CompletionContext -> ShowS
$cshowsPrec :: Int -> CompletionContext -> ShowS
Show, CompletionContext -> CompletionContext -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionContext -> CompletionContext -> Bool
$c/= :: CompletionContext -> CompletionContext -> Bool
== :: CompletionContext -> CompletionContext -> Bool
$c== :: CompletionContext -> CompletionContext -> Bool
Eq, Eq CompletionContext
CompletionContext -> CompletionContext -> Bool
CompletionContext -> CompletionContext -> Ordering
CompletionContext -> CompletionContext -> CompletionContext
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 :: CompletionContext -> CompletionContext -> CompletionContext
$cmin :: CompletionContext -> CompletionContext -> CompletionContext
max :: CompletionContext -> CompletionContext -> CompletionContext
$cmax :: CompletionContext -> CompletionContext -> CompletionContext
>= :: CompletionContext -> CompletionContext -> Bool
$c>= :: CompletionContext -> CompletionContext -> Bool
> :: CompletionContext -> CompletionContext -> Bool
$c> :: CompletionContext -> CompletionContext -> Bool
<= :: CompletionContext -> CompletionContext -> Bool
$c<= :: CompletionContext -> CompletionContext -> Bool
< :: CompletionContext -> CompletionContext -> Bool
$c< :: CompletionContext -> CompletionContext -> Bool
compare :: CompletionContext -> CompletionContext -> Ordering
$ccompare :: CompletionContext -> CompletionContext -> Ordering
Ord, forall x. Rep CompletionContext x -> CompletionContext
forall x. CompletionContext -> Rep CompletionContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompletionContext x -> CompletionContext
$cfrom :: forall x. CompletionContext -> Rep CompletionContext x
Generic)
  deriving anyclass (CompletionContext -> ()
forall a. (a -> ()) -> NFData a
rnf :: CompletionContext -> ()
$crnf :: CompletionContext -> ()
NFData, Eq CompletionContext
Int -> CompletionContext -> Int
CompletionContext -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: CompletionContext -> Int
$chash :: CompletionContext -> Int
hashWithSalt :: Int -> CompletionContext -> Int
$chashWithSalt :: Int -> CompletionContext -> Int
Hashable)
  deriving forall ann. [CompletionContext] -> Doc ann
forall ann. CompletionContext -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [CompletionContext] -> Doc ann
$cprettyList :: forall ann. [CompletionContext] -> Doc ann
pretty :: forall ann. CompletionContext -> Doc ann
$cpretty :: forall ann. CompletionContext -> Doc ann
Pretty via (ViaJSON CompletionContext)

instance Aeson.ToJSON CompletionContext where
  toJSON :: CompletionContext -> Value
toJSON (CompletionContext CompletionTriggerKind
arg0 Maybe Text
arg1) = [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
"triggerKind" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= CompletionTriggerKind
arg0]
    ,String
"triggerCharacter" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Text
arg1]

instance Aeson.FromJSON CompletionContext where
  parseJSON :: Value -> Parser CompletionContext
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"CompletionContext" forall a b. (a -> b) -> a -> b
$ \Object
arg -> CompletionTriggerKind -> Maybe Text -> CompletionContext
CompletionContext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"triggerKind" 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
"triggerCharacter"