{- 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.NotebookDocument 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.Aeson as Aeson
import qualified Data.Row.Hashable as Hashable
import qualified Data.Text
import qualified Language.LSP.Protocol.Internal.Types.NotebookCell
import qualified Language.LSP.Protocol.Types.Common
import qualified Language.LSP.Protocol.Types.Uri

{-|
A notebook document.

@since 3.17.0
-}
data NotebookDocument = NotebookDocument 
  { {-|
  The notebook document's uri.
  -}
  NotebookDocument -> Uri
_uri :: Language.LSP.Protocol.Types.Uri.Uri
  , {-|
  The type of the notebook.
  -}
  NotebookDocument -> Text
_notebookType :: Data.Text.Text
  , {-|
  The version number of this document (it will increase after each
  change, including undo/redo).
  -}
  NotebookDocument -> Int32
_version :: Language.LSP.Protocol.Types.Common.Int32
  , {-|
  Additional metadata stored with the notebook
  document.

  Note: should always be an object literal (e.g. LSPObject)
  -}
  NotebookDocument -> Maybe Object
_metadata :: (Maybe Data.Aeson.Object)
  , {-|
  The cells of a notebook.
  -}
  NotebookDocument -> [NotebookCell]
_cells :: [Language.LSP.Protocol.Internal.Types.NotebookCell.NotebookCell]
  }
  deriving stock (Int -> NotebookDocument -> ShowS
[NotebookDocument] -> ShowS
NotebookDocument -> String
(Int -> NotebookDocument -> ShowS)
-> (NotebookDocument -> String)
-> ([NotebookDocument] -> ShowS)
-> Show NotebookDocument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotebookDocument -> ShowS
showsPrec :: Int -> NotebookDocument -> ShowS
$cshow :: NotebookDocument -> String
show :: NotebookDocument -> String
$cshowList :: [NotebookDocument] -> ShowS
showList :: [NotebookDocument] -> ShowS
Show, NotebookDocument -> NotebookDocument -> Bool
(NotebookDocument -> NotebookDocument -> Bool)
-> (NotebookDocument -> NotebookDocument -> Bool)
-> Eq NotebookDocument
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotebookDocument -> NotebookDocument -> Bool
== :: NotebookDocument -> NotebookDocument -> Bool
$c/= :: NotebookDocument -> NotebookDocument -> Bool
/= :: NotebookDocument -> NotebookDocument -> Bool
Eq, Eq NotebookDocument
Eq NotebookDocument =>
(NotebookDocument -> NotebookDocument -> Ordering)
-> (NotebookDocument -> NotebookDocument -> Bool)
-> (NotebookDocument -> NotebookDocument -> Bool)
-> (NotebookDocument -> NotebookDocument -> Bool)
-> (NotebookDocument -> NotebookDocument -> Bool)
-> (NotebookDocument -> NotebookDocument -> NotebookDocument)
-> (NotebookDocument -> NotebookDocument -> NotebookDocument)
-> Ord NotebookDocument
NotebookDocument -> NotebookDocument -> Bool
NotebookDocument -> NotebookDocument -> Ordering
NotebookDocument -> NotebookDocument -> NotebookDocument
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 :: NotebookDocument -> NotebookDocument -> Ordering
compare :: NotebookDocument -> NotebookDocument -> Ordering
$c< :: NotebookDocument -> NotebookDocument -> Bool
< :: NotebookDocument -> NotebookDocument -> Bool
$c<= :: NotebookDocument -> NotebookDocument -> Bool
<= :: NotebookDocument -> NotebookDocument -> Bool
$c> :: NotebookDocument -> NotebookDocument -> Bool
> :: NotebookDocument -> NotebookDocument -> Bool
$c>= :: NotebookDocument -> NotebookDocument -> Bool
>= :: NotebookDocument -> NotebookDocument -> Bool
$cmax :: NotebookDocument -> NotebookDocument -> NotebookDocument
max :: NotebookDocument -> NotebookDocument -> NotebookDocument
$cmin :: NotebookDocument -> NotebookDocument -> NotebookDocument
min :: NotebookDocument -> NotebookDocument -> NotebookDocument
Ord, (forall x. NotebookDocument -> Rep NotebookDocument x)
-> (forall x. Rep NotebookDocument x -> NotebookDocument)
-> Generic NotebookDocument
forall x. Rep NotebookDocument x -> NotebookDocument
forall x. NotebookDocument -> Rep NotebookDocument x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NotebookDocument -> Rep NotebookDocument x
from :: forall x. NotebookDocument -> Rep NotebookDocument x
$cto :: forall x. Rep NotebookDocument x -> NotebookDocument
to :: forall x. Rep NotebookDocument x -> NotebookDocument
Generic)
  deriving anyclass (NotebookDocument -> ()
(NotebookDocument -> ()) -> NFData NotebookDocument
forall a. (a -> ()) -> NFData a
$crnf :: NotebookDocument -> ()
rnf :: NotebookDocument -> ()
NFData, Eq NotebookDocument
Eq NotebookDocument =>
(Int -> NotebookDocument -> Int)
-> (NotebookDocument -> Int) -> Hashable NotebookDocument
Int -> NotebookDocument -> Int
NotebookDocument -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> NotebookDocument -> Int
hashWithSalt :: Int -> NotebookDocument -> Int
$chash :: NotebookDocument -> Int
hash :: NotebookDocument -> Int
Hashable)
  deriving (forall ann. NotebookDocument -> Doc ann)
-> (forall ann. [NotebookDocument] -> Doc ann)
-> Pretty NotebookDocument
forall ann. [NotebookDocument] -> Doc ann
forall ann. NotebookDocument -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. NotebookDocument -> Doc ann
pretty :: forall ann. NotebookDocument -> Doc ann
$cprettyList :: forall ann. [NotebookDocument] -> Doc ann
prettyList :: forall ann. [NotebookDocument] -> Doc ann
Pretty via (ViaJSON NotebookDocument)

instance Aeson.ToJSON NotebookDocument where
  toJSON :: NotebookDocument -> Value
toJSON (NotebookDocument Uri
arg0 Text
arg1 Int32
arg2 Maybe Object
arg3 [NotebookCell]
arg4) = [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
"uri" Key -> Uri -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Uri
arg0]
    ,[Key
"notebookType" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
arg1]
    ,[Key
"version" Key -> Int32 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Int32
arg2]
    ,String
"metadata" String -> Maybe Object -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Object
arg3
    ,[Key
"cells" Key -> [NotebookCell] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= [NotebookCell]
arg4]]

