module AirGQL.Types.TextNullable (
  TextNullable (..),
)
where

import Protolude (
  Eq,
  Generic,
  Show,
  Text,
  pure,
  ($),
 )

import Data.Aeson (
  FromJSON,
  ToJSON,
  Value (Null, String),
  parseJSON,
 )


data TextNullable = TextUndefined | TextNull | TextValue Text
  deriving (Int -> TextNullable -> ShowS
[TextNullable] -> ShowS
TextNullable -> String
(Int -> TextNullable -> ShowS)
-> (TextNullable -> String)
-> ([TextNullable] -> ShowS)
-> Show TextNullable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextNullable -> ShowS
showsPrec :: Int -> TextNullable -> ShowS
$cshow :: TextNullable -> String
show :: TextNullable -> String
$cshowList :: [TextNullable] -> ShowS
showList :: [TextNullable] -> ShowS
Show, TextNullable -> TextNullable -> Bool
(TextNullable -> TextNullable -> Bool)
-> (TextNullable -> TextNullable -> Bool) -> Eq TextNullable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TextNullable -> TextNullable -> Bool
== :: TextNullable -> TextNullable -> Bool
$c/= :: TextNullable -> TextNullable -> Bool
/= :: TextNullable -> TextNullable -> Bool
Eq, (forall x. TextNullable -> Rep TextNullable x)
-> (forall x. Rep TextNullable x -> TextNullable)
-> Generic TextNullable
forall x. Rep TextNullable x -> TextNullable
forall x. TextNullable -> Rep TextNullable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TextNullable -> Rep TextNullable x
from :: forall x. TextNullable -> Rep TextNullable x
$cto :: forall x. Rep TextNullable x -> TextNullable
to :: forall x. Rep TextNullable x -> TextNullable
Generic)


instance FromJSON TextNullable where
  parseJSON :: Value -> Parser TextNullable
parseJSON (String Text
str) = TextNullable -> Parser TextNullable
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TextNullable -> Parser TextNullable)
-> TextNullable -> Parser TextNullable
forall a b. (a -> b) -> a -> b
$ Text -> TextNullable
TextValue Text
str
  parseJSON Value
Null = TextNullable -> Parser TextNullable
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextNullable
TextNull
  parseJSON Value
_ = TextNullable -> Parser TextNullable
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextNullable
TextUndefined
instance ToJSON TextNullable