{-# 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 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 x :: HashMap Text Value
x) <> :: Arguments -> Arguments -> Arguments
<> (Arguments y :: 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 this :: Text
this _) == :: ScalarType -> ScalarType -> Bool
== (ScalarType that :: Text
that _) = Text
this Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
that
data EnumType = EnumType Name (Maybe Text) (HashMap Name EnumValue)
instance Eq EnumType where
(EnumType this :: Text
this _ _) == :: EnumType -> EnumType -> Bool
== (EnumType that :: Text
that _ _) = Text
this Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
that
newtype EnumValue = EnumValue (Maybe Text)
string :: ScalarType
string :: ScalarType
string = Text -> Maybe Text -> ScalarType
ScalarType "String" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
"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 "Boolean" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description = "The `Boolean` scalar type represents `true` or `false`."
int :: ScalarType
int :: ScalarType
int = Text -> Maybe Text -> ScalarType
ScalarType "Int" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
"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 "Float" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
"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 "ID" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
description)
where
description :: Text
description =
"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
directive' directives' :: 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 _) -> Maybe [Directive]
directives'
Skip -> Maybe [Directive]
forall a. Maybe a
Nothing
(Continue x :: 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 _ Skip = Status
Skip
handle handler :: Directive -> Status
handler (Continue directive :: Directive
directive) = Directive -> Status
handler Directive
directive
handle handler :: Directive -> Status
handler (Include directive :: 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 "skip" (Arguments 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 "if" HashMap Text Value
arguments of
(Just (Boolean True)) -> Status
Skip
_ -> Directive -> Status
Include Directive
directive'
skip' directive' :: 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 "include" (Arguments 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 "if" HashMap Text Value
arguments of
(Just (Boolean True)) -> Directive -> Status
Include Directive
directive'
_ -> Status
Skip
include' directive' :: Directive
directive' = Directive -> Status
Continue Directive
directive'