instance Aeson.FromJSON NotebookDocument where
  parseJSON :: Value -> Parser NotebookDocument
parseJSON = String
-> (Object -> Parser NotebookDocument)
-> Value
-> Parser NotebookDocument
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NotebookDocument" ((Object -> Parser NotebookDocument)
 -> Value -> Parser NotebookDocument)
-> (Object -> Parser NotebookDocument)
-> Value
-> Parser NotebookDocument
forall a b. (a -> b) -> a -> b
$ \Object
arg -> Uri
-> Text
-> Int32
-> Maybe Object
-> [NotebookCell]
-> NotebookDocument
NotebookDocument (Uri
 -> Text
 -> Int32
 -> Maybe Object
 -> [NotebookCell]
 -> NotebookDocument)
-> Parser Uri
-> Parser
     (Text
      -> Int32 -> Maybe Object -> [NotebookCell] -> NotebookDocument)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser Uri
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"uri" Parser
  (Text
   -> Int32 -> Maybe Object -> [NotebookCell] -> NotebookDocument)
-> Parser Text
-> Parser
     (Int32 -> Maybe Object -> [NotebookCell] -> NotebookDocument)
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 Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"notebookType" Parser
  (Int32 -> Maybe Object -> [NotebookCell] -> NotebookDocument)
-> Parser Int32
-> Parser (Maybe Object -> [NotebookCell] -> NotebookDocument)
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 Int32
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"version" Parser (Maybe Object -> [NotebookCell] -> NotebookDocument)
-> Parser (Maybe Object)
-> Parser ([NotebookCell] -> NotebookDocument)
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 Object)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"metadata" Parser ([NotebookCell] -> NotebookDocument)
-> Parser [NotebookCell] -> Parser NotebookDocument
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 [NotebookCell]
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"cells"