{- 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.NotebookDocumentSyncRegistrationOptions 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.NotebookDocumentFilterWithCells
import qualified Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithNotebook
import qualified Language.LSP.Protocol.Types.Common

{-|
Registration options specific to a notebook.

@since 3.17.0
-}
data NotebookDocumentSyncRegistrationOptions = NotebookDocumentSyncRegistrationOptions 
  { {-|
  The notebooks to be synced
  -}
  NotebookDocumentSyncRegistrationOptions
-> [NotebookDocumentFilterWithNotebook
    |? NotebookDocumentFilterWithCells]
_notebookSelector :: [(Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithNotebook.NotebookDocumentFilterWithNotebook Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilterWithCells.NotebookDocumentFilterWithCells)]
  , {-|
  Whether save notification should be forwarded to
  the server. Will only be honored if mode === `notebook`.
  -}
  NotebookDocumentSyncRegistrationOptions -> Maybe Bool
_save :: (Maybe Bool)
  , {-|
  The id used to register the request. The id can be used to deregister
  the request again. See also Registration#id.
  -}
  NotebookDocumentSyncRegistrationOptions -> Maybe Text
_id :: (Maybe Data.Text.Text)
  }
  deriving stock (Int -> NotebookDocumentSyncRegistrationOptions -> ShowS
[NotebookDocumentSyncRegistrationOptions] -> ShowS
NotebookDocumentSyncRegistrationOptions -> String
(Int -> NotebookDocumentSyncRegistrationOptions -> ShowS)
-> (NotebookDocumentSyncRegistrationOptions -> String)
-> ([NotebookDocumentSyncRegistrationOptions] -> ShowS)
-> Show NotebookDocumentSyncRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotebookDocumentSyncRegistrationOptions -> ShowS
showsPrec :: Int -> NotebookDocumentSyncRegistrationOptions -> ShowS
$cshow :: NotebookDocumentSyncRegistrationOptions -> String
show :: NotebookDocumentSyncRegistrationOptions -> String
$cshowList :: [NotebookDocumentSyncRegistrationOptions] -> ShowS
showList :: [NotebookDocumentSyncRegistrationOptions] -> ShowS
Show, NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
(NotebookDocumentSyncRegistrationOptions
 -> NotebookDocumentSyncRegistrationOptions -> Bool)
-> (NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions -> Bool)
-> Eq NotebookDocumentSyncRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
== :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
$c/= :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
/= :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
Eq, Eq NotebookDocumentSyncRegistrationOptions
Eq NotebookDocumentSyncRegistrationOptions =>
(NotebookDocumentSyncRegistrationOptions
 -> NotebookDocumentSyncRegistrationOptions -> Ordering)
-> (NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions -> Bool)
-> (NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions -> Bool)
-> (NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions -> Bool)
-> (NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions -> Bool)
-> (NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions)
-> (NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions
    -> NotebookDocumentSyncRegistrationOptions)
-> Ord NotebookDocumentSyncRegistrationOptions
NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Ordering
NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
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
$ccompare :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Ordering
compare :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Ordering
$c< :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
< :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
$c<= :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
<= :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
$c> :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
> :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
$c>= :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
>= :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions -> Bool
$cmax :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
max :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
$cmin :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
min :: NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
-> NotebookDocumentSyncRegistrationOptions
Ord, (forall x.
 NotebookDocumentSyncRegistrationOptions
 -> Rep NotebookDocumentSyncRegistrationOptions x)
-> (forall x.
    Rep NotebookDocumentSyncRegistrationOptions x
    -> NotebookDocumentSyncRegistrationOptions)
-> Generic NotebookDocumentSyncRegistrationOptions
forall x.
Rep NotebookDocumentSyncRegistrationOptions x
-> NotebookDocumentSyncRegistrationOptions
forall x.
NotebookDocumentSyncRegistrationOptions
-> Rep NotebookDocumentSyncRegistrationOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
NotebookDocumentSyncRegistrationOptions
-> Rep NotebookDocumentSyncRegistrationOptions x
from :: forall x.
NotebookDocumentSyncRegistrationOptions
-> Rep NotebookDocumentSyncRegistrationOptions x
$cto :: forall x.
Rep NotebookDocumentSyncRegistrationOptions x
-> NotebookDocumentSyncRegistrationOptions
to :: forall x.
Rep NotebookDocumentSyncRegistrationOptions x
-> NotebookDocumentSyncRegistrationOptions
Generic)
  deriving anyclass (NotebookDocumentSyncRegistrationOptions -> ()
(NotebookDocumentSyncRegistrationOptions -> ())
-> NFData NotebookDocumentSyncRegistrationOptions
forall a. (a -> ()) -> NFData a
$crnf :: NotebookDocumentSyncRegistrationOptions -> ()
rnf :: NotebookDocumentSyncRegistrationOptions -> ()
NFData, Eq NotebookDocumentSyncRegistrationOptions
Eq NotebookDocumentSyncRegistrationOptions =>
(Int -> NotebookDocumentSyncRegistrationOptions -> Int)
-> (NotebookDocumentSyncRegistrationOptions -> Int)
-> Hashable NotebookDocumentSyncRegistrationOptions
Int -> NotebookDocumentSyncRegistrationOptions -> Int
NotebookDocumentSyncRegistrationOptions -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> NotebookDocumentSyncRegistrationOptions -> Int
hashWithSalt :: Int -> NotebookDocumentSyncRegistrationOptions -> Int
$chash :: NotebookDocumentSyncRegistrationOptions -> Int
hash :: NotebookDocumentSyncRegistrationOptions -> Int
Hashable)
  deriving (forall ann. NotebookDocumentSyncRegistrationOptions -> Doc ann)
-> (forall ann.
    [NotebookDocumentSyncRegistrationOptions] -> Doc ann)
-> Pretty NotebookDocumentSyncRegistrationOptions
forall ann. [NotebookDocumentSyncRegistrationOptions] -> Doc ann
forall ann. NotebookDocumentSyncRegistrationOptions -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. NotebookDocumentSyncRegistrationOptions -> Doc ann
pretty :: forall ann. NotebookDocumentSyncRegistrationOptions -> Doc ann
$cprettyList :: forall ann. [NotebookDocumentSyncRegistrationOptions] -> Doc ann
prettyList :: forall ann. [NotebookDocumentSyncRegistrationOptions] -> Doc ann
Pretty via (ViaJSON NotebookDocumentSyncRegistrationOptions)

instance Aeson.ToJSON NotebookDocumentSyncRegistrationOptions where
  toJSON :: NotebookDocumentSyncRegistrationOptions -> Value
toJSON (NotebookDocumentSyncRegistrationOptions [NotebookDocumentFilterWithNotebook
 |? NotebookDocumentFilterWithCells]
arg0 Maybe Bool
arg1 Maybe Text
arg2) = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ [[Pair]] -> [Pair]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pair]] -> [Pair]) -> [[Pair]] -> [Pair]
forall a b. (a -> b) -> a -> b
$  [[Key
"notebookSelector" Key
-> [NotebookDocumentFilterWithNotebook
    |? NotebookDocumentFilterWithCells]
-> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= [NotebookDocumentFilterWithNotebook
 |? NotebookDocumentFilterWithCells]
arg0]
    ,String
"save" String -> Maybe Bool -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg1
    ,String
"id" String -> Maybe Text -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Text
arg2]

