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