{-# 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 :: ByteString -> m GQLRequest
decodeNoDup ByteString
str = case Parser Value
-> (Value -> IResult GQLRequest)
-> ByteString
-> Either (JSONPath, String) GQLRequest
forall a.
Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
eitherDecodeWith Parser Value
jsonNoDup Value -> IResult GQLRequest
forall a. FromJSON a => Value -> IResult a
ifromJSON ByteString
str of
  Left (JSONPath
path, String
x) -> ByteString -> m GQLRequest
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ByteString -> m GQLRequest) -> ByteString -> m GQLRequest
forall a b. (a -> b) -> a -> b
$ String -> ByteString
pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Bad Request. Could not decode Request body: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> JSONPath -> String -> String
formatError JSONPath
path String
x
  Right GQLRequest
value -> GQLRequest -> m GQLRequest
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 :: (GQLRequest -> m GQLResponse) -> GQLRequest -> m GQLResponse
mapAPI GQLRequest -> m GQLResponse
f = GQLRequest -> m GQLResponse
f

instance MapAPI LB.ByteString LB.ByteString where
  mapAPI :: (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 (f :: * -> *) a. Applicative f => a -> f a
pure ((GQLResponse -> ByteString) -> m GQLResponse -> m ByteString
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 :: (GQLRequest -> m GQLResponse) -> Text -> m Text
mapAPI GQLRequest -> m GQLResponse
api = (ByteString -> Text) -> m ByteString -> m Text
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
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 :: (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString
mapAPI GQLRequest -> m GQLResponse
api = (ByteString -> ByteString) -> m ByteString -> m ByteString
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
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 :: (GQLRequest -> m GQLResponse) -> Text -> m Text
mapAPI GQLRequest -> m GQLResponse
api = (Text -> Text) -> m Text -> m Text
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
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