{- 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.NotebookDocumentChangeEvent where

import Control.DeepSeq
import Data.Hashable
import GHC.Generics
import Language.LSP.Protocol.Utils.Misc
import Prettyprinter
import qualified Data.Aeson
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 Language.LSP.Protocol.Internal.Types.NotebookCell
import qualified Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange
import qualified Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent
import qualified Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier
import qualified Language.LSP.Protocol.Internal.Types.TextDocumentItem
import qualified Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier
import qualified Language.LSP.Protocol.Types.Common

{-|
A change event for a notebook document.

@since 3.17.0
-}
data NotebookDocumentChangeEvent = NotebookDocumentChangeEvent 
  { {-|
  The changed meta data if any.

  Note: should always be an object literal (e.g. LSPObject)
  -}
  NotebookDocumentChangeEvent -> Maybe Object
_metadata :: (Maybe Data.Aeson.Object)
  , {-|
  Changes to cells
  -}
  NotebookDocumentChangeEvent
-> Maybe
     (Rec
        (("structure"
          .== Maybe
                (Rec
                   (("array" .== NotebookCellArrayChange)
                    .+ (Extend "didOpen" (Maybe [TextDocumentItem]) ('R '[])
                        .+ (("didClose" .== Maybe [TextDocumentIdentifier]) .+ 'R '[])))))
         .+ (("data" .== Maybe [NotebookCell])
             .+ (("textContent"
                  .== Maybe
                        [Rec
                           (Extend "document" VersionedTextDocumentIdentifier ('R '[])
                            .+ (("changes" .== [TextDocumentContentChangeEvent]) .+ 'R '[]))])
                 .+ 'R '[]))))
_cells :: (Maybe (Row.Rec ("structure" Row..== (Maybe (Row.Rec ("array" Row..== Language.LSP.Protocol.Internal.Types.NotebookCellArrayChange.NotebookCellArrayChange Row..+ ("didOpen" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentItem.TextDocumentItem]) Row..+ ("didClose" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.TextDocumentIdentifier.TextDocumentIdentifier]) Row..+ Row.Empty))))) Row..+ ("data" Row..== (Maybe [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]) Row..+ ("textContent" Row..== (Maybe [(Row.Rec ("document" Row..== Language.LSP.Protocol.Internal.Types.VersionedTextDocumentIdentifier.VersionedTextDocumentIdentifier Row..+ ("changes" Row..== [Language.LSP.Protocol.Internal.Types.TextDocumentContentChangeEvent.TextDocumentContentChangeEvent] Row..+ Row.Empty)))]) Row..+ Row.Empty)))))
  }
  deriving stock (Int -> NotebookDocumentChangeEvent -> ShowS
[NotebookDocumentChangeEvent] -> ShowS
NotebookDocumentChangeEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotebookDocumentChangeEvent] -> ShowS
$cshowList :: [NotebookDocumentChangeEvent] -> ShowS
show :: NotebookDocumentChangeEvent -> String
$cshow :: NotebookDocumentChangeEvent -> String
showsPrec :: Int -> NotebookDocumentChangeEvent -> ShowS
$cshowsPrec :: Int -> NotebookDocumentChangeEvent -> ShowS
Show, NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
$c/= :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
== :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
$c== :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
Eq, Eq NotebookDocumentChangeEvent
NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> Ordering
NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent
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 :: NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent
$cmin :: NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent
max :: NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent
$cmax :: NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent
>= :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
$c>= :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
> :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
$c> :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
<= :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
$c<= :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
< :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
$c< :: NotebookDocumentChangeEvent -> NotebookDocumentChangeEvent -> Bool
compare :: NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> Ordering
$ccompare :: NotebookDocumentChangeEvent
-> NotebookDocumentChangeEvent -> Ordering
Ord, forall x.
Rep NotebookDocumentChangeEvent x -> NotebookDocumentChangeEvent
forall x.
NotebookDocumentChangeEvent -> Rep NotebookDocumentChangeEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep NotebookDocumentChangeEvent x -> NotebookDocumentChangeEvent
$cfrom :: forall x.
NotebookDocumentChangeEvent -> Rep NotebookDocumentChangeEvent x
Generic)
  deriving anyclass (NotebookDocumentChangeEvent -> ()
forall a. (a -> ()) -> NFData a
rnf :: NotebookDocumentChangeEvent -> ()
$crnf :: NotebookDocumentChangeEvent -> ()
NFData, Eq NotebookDocumentChangeEvent
Int -> NotebookDocumentChangeEvent -> Int
NotebookDocumentChangeEvent -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: NotebookDocumentChangeEvent -> Int
$chash :: NotebookDocumentChangeEvent -> Int
hashWithSalt :: Int -> NotebookDocumentChangeEvent -> Int
$chashWithSalt :: Int -> NotebookDocumentChangeEvent -> Int
Hashable)
  deriving forall ann. [NotebookDocumentChangeEvent] -> Doc ann
