{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
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.List (intercalate)
import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Language.GraphQL.AST (Name, escape)
import Numeric (showFloat)
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
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
instance Show Value where
showList :: [Value] -> ShowS
showList = forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Show a => [a] -> String
showList'
where
showList' :: [a] -> String
showList' [a]
list = String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
list) forall a. [a] -> [a] -> [a]
++ String
"]"
show :: Value -> String
show (Int Int32
integer) = forall a. Show a => a -> String
show Int32
integer
show (Float Double
float') = forall a. RealFloat a => a -> ShowS
showFloat Double
float' forall a. Monoid a => a
mempty
show (String Name
text) = String
"\"" forall a. Semigroup a => a -> a -> a
<> forall a. (Char -> a -> a) -> a -> Name -> a
Text.foldr (forall a. Monoid a => a -> a -> a
mappend forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
escape) String
"\"" Name
text
show (Boolean Bool
boolean') = forall a. Show a => a -> String
show Bool
boolean'
show Value
Null = String
"null"
show (Enum Name
name) = Name -> String
Text.unpack Name
name
show (List [Value]
list) = forall a. Show a => a -> String
show [Value]
list
show (Object HashMap Name Value
fields) = [String] -> String
unwords
[ String
"{"
, forall a. [a] -> [[a]] -> [a]
intercalate String
", " (forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey forall {a}. Show a => Name -> a -> [String] -> [String]
showObject [] HashMap Name Value
fields)
, String
"}"
]
where
showObject :: Name -> a -> [String] -> [String]
showObject Name
key a
value [String]
accumulator =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Name -> String
Text.unpack Name
key, String
": ", forall a. Show a => a -> String
show a
value] forall a. a -> [a] -> [a]
: [String]
accumulator
instance IsString Value where
fromString :: String -> Value
fromString = Name -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => String -> a
fromString
type Subs = HashMap Name Value
newtype Arguments = Arguments (HashMap Name Value)
deriving (Arguments -> Arguments -> Bool
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
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 Name Value
x) <> :: Arguments -> Arguments -> Arguments
<> (Arguments HashMap Name Value
y) = HashMap Name Value -> Arguments
Arguments forall a b. (a -> b) -> a -> b
$ HashMap Name Value
x forall a. Semigroup a => a -> a -> a
<> HashMap Name Value
y
instance Monoid Arguments where
mempty :: Arguments
mempty = HashMap Name Value -> Arguments
Arguments forall a. Monoid a => a
mempty
data ScalarType = ScalarType Name (Maybe Text)
instance Eq ScalarType where
(ScalarType Name
this Maybe Name
_) == :: ScalarType -> ScalarType -> Bool
== (ScalarType Name
that Maybe Name
_) = Name
this forall a. Eq a => a -> a -> Bool
== Name
that
instance Show ScalarType where
show :: ScalarType -> String
show (ScalarType Name
typeName Maybe Name
_) = Name -> String
Text.unpack Name
typeName
data EnumType = EnumType Name (Maybe Text) (HashMap Name EnumValue)
instance Eq EnumType where
(EnumType Name
this Maybe Name
_ HashMap Name EnumValue
_) == :: EnumType -> EnumType -> Bool
== (EnumType Name
that Maybe Name
_ HashMap Name EnumValue
_) = Name
this forall a. Eq a => a -> a -> Bool
== Name
that
instance Show EnumType where
show :: EnumType -> String
show (EnumType Name
typeName Maybe Name
_ HashMap Name EnumValue
_) = Name -> String
Text.unpack Name
typeName
newtype EnumValue = EnumValue (Maybe Text)
string :: ScalarType
string :: ScalarType
string = Name -> Maybe Name -> ScalarType
ScalarType Name
"String" (forall a. a -> Maybe a
Just Name
description)
where
description :: Name
description =
Name
"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 = Name -> Maybe Name -> ScalarType
ScalarType Name
"Boolean" (forall a. a -> Maybe a
Just Name
description)
where
description :: Name
description = Name
"The `Boolean` scalar type represents `true` or `false`."
int :: ScalarType
int :: ScalarType
int = Name -> Maybe Name -> ScalarType
ScalarType Name
"Int" (forall a. a -> Maybe a
Just Name
description)
where
description :: Name
description =
Name
"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 = Name -> Maybe Name -> ScalarType
ScalarType Name
"Float" (forall a. a -> Maybe a
Just Name
description)
where
description :: Name
description =
Name
"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 = Name -> Maybe Name -> ScalarType
ScalarType Name
"ID" (forall a. a -> Maybe a
Just Name
description)
where
description :: Name
description =
Name
"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
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
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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Directive -> Maybe [Directive] -> Maybe [Directive]
go (forall a. a -> Maybe a
Just [])
where
go :: Directive -> Maybe [Directive] -> Maybe [Directive]
go Directive
directive' Maybe [Directive]
directives' =
case (Status -> Status
skip 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 -> forall a. Maybe a
Nothing
(Continue Directive
x) -> (Directive
x forall a. a -> [a] -> [a]
:) 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 Name
"skip" (Arguments HashMap Name Value
arguments)) =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"if" HashMap Name 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 Name
"include" (Arguments HashMap Name Value
arguments)) =
case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Name
"if" HashMap Name Value
arguments of
(Just (Boolean Bool
True)) -> Directive -> Status
Include Directive
directive'
Maybe Value
_ -> Status
Skip
include' Directive
directive' = Directive -> Status
Continue Directive
directive'