{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
module Language.GraphQL.Type.Definition
( Arguments(..)
, Directive(..)
, EnumType(..)
, EnumValue(..)
, ScalarType(..)
, Subs
, Value(..)
, boolean
, float
, id
, int
, showNonNullType
, showNonNullListType
, 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
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq
instance Show Value where
showList :: [Value] -> ShowS
showList = String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> ([Value] -> String) -> [Value] -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> String
forall {a}. Show a => [a] -> String
showList'
where
showList' :: [a] -> String
showList' [a]
list = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " (a -> String
forall a. Show a => a -> String
show (a -> String) -> [a] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
list) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
show :: Value -> String
show (Int Int32
integer) = Int32 -> String
forall a. Show a => a -> String
show Int32
integer
show (Float Double
float') = Double -> ShowS
forall a. RealFloat a => a -> ShowS
showFloat Double
float' String
forall a. Monoid a => a
mempty
show (String Name
text) = String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Char -> ShowS) -> String -> Name -> String
forall a. (Char -> a -> a) -> a -> Name -> a
Text.foldr (String -> ShowS
forall a. Monoid a => a -> a -> a
mappend (String -> ShowS) -> (Char -> String) -> Char -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> String
escape) String
"\"" Name
text
show (Boolean Bool
boolean') = Bool -> String
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) = [Value] -> String
forall a. Show a => a -> String
show [Value]
list
show (Object HashMap Name Value
fields) = [String] -> String
unwords
[ String
"{"
, String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((Name -> Value -> [String] -> [String])
-> [String] -> HashMap Name Value -> [String]
forall k v a. (k -> v -> a -> a) -> a -> HashMap k v -> a
HashMap.foldrWithKey Name -> Value -> [String] -> [String]
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 =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Name -> String
Text.unpack Name
key, String
": ", a -> String
forall a. Show a => a -> String
show a
value] String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
accumulator
instance IsString Value where
fromString :: String -> Value
fromString = Name -> Value
String (Name -> Value) -> (String -> Name) -> String -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Name
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
$c== :: Arguments -> Arguments -> Bool
== :: Arguments -> Arguments -> Bool
$c/= :: Arguments -> Arguments -> Bool
/= :: 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
$cshowsPrec :: Int -> Arguments -> ShowS
showsPrec :: Int -> Arguments -> ShowS
$cshow :: Arguments -> String
show :: Arguments -> String
$cshowList :: [Arguments] -> ShowS
showList :: [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 (HashMap Name Value -> Arguments)
-> HashMap Name Value -> Arguments
forall a b. (a -> b) -> a -> b
$ HashMap Name Value
x HashMap Name Value -> HashMap Name Value -> HashMap Name Value
forall a. Semigroup a => a -> a -> a
<> HashMap Name Value
y
instance Monoid Arguments where
mempty :: Arguments
mempty = HashMap Name Value -> Arguments
Arguments HashMap Name Value
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 Name -> Name -> Bool
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 Name -> Name -> Bool
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" (Name -> Maybe Name
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" (Name -> Maybe Name
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" (Name -> Maybe Name
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" (Name -> Maybe Name
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" (Name -> Maybe Name
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
(Directive -> Directive -> Bool)
-> (Directive -> Directive -> Bool) -> Eq Directive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Directive -> Directive -> Bool
== :: Directive -> Directive -> Bool
$c/= :: Directive -> Directive -> Bool
/= :: 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
$cshowsPrec :: Int -> Directive -> ShowS
showsPrec :: Int -> Directive -> ShowS
$cshow :: Directive -> String
show :: Directive -> String
$cshowList :: [Directive] -> ShowS
showList :: [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 a b. (a -> b -> b) -> b -> [a] -> b
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 Name
"skip" (Arguments HashMap Name Value
arguments)) =
case Name -> HashMap Name Value -> Maybe Value
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 Name -> HashMap Name Value -> Maybe Value
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'
showNonNullType :: Show a => a -> String
showNonNullType :: forall a. Show a => a -> String
showNonNullType = (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"!") ShowS -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
showNonNullListType :: Show a => a -> String
showNonNullListType :: forall a. Show a => a -> String
showNonNullListType a
listType =
let representation :: String
representation = a -> String
forall a. Show a => a -> String
show a
listType
in [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"[", String
representation, String
"]!"]