{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.GQLScalar
( GQLScalar (..),
toScalar,
scalarToJSON,
scalarFromJSON,
)
where
import qualified Data.Aeson as A
import Data.Morpheus.Types.Internal.AST
( ScalarDefinition (..),
ScalarValue (..),
ValidValue,
Value (..),
replaceValue,
)
import Data.Text (unpack)
import Relude
toScalar :: ValidValue -> Either Text ScalarValue
toScalar :: ValidValue -> Either Text ScalarValue
toScalar (Scalar ScalarValue
x) = ScalarValue -> Either Text ScalarValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure ScalarValue
x
toScalar ValidValue
_ = Text -> Either Text ScalarValue
forall a b. a -> Either a b
Left Text
""
class GQLScalar a where
parseValue :: ScalarValue -> Either Text a
serialize :: a -> ScalarValue
scalarValidator :: f a -> ScalarDefinition
scalarValidator f a
_ = ScalarDefinition :: (ValidValue -> Either Text ValidValue) -> ScalarDefinition
ScalarDefinition {validateValue :: ValidValue -> Either Text ValidValue
validateValue = ValidValue -> Either Text ValidValue
validator}
where
validator :: ValidValue -> Either Text ValidValue
validator ValidValue
value = do
ScalarValue
scalarValue' <- ValidValue -> Either Text ScalarValue
toScalar ValidValue
value
(a
_ :: a) <- ScalarValue -> Either Text a
forall a. GQLScalar a => ScalarValue -> Either Text a
parseValue ScalarValue
scalarValue'
ValidValue -> Either Text ValidValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidValue
value
instance GQLScalar Text where
parseValue :: ScalarValue -> Either Text Text
parseValue (String Text
x) = Text -> Either Text Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
parseValue ScalarValue
_ = Text -> Either Text Text
forall a b. a -> Either a b
Left Text
""
serialize :: Text -> ScalarValue
serialize = Text -> ScalarValue
String
instance GQLScalar Bool where
parseValue :: ScalarValue -> Either Text Bool
parseValue (Boolean Bool
x) = Bool -> Either Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
x
parseValue ScalarValue
_ = Text -> Either Text Bool
forall a b. a -> Either a b
Left Text
""
serialize :: Bool -> ScalarValue
serialize = Bool -> ScalarValue
Boolean
instance GQLScalar Int where
parseValue :: ScalarValue -> Either Text Int
parseValue (Int Int
x) = Int -> Either Text Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
x
parseValue ScalarValue
_ = Text -> Either Text Int
forall a b. a -> Either a b
Left Text
""
serialize :: Int -> ScalarValue
serialize = Int -> ScalarValue
Int
instance GQLScalar Float where
parseValue :: ScalarValue -> Either Text Float
parseValue (Float Float
x) = Float -> Either Text Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
x
parseValue (Int Int
x) = Float -> Either Text Float
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Either Text Float) -> Float -> Either Text Float
forall a b. (a -> b) -> a -> b
$ Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
x
parseValue ScalarValue
_ = Text -> Either Text Float
forall a b. a -> Either a b
Left Text
""
serialize :: Float -> ScalarValue
serialize = Float -> ScalarValue
Float
scalarToJSON :: GQLScalar a => a -> A.Value
scalarToJSON :: a -> Value
scalarToJSON = ScalarValue -> Value
forall a. ToJSON a => a -> Value
A.toJSON (ScalarValue -> Value) -> (a -> ScalarValue) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ScalarValue
forall a. GQLScalar a => a -> ScalarValue
serialize
scalarFromJSON :: (Monad m, MonadFail m) => GQLScalar a => A.Value -> m a
scalarFromJSON :: Value -> m a
scalarFromJSON Value
x = case Value -> Value Any
forall (a :: Stage). Value -> Value a
replaceValue Value
x of
Scalar ScalarValue
value -> (Text -> m a) -> (a -> m a) -> Either Text a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (Text -> String) -> Text -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScalarValue -> Either Text a
forall a. GQLScalar a => ScalarValue -> Either Text a
parseValue ScalarValue
value)
Value Any
_ -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"input must be scalar value"