{- 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.NotebookCell 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 Language.LSP.Protocol.Internal.Types.ExecutionSummary
import qualified Language.LSP.Protocol.Internal.Types.NotebookCellKind
import qualified Language.LSP.Protocol.Types.Common
import qualified Language.LSP.Protocol.Types.Uri

{-|
A notebook cell.

A cell's document URI must be unique across ALL notebook
cells and can therefore be used to uniquely identify a
notebook cell or the cell's text document.

@since 3.17.0
-}
data NotebookCell = NotebookCell 
  { {-|
  The cell's kind
  -}
  NotebookCell -> NotebookCellKind
_kind :: Language.LSP.Protocol.Internal.Types.NotebookCellKind.NotebookCellKind
  , {-|
  The URI of the cell's text document
  content.
  -}
  NotebookCell -> Uri
_document :: Language.LSP.Protocol.Types.Uri.Uri
  , {-|
  Additional metadata stored with the cell.

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

instance Aeson.ToJSON NotebookCell where
  toJSON :: NotebookCell -> Value
toJSON (NotebookCell NotebookCellKind
arg0 Uri
arg1 Maybe Object
arg2 Maybe ExecutionSummary
arg3) = [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
"kind" Key -> NotebookCellKind -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= NotebookCellKind
arg0]
    ,[Key
"document" Key -> Uri -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Uri
arg1]
    ,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
arg2
    ,String
"executionSummary" String -> Maybe ExecutionSummary -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe ExecutionSummary
arg3]

instance Aeson.FromJSON NotebookCell where
  parseJSON :: Value -> Parser NotebookCell
parseJSON = String
-> (Object -> Parser NotebookCell) -> Value -> Parser NotebookCell
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NotebookCell" ((Object -> Parser NotebookCell) -> Value -> Parser NotebookCell)
-> (Object -> Parser NotebookCell) -> Value -> Parser NotebookCell
forall a b. (a -> b) -> a -> b
$ \Object
arg -> NotebookCellKind
-> Uri -> Maybe Object -> Maybe ExecutionSummary -> NotebookCell
NotebookCell (NotebookCellKind
 -> Uri -> Maybe Object -> Maybe ExecutionSummary -> NotebookCell)
-> Parser NotebookCellKind
-> Parser
     (Uri -> Maybe Object -> Maybe ExecutionSummary -> NotebookCell)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser NotebookCellKind
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"kind" Parser
  (Uri -> Maybe Object -> Maybe ExecutionSummary -> NotebookCell)
-> Parser Uri
-> Parser (Maybe Object -> Maybe ExecutionSummary -> NotebookCell)
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 Uri
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"document" Parser (Maybe Object -> Maybe ExecutionSummary -> NotebookCell)
-> Parser (Maybe Object)
-> Parser (Maybe ExecutionSummary -> NotebookCell)
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 (Maybe ExecutionSummary -> NotebookCell)
-> Parser (Maybe ExecutionSummary) -> Parser NotebookCell
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 ExecutionSummary)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"executionSummary"