{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.App.MapAPI ( MapAPI (..), ) where import Control.Monad.Except (MonadError (throwError)) import Data.Aeson ( encode, ) import Data.Aeson.Internal ( formatError, ifromJSON, ) import Data.Aeson.Parser ( eitherDecodeWith, jsonNoDup, ) import Data.ByteString.Lazy.Char8 (pack) import qualified Data.ByteString.Lazy.Char8 as LB ( ByteString, fromStrict, toStrict, ) import Data.Morpheus.Types.IO ( GQLRequest (..), GQLResponse (..), ) import qualified Data.Text.Lazy as LT ( Text, fromStrict, toStrict, ) import Data.Text.Lazy.Encoding ( decodeUtf8, encodeUtf8, ) import Relude hiding ( decodeUtf8, encodeUtf8, ) decodeNoDup :: MonadError LB.ByteString m => LB.ByteString -> m GQLRequest decodeNoDup :: forall (m :: * -> *). MonadError ByteString m => ByteString -> m GQLRequest decodeNoDup ByteString str = case forall a. Parser Value -> (Value -> IResult a) -> ByteString -> Either (JSONPath, [Char]) a eitherDecodeWith Parser Value jsonNoDup forall a. FromJSON a => Value -> IResult a ifromJSON ByteString str of Left (JSONPath path, [Char] x) -> forall e (m :: * -> *) a. MonadError e m => e -> m a throwError forall a b. (a -> b) -> a -> b $ [Char] -> ByteString pack forall a b. (a -> b) -> a -> b $ [Char] "Bad Request. Could not decode Request body: " forall a. Semigroup a => a -> a -> a <> JSONPath -> [Char] -> [Char] formatError JSONPath path [Char] x Right GQLRequest value -> forall (f :: * -> *) a. Applicative f => a -> f a pure GQLRequest value class MapAPI a b where mapAPI :: Applicative m => (GQLRequest -> m GQLResponse) -> a -> m b instance MapAPI GQLRequest GQLResponse where mapAPI :: forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> GQLRequest -> m GQLResponse mapAPI GQLRequest -> m GQLResponse f = GQLRequest -> m GQLResponse f instance MapAPI LB.ByteString LB.ByteString where mapAPI :: forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString mapAPI GQLRequest -> m GQLResponse api = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall (f :: * -> *) a. Applicative f => a -> f a pure (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a. ToJSON a => a -> ByteString encode forall b c a. (b -> c) -> (a -> b) -> a -> c . GQLRequest -> m GQLResponse api) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). MonadError ByteString m => ByteString -> m GQLRequest decodeNoDup instance MapAPI LT.Text LT.Text where mapAPI :: forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> Text -> m Text mapAPI GQLRequest -> m GQLResponse api = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ByteString -> Text decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b (m :: * -> *). (MapAPI a b, Applicative m) => (GQLRequest -> m GQLResponse) -> a -> m b mapAPI GQLRequest -> m GQLResponse api forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> ByteString encodeUtf8 instance MapAPI ByteString ByteString where mapAPI :: forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString mapAPI GQLRequest -> m GQLResponse api = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ByteString -> ByteString LB.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b (m :: * -> *). (MapAPI a b, Applicative m) => (GQLRequest -> m GQLResponse) -> a -> m b mapAPI GQLRequest -> m GQLResponse api forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> ByteString LB.fromStrict instance MapAPI Text Text where mapAPI :: forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> Text -> m Text mapAPI GQLRequest -> m GQLResponse api = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Text LT.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b (m :: * -> *). (MapAPI a b, Applicative m) => (GQLRequest -> m GQLResponse) -> a -> m b mapAPI GQLRequest -> m GQLResponse api forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Text LT.fromStrict