{- 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.NotebookDocumentFilterPattern 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.Types.Common

{-|
A notebook document filter where `pattern` is required field.

@since 3.18.0
@proposed
-}
data NotebookDocumentFilterPattern = NotebookDocumentFilterPattern 
  { {-|
  The type of the enclosing notebook.
  -}
  NotebookDocumentFilterPattern -> Maybe Text
_notebookType :: (Maybe Data.Text.Text)
  , {-|
  A Uri `Uri.scheme`, like `file` or `untitled`.
  -}
  NotebookDocumentFilterPattern -> Maybe Text
_scheme :: (Maybe Data.Text.Text)
  , {-|
  A glob pattern.
  -}
  NotebookDocumentFilterPattern -> Text
_pattern :: Data.Text.Text
  }
  deriving stock (Int -> NotebookDocumentFilterPattern -> ShowS
[NotebookDocumentFilterPattern] -> ShowS
NotebookDocumentFilterPattern -> String
(Int -> NotebookDocumentFilterPattern -> ShowS)
-> (NotebookDocumentFilterPattern -> String)
-> ([NotebookDocumentFilterPattern] -> ShowS)
-> Show NotebookDocumentFilterPattern
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotebookDocumentFilterPattern -> ShowS
showsPrec :: Int -> NotebookDocumentFilterPattern -> ShowS
$cshow :: NotebookDocumentFilterPattern -> String
show :: NotebookDocumentFilterPattern -> String
$cshowList :: [NotebookDocumentFilterPattern] -> ShowS
showList :: [NotebookDocumentFilterPattern] -> ShowS
Show, NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
(NotebookDocumentFilterPattern
 -> NotebookDocumentFilterPattern -> Bool)
-> (NotebookDocumentFilterPattern
    -> NotebookDocumentFilterPattern -> Bool)
-> Eq NotebookDocumentFilterPattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
== :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
$c/= :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
/= :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
Eq, Eq NotebookDocumentFilterPattern
Eq NotebookDocumentFilterPattern =>
(NotebookDocumentFilterPattern
 -> NotebookDocumentFilterPattern -> Ordering)
-> (NotebookDocumentFilterPattern
    -> NotebookDocumentFilterPattern -> Bool)
-> (NotebookDocumentFilterPattern
    -> NotebookDocumentFilterPattern -> Bool)
-> (NotebookDocumentFilterPattern
    -> NotebookDocumentFilterPattern -> Bool)
-> (NotebookDocumentFilterPattern
    -> NotebookDocumentFilterPattern -> Bool)
-> (NotebookDocumentFilterPattern
    -> NotebookDocumentFilterPattern -> NotebookDocumentFilterPattern)
-> (NotebookDocumentFilterPattern
    -> NotebookDocumentFilterPattern -> NotebookDocumentFilterPattern)
-> Ord NotebookDocumentFilterPattern
NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Ordering
NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> NotebookDocumentFilterPattern
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 :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Ordering
compare :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Ordering
$c< :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
< :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
$c<= :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
<= :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
$c> :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
> :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
$c>= :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
>= :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> Bool
$cmax :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> NotebookDocumentFilterPattern
max :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> NotebookDocumentFilterPattern
$cmin :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> NotebookDocumentFilterPattern
min :: NotebookDocumentFilterPattern
-> NotebookDocumentFilterPattern -> NotebookDocumentFilterPattern
Ord, (forall x.
 NotebookDocumentFilterPattern
 -> Rep NotebookDocumentFilterPattern x)
-> (forall x.
    Rep NotebookDocumentFilterPattern x
    -> NotebookDocumentFilterPattern)
-> Generic NotebookDocumentFilterPattern
forall x.
Rep NotebookDocumentFilterPattern x
-> NotebookDocumentFilterPattern
forall x.
NotebookDocumentFilterPattern
-> Rep NotebookDocumentFilterPattern x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
NotebookDocumentFilterPattern
-> Rep NotebookDocumentFilterPattern x
from :: forall x.
NotebookDocumentFilterPattern
-> Rep NotebookDocumentFilterPattern x
$cto :: forall x.
Rep NotebookDocumentFilterPattern x
-> NotebookDocumentFilterPattern
to :: forall x.
Rep NotebookDocumentFilterPattern x
-> NotebookDocumentFilterPattern
Generic)
  deriving anyclass (NotebookDocumentFilterPattern -> ()
(NotebookDocumentFilterPattern -> ())
-> NFData NotebookDocumentFilterPattern
forall a. (a -> ()) -> NFData a
$crnf :: NotebookDocumentFilterPattern -> ()
rnf :: NotebookDocumentFilterPattern -> ()
NFData, Eq NotebookDocumentFilterPattern
Eq NotebookDocumentFilterPattern =>
(Int -> NotebookDocumentFilterPattern -> Int)
-> (NotebookDocumentFilterPattern -> Int)
-> Hashable NotebookDocumentFilterPattern
Int -> NotebookDocumentFilterPattern -> Int
NotebookDocumentFilterPattern -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> NotebookDocumentFilterPattern -> Int
hashWithSalt :: Int -> NotebookDocumentFilterPattern -> Int
$chash :: NotebookDocumentFilterPattern -> Int
hash :: NotebookDocumentFilterPattern -> Int
Hashable)
  deriving (forall ann. NotebookDocumentFilterPattern -> Doc ann)
-> (forall ann. [NotebookDocumentFilterPattern] -> Doc ann)
-> Pretty NotebookDocumentFilterPattern
forall ann. [NotebookDocumentFilterPattern] -> Doc ann
forall ann. NotebookDocumentFilterPattern -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. NotebookDocumentFilterPattern -> Doc ann
pretty :: forall ann. NotebookDocumentFilterPattern -> Doc ann
$cprettyList :: forall ann. [NotebookDocumentFilterPattern] -> Doc ann
prettyList :: forall ann. [NotebookDocumentFilterPattern] -> Doc ann
Pretty via (ViaJSON NotebookDocumentFilterPattern)

instance Aeson.ToJSON NotebookDocumentFilterPattern where
  toJSON :: NotebookDocumentFilterPattern -> Value
toJSON (NotebookDocumentFilterPattern Maybe Text
arg0 Maybe Text
arg1 Text
arg2) = [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
$  [String
"notebookType" String -> Maybe Text -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Text
arg0
    ,String
"scheme" String -> Maybe Text -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Text
arg1
    ,[Key
"pattern" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
Aeson..= Text
arg2]]

instance Aeson.FromJSON NotebookDocumentFilterPattern where
  parseJSON :: Value -> Parser NotebookDocumentFilterPattern
parseJSON = String
-> (Object -> Parser NotebookDocumentFilterPattern)
-> Value
-> Parser NotebookDocumentFilterPattern
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"NotebookDocumentFilterPattern" ((Object -> Parser NotebookDocumentFilterPattern)
 -> Value -> Parser NotebookDocumentFilterPattern)
-> (Object -> Parser NotebookDocumentFilterPattern)
-> Value
-> Parser NotebookDocumentFilterPattern
forall a b. (a -> b) -> a -> b
$ \Object
arg -> Maybe Text -> Maybe Text -> Text -> NotebookDocumentFilterPattern
NotebookDocumentFilterPattern (Maybe Text -> Maybe Text -> Text -> NotebookDocumentFilterPattern)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Text -> NotebookDocumentFilterPattern)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser (Maybe Text)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"notebookType" Parser (Maybe Text -> Text -> NotebookDocumentFilterPattern)
-> Parser (Maybe Text)
-> Parser (Text -> NotebookDocumentFilterPattern)
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 Text)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"scheme" Parser (Text -> NotebookDocumentFilterPattern)
-> Parser Text -> Parser NotebookDocumentFilterPattern
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
"pattern"