{- 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.SaveOptions 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 Language.LSP.Protocol.Types.Common

{-|
Save options.
-}
data SaveOptions = SaveOptions 
  { {-|
  The client is supposed to include the content on save.
  -}
  SaveOptions -> Maybe Bool
_includeText :: (Maybe Bool)
  }
  deriving stock (Int -> SaveOptions -> ShowS
[SaveOptions] -> ShowS
SaveOptions -> String
(Int -> SaveOptions -> ShowS)
-> (SaveOptions -> String)
-> ([SaveOptions] -> ShowS)
-> Show SaveOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SaveOptions -> ShowS
showsPrec :: Int -> SaveOptions -> ShowS
$cshow :: SaveOptions -> String
show :: SaveOptions -> String
$cshowList :: [SaveOptions] -> ShowS
showList :: [SaveOptions] -> ShowS
Show, SaveOptions -> SaveOptions -> Bool
(SaveOptions -> SaveOptions -> Bool)
-> (SaveOptions -> SaveOptions -> Bool) -> Eq SaveOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SaveOptions -> SaveOptions -> Bool
== :: SaveOptions -> SaveOptions -> Bool
$c/= :: SaveOptions -> SaveOptions -> Bool
/= :: SaveOptions -> SaveOptions -> Bool
Eq, Eq SaveOptions
Eq SaveOptions =>
(SaveOptions -> SaveOptions -> Ordering)
-> (SaveOptions -> SaveOptions -> Bool)
-> (SaveOptions -> SaveOptions -> Bool)
-> (SaveOptions -> SaveOptions -> Bool)
-> (SaveOptions -> SaveOptions -> Bool)
-> (SaveOptions -> SaveOptions -> SaveOptions)
-> (SaveOptions -> SaveOptions -> SaveOptions)
-> Ord SaveOptions
SaveOptions -> SaveOptions -> Bool
SaveOptions -> SaveOptions -> Ordering
SaveOptions -> SaveOptions -> SaveOptions
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 :: SaveOptions -> SaveOptions -> Ordering
compare :: SaveOptions -> SaveOptions -> Ordering
$c< :: SaveOptions -> SaveOptions -> Bool
< :: SaveOptions -> SaveOptions -> Bool
$c<= :: SaveOptions -> SaveOptions -> Bool
<= :: SaveOptions -> SaveOptions -> Bool
$c> :: SaveOptions -> SaveOptions -> Bool
> :: SaveOptions -> SaveOptions -> Bool
$c>= :: SaveOptions -> SaveOptions -> Bool
>= :: SaveOptions -> SaveOptions -> Bool
$cmax :: SaveOptions -> SaveOptions -> SaveOptions
max :: SaveOptions -> SaveOptions -> SaveOptions
$cmin :: SaveOptions -> SaveOptions -> SaveOptions
min :: SaveOptions -> SaveOptions -> SaveOptions
Ord, (forall x. SaveOptions -> Rep SaveOptions x)
-> (forall x. Rep SaveOptions x -> SaveOptions)
-> Generic SaveOptions
forall x. Rep SaveOptions x -> SaveOptions
forall x. SaveOptions -> Rep SaveOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SaveOptions -> Rep SaveOptions x
from :: forall x. SaveOptions -> Rep SaveOptions x
$cto :: forall x. Rep SaveOptions x -> SaveOptions
to :: forall x. Rep SaveOptions x -> SaveOptions
Generic)
  deriving anyclass (SaveOptions -> ()
(SaveOptions -> ()) -> NFData SaveOptions
forall a. (a -> ()) -> NFData a
$crnf :: SaveOptions -> ()
rnf :: SaveOptions -> ()
NFData, Eq SaveOptions
Eq SaveOptions =>
(Int -> SaveOptions -> Int)
-> (SaveOptions -> Int) -> Hashable SaveOptions
Int -> SaveOptions -> Int
SaveOptions -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> SaveOptions -> Int
hashWithSalt :: Int -> SaveOptions -> Int
$chash :: SaveOptions -> Int
hash :: SaveOptions -> Int
Hashable)
  deriving (forall ann. SaveOptions -> Doc ann)
-> (forall ann. [SaveOptions] -> Doc ann) -> Pretty SaveOptions
forall ann. [SaveOptions] -> Doc ann
forall ann. SaveOptions -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
$cpretty :: forall ann. SaveOptions -> Doc ann
pretty :: forall ann. SaveOptions -> Doc ann
$cprettyList :: forall ann. [SaveOptions] -> Doc ann
prettyList :: forall ann. [SaveOptions] -> Doc ann
Pretty via (ViaJSON SaveOptions)

instance Aeson.ToJSON SaveOptions where
  toJSON :: SaveOptions -> Value
toJSON (SaveOptions Maybe Bool
arg0) = [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
"includeText" String -> Maybe Bool -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
String -> Maybe v -> [kv]
Language.LSP.Protocol.Types.Common..=? Maybe Bool
arg0]

instance Aeson.FromJSON SaveOptions where
  parseJSON :: Value -> Parser SaveOptions
parseJSON = String
-> (Object -> Parser SaveOptions) -> Value -> Parser SaveOptions
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"SaveOptions" ((Object -> Parser SaveOptions) -> Value -> Parser SaveOptions)
-> (Object -> Parser SaveOptions) -> Value -> Parser SaveOptions
forall a b. (a -> b) -> a -> b
$ \Object
arg -> Maybe Bool -> SaveOptions
SaveOptions (Maybe Bool -> SaveOptions)
-> Parser (Maybe Bool) -> Parser SaveOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
arg Object -> Key -> Parser (Maybe Bool)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
Language.LSP.Protocol.Types.Common..:!? Key
"includeText"