{-# LANGUAGE OverloadedStrings #-}

-- | Types that can be used as both input and output types.
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)

-- | Represents accordingly typed GraphQL values.
data Value
    = Int Int32
    | Float Double -- ^ GraphQL Float is double precision.
    | String Text
    | Boolean Bool
    | Null
    | Enum Name
    | List [Value] -- ^ Arbitrary nested list.
    | 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

-- | Contains variables for the query. The key of the map is a variable name,
-- and the value is the variable value.
type Subs = HashMap Name Value

-- | Argument list.
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

-- | Scalar type definition.
--
-- The leaf values of any request and input values to arguments are Scalars (or
-- Enums) .
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

-- | Enum type definition.
--
-- Some leaf values of requests and input values are Enums. GraphQL serializes
-- Enum values as strings, however internally Enums can be represented by any
-- kind of type, often integers.
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

-- | Enum value is a single member of an 'EnumType'.
newtype EnumValue = EnumValue (Maybe 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.
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."

-- | The @Boolean@ scalar type represents @true@ or @false@.
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`."

-- | The @Int@ scalar type represents non-fractional signed whole numeric
-- values. Int can represent values between \(-2^{31}\) and \(2^{31 - 1}\).
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."

-- | The @Float@ scalar type represents signed double-precision fractional
-- values as specified by
-- [IEEE 754](https://en.wikipedia.org/wiki/IEEE_floating_point).
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)."

-- | 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.
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."

-- | Directive.
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)

-- | Directive processing status.
data Status
    = Skip -- ^ Skip the selection and stop directive processing
    | Include Directive -- ^ The directive was processed, try other handlers
    | Continue Directive -- ^ Directive handler mismatch, try other handlers

-- | Takes a list of directives, handles supported directives and excludes them
--   from the result. If the selection should be skipped, returns 'Nothing'.
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

-- * Directive implementations

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'