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

{-|
A notebook cell text document filter denotes a cell text
document by different properties.

@since 3.17.0
-}
data NotebookCellTextDocumentFilter = NotebookCellTextDocumentFilter 
  { {-|
  A filter that matches against the notebook
  containing the notebook cell. If a string
  value is provided it matches against the
  notebook type. '*' matches every notebook.
  -}
  NotebookCellTextDocumentFilter -> Text |? NotebookDocumentFilter
_notebook :: (Data.Text.Text Language.LSP.Protocol.Types.Common.|? Language.LSP.Protocol.Internal.Types.NotebookDocumentFilter.NotebookDocumentFilter)
  , {-|
  A language id like `python`.

  Will be matched against the language id of the
  notebook cell document. '*' matches every language.
  -}
  NotebookCellTextDocumentFilter -> Maybe Text
_language :: (Maybe Data.Text.Text)
  }
  deriving stock (Int -> NotebookCellTextDocumentFilter -> ShowS
[NotebookCellTextDocumentFilter] -> ShowS
NotebookCellTextDocumentFilter -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotebookCellTextDocumentFilter] -> ShowS
$cshowList :: [NotebookCellTextDocumentFilter] -> ShowS
show :: NotebookCellTextDocumentFilter -> String
$cshow :: NotebookCellTextDocumentFilter -> String
showsPrec :: Int -> NotebookCellTextDocumentFilter -> ShowS
$cshowsPrec :: Int -> NotebookCellTextDocumentFilter -> ShowS
Show, NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
$c/= :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
== :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
$c== :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
Eq, Eq NotebookCellTextDocumentFilter
NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Ordering
NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> NotebookCellTextDocumentFilter
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 :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> NotebookCellTextDocumentFilter
$cmin :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> NotebookCellTextDocumentFilter
max :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> NotebookCellTextDocumentFilter
$cmax :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> NotebookCellTextDocumentFilter
>= :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
$c>= :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
> :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
$c> :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
<= :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
$c<= :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
< :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
$c< :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Bool
compare :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Ordering
$ccompare :: NotebookCellTextDocumentFilter
-> NotebookCellTextDocumentFilter -> Ordering
Ord, forall x.
Rep NotebookCellTextDocumentFilter x
-> NotebookCellTextDocumentFilter
forall x.
NotebookCellTextDocumentFilter
-> Rep NotebookCellTextDocumentFilter x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep NotebookCellTextDocumentFilter x
-> NotebookCellTextDocumentFilter
$cfrom :: forall x.
NotebookCellTextDocumentFilter
-> Rep NotebookCellTextDocumentFilter x
Generic)
  deriving anyclass (NotebookCellTextDocumentFilter -> ()
forall a. (a -> ()) -> NFData a
rnf :: NotebookCellTextDocumentFilter -> ()
$crnf :: NotebookCellTextDocumentFilter -> ()
NFData, Eq NotebookCellTextDocumentFilter
Int -> NotebookCellTextDocumentFilter -> Int
NotebookCellTextDocumentFilter -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: NotebookCellTextDocumentFilter -> Int
$chash :: NotebookCellTextDocumentFilter -> Int
hashWithSalt :: Int -> NotebookCellTextDocumentFilter -> Int
$chashWithSalt :: Int -> NotebookCellTextDocumentFilter -> Int
Hashable)
  deriving forall ann. [NotebookCellTextDocumentFilter] -> Doc ann
forall ann. NotebookCellTextDocumentFilter -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: forall ann. [NotebookCellTextDocumentFilter] -> Doc ann
$cprettyList :: forall ann. [NotebookCellTextDocumentFilter] -> Doc ann
pretty :: forall ann. NotebookCellTextDocumentFilter -> Doc ann
$cpretty :: forall ann. NotebookCellTextDocumentFilter -> Doc ann
Pretty via (ViaJSON NotebookCellTextDocumentFilter)

instance Aeson.ToJSON NotebookCellTextDocumentFilter where
  toJSON :: NotebookCellTextDocumentFilter -> Value
toJSON (NotebookCellTextDocumentFilter Text |? NotebookDocumentFilter
arg0 Maybe Text
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
$  [[Key
"notebook" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Aeson..= Text |? NotebookDocumentFilter
arg0]
    ,String
"language" forall kv v. (KeyValue kv, ToJSON v) => String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Text
arg1]

instance Aeson.FromJSON NotebookCellTextDocumentFilter where
  parseJSON :: Value -> Parser NotebookCellTextDocumentFilter
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NotebookCellTextDocumentFilter" forall a b. (a -> b) -> a -> b
$ \Object
arg -> (Text |? NotebookDocumentFilter)
-> Maybe Text -> NotebookCellTextDocumentFilter
NotebookCellTextDocumentFilter forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"notebook" 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
"language"