{-# LANGUAGE CPP #-} {-# 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.Parser ( eitherDecodeWith, jsonNoDup, ) #if MIN_VERSION_aeson(2,1,0) import Data.Aeson.Types ( formatError,ifromJSON,) #else import Data.Aeson.Internal ( formatError,ifromJSON,) #endif 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 Parser Value -> (Value -> IResult GQLRequest) -> ByteString -> Either (JSONPath, [Char]) GQLRequest forall a. Parser Value -> (Value -> IResult a) -> ByteString -> Either (JSONPath, [Char]) a eitherDecodeWith Parser Value jsonNoDup Value -> IResult GQLRequest forall a. FromJSON a => Value -> IResult a ifromJSON ByteString str of Left (JSONPath path, [Char] x) -> ByteString -> m GQLRequest forall a. ByteString -> m a forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (ByteString -> m GQLRequest) -> ByteString -> m GQLRequest forall a b. (a -> b) -> a -> b $ [Char] -> ByteString pack ([Char] -> ByteString) -> [Char] -> ByteString forall a b. (a -> b) -> a -> b $ [Char] "Bad Request. Could not decode Request body: " [Char] -> [Char] -> [Char] forall a. Semigroup a => a -> a -> a <> JSONPath -> [Char] -> [Char] formatError JSONPath path [Char] x Right GQLRequest value -> GQLRequest -> m GQLRequest forall a. a -> m a 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 = (ByteString -> m ByteString) -> (GQLRequest -> m ByteString) -> Either ByteString GQLRequest -> m ByteString forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either ByteString -> m ByteString forall a. a -> m a forall (f :: * -> *) a. Applicative f => a -> f a pure ((GQLResponse -> ByteString) -> m GQLResponse -> m ByteString forall a b. (a -> b) -> m a -> m b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap GQLResponse -> ByteString forall a. ToJSON a => a -> ByteString encode (m GQLResponse -> m ByteString) -> (GQLRequest -> m GQLResponse) -> GQLRequest -> m ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . GQLRequest -> m GQLResponse api) (Either ByteString GQLRequest -> m ByteString) -> (ByteString -> Either ByteString GQLRequest) -> ByteString -> m ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> Either ByteString GQLRequest 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 = (ByteString -> Text) -> m ByteString -> m Text forall a b. (a -> b) -> m a -> m b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ByteString -> Text decodeUtf8 (m ByteString -> m Text) -> (Text -> m ByteString) -> Text -> m Text forall b c a. (b -> c) -> (a -> b) -> a -> c . (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString forall a b (m :: * -> *). (MapAPI a b, Applicative m) => (GQLRequest -> m GQLResponse) -> a -> m b forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString mapAPI GQLRequest -> m GQLResponse api (ByteString -> m ByteString) -> (Text -> ByteString) -> Text -> m ByteString 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 = (ByteString -> ByteString) -> m ByteString -> m ByteString forall a b. (a -> b) -> m a -> m b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap ByteString -> ByteString LB.toStrict (m ByteString -> m ByteString) -> (ByteString -> m ByteString) -> ByteString -> m ByteString forall b c a. (b -> c) -> (a -> b) -> a -> c . (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString forall a b (m :: * -> *). (MapAPI a b, Applicative m) => (GQLRequest -> m GQLResponse) -> a -> m b forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString mapAPI GQLRequest -> m GQLResponse api (ByteString -> m ByteString) -> (ByteString -> ByteString) -> ByteString -> m ByteString 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 = (Text -> Text) -> m Text -> m Text forall a b. (a -> b) -> m a -> m b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Text -> Text LT.toStrict (m Text -> m Text) -> (Text -> m Text) -> Text -> m Text forall b c a. (b -> c) -> (a -> b) -> a -> c . (GQLRequest -> m GQLResponse) -> Text -> m Text forall a b (m :: * -> *). (MapAPI a b, Applicative m) => (GQLRequest -> m GQLResponse) -> a -> m b forall (m :: * -> *). Applicative m => (GQLRequest -> m GQLResponse) -> Text -> m Text mapAPI GQLRequest -> m GQLResponse api (Text -> m Text) -> (Text -> Text) -> Text -> m Text forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Text LT.fromStrict