{-# LANGUAGE OverloadedStrings #-}
module Language.GraphQL.Type.Definition
( Arguments(..)
, Directive(..)
, EnumType(..)
, EnumValue(..)
, ScalarType(..)
, Subs
, Value(..)
, boolean
, float
, id
, int
, selection
, string
) where
import Data.Int (Int32)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Language.GraphQL.AST (Name)
import Prelude hiding (id)
data Value
= Int Int32
| Float Double
| String Text
| Boolean Bool
| Null
| Enum Name
| List [Value]
| Object (HashMap Name Value)
deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show)
instance IsString Value where
fromString :: String -> Value
fromString = Text -> Value
String (Text -> Value) -> (String -> Text) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
type Subs = HashMap Name Value
newtype Arguments = Arguments (HashMap Name Value)
deriving (Arguments -> Arguments -> Bool
(Arguments -> Arguments -> Bool)
-> (Arguments -> Arguments -> Bool) -> Eq Arguments
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Arguments -> Arguments -> Bool
$c/= :: Arguments -> Arguments -> Bool
== :: Arguments -> Arguments -> Bool
$c== :: Arguments -> Arguments -> Bool
Eq, Int -> Arguments -> ShowS
[Arguments] -> ShowS
Arguments -> String
(Int -> Arguments -> ShowS)
-> (Arguments -> String)
-> ([Arguments] -> ShowS)
-> Show Arguments
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arguments] -> ShowS
$cshowList :: [Arguments] -> ShowS
show :: Arguments -> String
$cshow :: Arguments -> String
showsPrec :: Int -> Arguments -> ShowS
$cshowsPrec :: Int -> Arguments -> ShowS
Show)
instance Semigroup Arguments where
(Arguments HashMap Text Value
x) <> :: Arguments -> Arguments -> Arguments
<> (Arguments HashMap Text Value
y) = HashMap Text Value -> Arguments
Arguments (HashMap Text Value -> Arguments)
-> HashMap Text Value -> Arguments
forall a b. (a -> b) -> a -> b
$ HashMap Text Value
x HashMap Text Value -> HashMap Text Value -> HashMap Text Value
forall a. Semigroup a => a -> a -> a
<> HashMap Text Value
y
instance Monoid Arguments where
mempty :: Arguments
mempty = HashMap Text Value -> Arguments
Arguments HashMap Text Value
forall a. Monoid a => a
mempty
data ScalarType = ScalarType Name (Maybe Text)
instance Eq ScalarType where
(ScalarType Text
this Maybe Text
_) == :: ScalarType -> ScalarType -> Bool
== (ScalarType Text
that Maybe Text
_) = Text
this Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
that
instance Show ScalarType where
show :: ScalarType -> String
show (ScalarType Text
typeName Maybe Text
_) = Text -> String
Text.unpack Text
typeName
data EnumType = EnumType Name (Maybe Text) (HashMap Name EnumValue)
instance Eq EnumType where
(EnumType Text
this Maybe Text
_ HashMap Text EnumValue
_) == :: EnumType -> EnumType -> Bool
== (EnumType Text
that Maybe Text
_ HashMap Text EnumValue
_) = Text
this Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
that
instance Show EnumType where
show :: EnumType -> String
show (EnumType Text
typeName Maybe Text
_ HashMap Text EnumValue
_) = Text -> String
Text.unpack Text
typeName
newtype EnumValue = EnumValue (Maybe Text)
string :: ScalarType
string :: ScalarType
string = Text -> Maybe Text -> ScalarType
ScalarType Text
"String" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
Text
"The `String` scalar type represents textual data, represented as \
\UTF-8 character sequences. The String type is most often used by \
\GraphQL to represent free-form human-readable text."
boolean :: ScalarType
boolean :: ScalarType
boolean = Text -> Maybe Text -> ScalarType
ScalarType Text
"Boolean" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description = Text
"The `Boolean` scalar type represents `true` or `false`."
int :: ScalarType
int :: ScalarType
int = Text -> Maybe Text -> ScalarType
ScalarType Text
"Int" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
Text
"The `Int` scalar type represents non-fractional signed whole numeric \
\values. Int can represent values between -(2^31) and 2^31 - 1."
float :: ScalarType
float :: ScalarType
float = Text -> Maybe Text -> ScalarType
ScalarType Text
"Float" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
Text
"The `Float` scalar type represents signed double-precision fractional \
\values as specified by \
\[IEEE 754](https://en.wikipedia.org/wiki/IEEE_floating_point)."
id :: ScalarType
id :: ScalarType
id = Text -> Maybe Text -> ScalarType
ScalarType Text
"ID" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
Text
"The `ID` scalar type represents a unique identifier, often used to \
\refetch an object or as key for a cache. The ID type appears in a \
\JSON response as a String; however, it is not intended to be \
\human-readable. When expected as an input type, any string (such as \
\`\"4\"`) or integer (such as `4`) input value will be accepted as an ID."
data Directive = Directive Name Arguments
deriving (Directive -> Directive -> Bool
(Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool) -> Eq Directive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c== :: Directive -> Directive -> Bool
Eq, Int -> Directive -> ShowS
[Directive] -> ShowS
Directive -> String
(Int -> Directive -> ShowS)
-> (Directive -> String)
-> ([Directive] -> ShowS)
-> Show Directive
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Directive] -> ShowS
$cshowList :: [Directive] -> ShowS
show :: Directive -> String
$cshow :: Directive -> String
showsPrec :: Int -> Directive -> ShowS
$cshowsPrec :: Int -> Directive -> ShowS
Show)
data Status
= Skip
| Include Directive
| Continue Directive
selection :: [Directive] -> Maybe [Directive]
selection :: [Directive] -> Maybe [Directive]
selection = (Directive -> Maybe [Directive] -> Maybe [Directive])
-> Maybe [Directive] -> [Directive] -> Maybe [Directive]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Directive -> Maybe [Directive] -> Maybe [Directive]
go ([Directive] -> Maybe [Directive]
forall a. a -> Maybe a
Just [])
where
go :: Directive -> Maybe [Directive] -> Maybe [Directive]
go Directive
directive' Maybe [Directive]
directives' =
case (Status -> Status
skip (Status -> Status) -> (Status -> Status) -> Status -> Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Status -> Status
include) (Directive -> Status
Continue Directive
directive') of
(Include Directive
_) -> Maybe [Directive]
directives'
Status
Skip -> Maybe [Directive]
forall a. Maybe a
Nothing
(Continue Directive
x) -> (Directive
x Directive -> [Directive] -> [Directive]
forall a. a -> [a] -> [a]
:) ([Directive] -> [Directive])
-> Maybe [Directive] -> Maybe [Directive]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Directive]
directives'
handle :: (Directive -> Status) -> Status -> Status
handle :: (Directive -> Status) -> Status -> Status
handle Directive -> Status
_ Status
Skip = Status
Skip
handle Directive -> Status
handler (Continue Directive
directive) = Directive -> Status
handler Directive
directive
handle Directive -> Status
handler (Include Directive
directive) = Directive -> Status
handler Directive
directive
skip :: Status -> Status
skip :: Status -> Status
skip = (Directive -> Status) -> Status -> Status
handle Directive -> Status
skip'
where
skip' :: Directive -> Status
skip' directive' :: Directive
directive'@(Directive Text
"skip" (Arguments HashMap Text Value
arguments)) =
case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"if" HashMap Text Value
arguments of
(Just (Boolean Bool
True)) -> Status
Skip
Maybe Value
_ -> Directive -> Status
Include Directive
directive'
skip' Directive
directive' = Directive -> Status
Continue Directive
directive'
include :: Status -> Status
include :: Status -> Status
include = (Directive -> Status) -> Status -> Status
handle Directive -> Status
include'
where
include' :: Directive -> Status
include' directive' :: Directive
directive'@(Directive Text
"include" (Arguments HashMap Text Value
arguments)) =
case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"if" HashMap Text Value
arguments of
(Just (Boolean Bool
True)) -> Directive -> Status
Include Directive
directive'
Maybe Value
_ -> Status
Skip
include' Directive
directive' = Directive -> Status
Continue Directive
directive'