{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.Fetch.RequestType
  ( toRequest,
    decodeResponse,
    Request (..),
    RequestType (..),
    processResponse,
    ClientTypeConstraint,
    isSubscription,
  )
where

import Data.Aeson
  ( FromJSON,
    ToJSON (..),
    eitherDecode,
  )
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import Data.ByteString.Lazy (ByteString)
import Data.Morpheus.Client.Fetch.Types
  ( FetchError (..),
  )
import Data.Morpheus.Client.Schema.JSON.Types
  ( JSONResponse (..),
  )
import Data.Morpheus.Types.IO
  ( GQLRequest (..),
  )
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    OperationType (..),
  )
import Data.Text
  ( pack,
  )
import Relude hiding (ByteString)

fixVars :: A.Value -> Maybe A.Value
fixVars :: Value -> Maybe Value
fixVars Value
x
  | Value
x Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
A.emptyArray = Maybe Value
forall a. Maybe a
Nothing
  | Bool
otherwise = Value -> Maybe Value
forall a. a -> Maybe a
Just Value
x

toRequest :: (RequestType a, ToJSON (RequestArgs a)) => Request a -> GQLRequest
toRequest :: forall a.
(RequestType a, ToJSON (RequestArgs a)) =>
Request a -> GQLRequest
toRequest r :: Request a
r@Request {RequestArgs a
requestArgs :: RequestArgs a
requestArgs :: forall a. Request a -> RequestArgs a
requestArgs} =
  ( GQLRequest
      { operationName :: Maybe FieldName
operationName = FieldName -> Maybe FieldName
forall a. a -> Maybe a
Just (Request a -> FieldName
forall a (f :: * -> *). RequestType a => f a -> FieldName
forall (f :: * -> *). f a -> FieldName
__name Request a
r),
        query :: Text
query = String -> Text
pack (Request a -> String
forall a (f :: * -> *). RequestType a => f a -> String
forall (f :: * -> *). f a -> String
__query Request a
r),
        variables :: Maybe Value
variables = Value -> Maybe Value
fixVars (RequestArgs a -> Value
forall a. ToJSON a => a -> Value
toJSON RequestArgs a
requestArgs)
      }
  )

decodeResponse :: FromJSON a => ByteString -> Either (FetchError a) a
decodeResponse :: forall a. FromJSON a => ByteString -> Either (FetchError a) a
decodeResponse = ((String -> FetchError a)
-> Either String (JSONResponse a)
-> Either (FetchError a) (JSONResponse a)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first String -> FetchError a
forall a. String -> FetchError a
FetchErrorParseFailure (Either String (JSONResponse a)
 -> Either (FetchError a) (JSONResponse a))
-> (ByteString -> Either String (JSONResponse a))
-> ByteString
-> Either (FetchError a) (JSONResponse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String (JSONResponse a)
forall a. FromJSON a => ByteString -> Either String a
eitherDecode) (ByteString -> Either (FetchError a) (JSONResponse a))
-> (JSONResponse a -> Either (FetchError a) a)
-> ByteString
-> Either (FetchError a) a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> JSONResponse a -> Either (FetchError a) a
forall a. JSONResponse a -> Either (FetchError a) a
processResponse

processResponse :: JSONResponse a -> Either (FetchError a) a
processResponse :: forall a. JSONResponse a -> Either (FetchError a) a
processResponse JSONResponse {$sel:responseData:JSONResponse :: forall a. JSONResponse a -> Maybe a
responseData = Just a
x, $sel:responseErrors:JSONResponse :: forall a. JSONResponse a -> [GQLError]
responseErrors = []} = a -> Either (FetchError a) a
forall a b. b -> Either a b
Right a
x
processResponse JSONResponse {$sel:responseData:JSONResponse :: forall a. JSONResponse a -> Maybe a
responseData = Maybe a
Nothing, $sel:responseErrors:JSONResponse :: forall a. JSONResponse a -> [GQLError]
responseErrors = []} = FetchError a -> Either (FetchError a) a
forall a b. a -> Either a b
Left FetchError a
forall a. FetchError a
FetchErrorNoResult
processResponse JSONResponse {$sel:responseData:JSONResponse :: forall a. JSONResponse a -> Maybe a
responseData = Maybe a
result, $sel:responseErrors:JSONResponse :: forall a. JSONResponse a -> [GQLError]
responseErrors = (GQLError
x : [GQLError]
xs)} = FetchError a -> Either (FetchError a) a
forall a b. a -> Either a b
Left (FetchError a -> Either (FetchError a) a)
-> FetchError a -> Either (FetchError a) a
forall a b. (a -> b) -> a -> b
$ GQLErrors -> Maybe a -> FetchError a
forall a. GQLErrors -> Maybe a -> FetchError a
FetchErrorProducedErrors (GQLError
x GQLError -> [GQLError] -> GQLErrors
forall a. a -> [a] -> NonEmpty a
:| [GQLError]
xs) Maybe a
result

type ClientTypeConstraint (a :: Type) = (RequestType a, ToJSON (RequestArgs a), FromJSON a)

class RequestType a where
  type RequestArgs a :: Type
  __name :: f a -> FieldName
  __query :: f a -> String
  __type :: f a -> OperationType

newtype Request (a :: Type) = Request {forall a. Request a -> RequestArgs a
requestArgs :: RequestArgs a}

isSubscription :: RequestType a => Request a -> Bool
isSubscription :: forall a. RequestType a => Request a -> Bool
isSubscription Request a
x = Request a -> OperationType
forall a (f :: * -> *). RequestType a => f a -> OperationType
forall (f :: * -> *). f a -> OperationType
__type Request a
x OperationType -> OperationType -> Bool
forall a. Eq a => a -> a -> Bool
== OperationType
OPERATION_SUBSCRIPTION