forall ann. NotebookDocumentChangeEvent -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [NotebookDocumentChangeEvent] -> Doc ann
$cprettyList :: forall ann. [NotebookDocumentChangeEvent] -> Doc ann
pretty :: forall ann. NotebookDocumentChangeEvent -> Doc ann
$cpretty :: forall ann. NotebookDocumentChangeEvent -> Doc ann
Pretty via (ViaJSON NotebookDocumentChangeEvent)

instance Aeson.ToJSON NotebookDocumentChangeEvent where
  toJSON :: NotebookDocumentChangeEvent -> Value
toJSON (NotebookDocumentChangeEvent Maybe Object
arg0 Maybe
  (Rec
     (("structure"
       .== Maybe
             (Rec
                (("array" .== NotebookCellArrayChange)
                 .+ (Extend "didOpen" (Maybe [TextDocumentItem]) ('R '[])
                     .+ (("didClose" .== Maybe [TextDocumentIdentifier]) .+ 'R '[])))))
      .+ (("data" .== Maybe [NotebookCell])
          .+ (("textContent"
               .== Maybe
                     [Rec
                        (Extend "document" VersionedTextDocumentIdentifier ('R '[])
                         .+ (("changes" .== [TextDocumentContentChangeEvent]) .+ 'R '[]))])
              .+ 'R '[]))))
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
$  [String
"metadata" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Object
arg0
    ,String
"cells" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe
  (Rec
     (("structure"
       .== Maybe
             (Rec
                (("array" .== NotebookCellArrayChange)
                 .+ (Extend "didOpen" (Maybe [TextDocumentItem]) ('R '[])
                     .+ (("didClose" .== Maybe [TextDocumentIdentifier]) .+ 'R '[])))))
      .+ (("data" .== Maybe [NotebookCell])
          .+ (("textContent"
               .== Maybe
                     [Rec
                        (Extend "document" VersionedTextDocumentIdentifier ('R '[])
                         .+ (("changes" .== [TextDocumentContentChangeEvent]) .+ 'R '[]))])
              .+ 'R '[]))))
arg1]

instance Aeson.FromJSON NotebookDocumentChangeEvent where
  parseJSON :: Value -> Parser NotebookDocumentChangeEvent
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NotebookDocumentChangeEvent" forall a b. (a -> b) -> a -> b
$ \Object
arg -> Maybe Object
-> Maybe
     (Rec
        (("structure"
          .== Maybe
                (Rec
                   (("array" .== NotebookCellArrayChange)
                    .+ (Extend "didOpen" (Maybe [TextDocumentItem]) ('R '[])
                        .+ (("didClose" .== Maybe [TextDocumentIdentifier]) .+ 'R '[])))))
         .+ (("data" .== Maybe [NotebookCell])
             .+ (("textContent"
                  .== Maybe
                        [Rec
                           (Extend "document" VersionedTextDocumentIdentifier ('R '[])
                            .+ (("changes" .== [TextDocumentContentChangeEvent]) .+ 'R '[]))])
                 .+ 'R '[]))))
-> NotebookDocumentChangeEvent
NotebookDocumentChangeEvent forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:! Key
"metadata" 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
"cells"