{- 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.NotebookDocumentSyncOptions 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 as Row
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.NotebookDocumentFilter
import qualified Language.LSP.Protocol.Types.Common

{-|
Options specific to a notebook plus its cells
to be synced to the server.

If a selector provides a notebook document
filter but no cell selector all cells of a
matching notebook document will be synced.

If a selector provides no notebook document
filter but only a cell selector all notebook
document that contain at least one matching
cell will be synced.

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

instance Aeson.ToJSON NotebookDocumentSyncOptions where
  toJSON :: NotebookDocumentSyncOptions -> Value
toJSON (NotebookDocumentSyncOptions [Rec
   (("notebook" .== (Text |? NotebookDocumentFilter))
    .+ (("cells" .== Maybe [Rec (("language" .== Text) .+ Empty)])
        .+ Empty))
 |? Rec
      (("notebook" .== Maybe (Text |? NotebookDocumentFilter))
       .+ (("cells" .== [Rec (("language" .== Text) .+ Empty)])
           .+ Empty))]
arg0 Maybe Bool
arg1) = [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
-> [Rec
      ('R
         '["cells" ':-> Maybe [Rec ('R '["language" ':-> Text])],
           "notebook" ':-> (Text |? NotebookDocumentFilter)])
    |? Rec
         ('R
            '["cells" ':-> [Rec ('R '["language" ':-> Text])],
              "notebook" ':-> Maybe (Text |? NotebookDocumentFilter)])]
-> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= [Rec
   (("notebook" .== (Text |? NotebookDocumentFilter))
    .+ (("cells" .== Maybe [Rec (("language" .== Text) .+ Empty)])
        .+ Empty))
 |? Rec
      (("notebook" .== Maybe (Text |? NotebookDocumentFilter))
       .+ (("cells" .== [Rec (("language" .== Text) .+ Empty)])
           .+ Empty))]
[Rec
   ('R
      '["cells" ':-> Maybe [Rec ('R '["language" ':-> Text])],
        "notebook" ':-> (Text |? NotebookDocumentFilter)])
 |? Rec
      ('R
         '["cells" ':-> [Rec ('R '["language" ':-> Text])],
           "notebook" ':-> Maybe (Text |? NotebookDocumentFilter)])]
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]

instance Aeson.FromJSON NotebookDocumentSyncOptions where
  parseJSON :: Value -> Parser NotebookDocumentSyncOptions
parseJSON = String
-> (Object -> Parser NotebookDocumentSyncOptions)
-> Value
-> Parser NotebookDocumentSyncOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NotebookDocumentSyncOptions" ((Object -> Parser NotebookDocumentSyncOptions)
 -> Value -> Parser NotebookDocumentSyncOptions)
-> (Object -> Parser NotebookDocumentSyncOptions)
-> Value
-> Parser NotebookDocumentSyncOptions
forall a b. (a -> b) -> a -> b
$ \Object
arg -> [Rec
   (("notebook" .== (Text |? NotebookDocumentFilter))
    .+ (("cells" .== Maybe [Rec (("language" .== Text) .+ Empty)])
        .+ Empty))
 |? Rec
      (("notebook" .== Maybe (Text |? NotebookDocumentFilter))
       .+ (("cells" .== [Rec (("language" .== Text) .+ Empty)])
           .+ Empty))]
-> Maybe Bool -> NotebookDocumentSyncOptions
[Rec
   ('R
      '["cells" ':-> Maybe [Rec ('R '["language" ':-> Text])],
        "notebook" ':-> (Text |? NotebookDocumentFilter)])
 |? Rec
      ('R
         '["cells" ':-> [Rec ('R '["language" ':-> Text])],
           "notebook" ':-> Maybe (Text |? NotebookDocumentFilter)])]
-> Maybe Bool -> NotebookDocumentSyncOptions
NotebookDocumentSyncOptions ([Rec
    ('R
       '["cells" ':-> Maybe [Rec ('R '["language" ':-> Text])],
         "notebook" ':-> (Text |? NotebookDocumentFilter)])
  |? Rec
       ('R
          '["cells" ':-> [Rec ('R '["language" ':-> Text])],
            "notebook" ':-> Maybe (Text |? NotebookDocumentFilter)])]
 -> Maybe Bool -> NotebookDocumentSyncOptions)
-> Parser
     [Rec
        ('R
           '["cells" ':-> Maybe [Rec ('R '["language" ':-> Text])],
             "notebook" ':-> (Text |? NotebookDocumentFilter)])
      |? Rec
           ('R
              '["cells" ':-> [Rec ('R '["language" ':-> Text])],
                "notebook" ':-> Maybe (Text |? NotebookDocumentFilter)])]
-> Parser (Maybe Bool -> NotebookDocumentSyncOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object
-> Key
-> Parser
     [Rec
        ('R
           '["cells" ':-> Maybe [Rec ('R '["language" ':-> Text])],
             "notebook" ':-> (Text |? NotebookDocumentFilter)])
      |? Rec
           ('R
              '["cells" ':-> [Rec ('R '["language" ':-> Text])],
                "notebook" ':-> Maybe (Text |? NotebookDocumentFilter)])]
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"notebookSelector" Parser (Maybe Bool -> NotebookDocumentSyncOptions)
-> Parser (Maybe Bool) -> Parser NotebookDocumentSyncOptions
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"