instance Aeson.FromJSON NotebookDocumentSyncRegistrationOptions where
  parseJSON :: Value -> Parser NotebookDocumentSyncRegistrationOptions
parseJSON = String
-> (Object -> Parser NotebookDocumentSyncRegistrationOptions)
-> Value
-> Parser NotebookDocumentSyncRegistrationOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NotebookDocumentSyncRegistrationOptions" ((Object -> Parser NotebookDocumentSyncRegistrationOptions)
 -> Value -> Parser NotebookDocumentSyncRegistrationOptions)
-> (Object -> Parser NotebookDocumentSyncRegistrationOptions)
-> Value
-> Parser NotebookDocumentSyncRegistrationOptions
forall a b. (a -> b) -> a -> b
$ \Object
arg -> [NotebookDocumentFilterWithNotebook
 |? NotebookDocumentFilterWithCells]
-> Maybe Bool
-> Maybe Text
-> NotebookDocumentSyncRegistrationOptions
NotebookDocumentSyncRegistrationOptions ([NotebookDocumentFilterWithNotebook
  |? NotebookDocumentFilterWithCells]
 -> Maybe Bool
 -> Maybe Text
 -> NotebookDocumentSyncRegistrationOptions)
-> Parser
     [NotebookDocumentFilterWithNotebook
      |? NotebookDocumentFilterWithCells]
-> Parser
     (Maybe Bool
      -> Maybe Text -> NotebookDocumentSyncRegistrationOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object
-> Key
-> Parser
     [NotebookDocumentFilterWithNotebook
      |? NotebookDocumentFilterWithCells]
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"notebookSelector" Parser
  (Maybe Bool
   -> Maybe Text -> NotebookDocumentSyncRegistrationOptions)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> NotebookDocumentSyncRegistrationOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg Object -> Key -> Parser (Maybe Bool)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"save" Parser (Maybe Text -> NotebookDocumentSyncRegistrationOptions)
-> Parser (Maybe Text)
-> Parser NotebookDocumentSyncRegistrationOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
arg Object -> Key -> Parser (Maybe Text)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"id"