{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.IO
  ( GQLRequest (..),
    GQLResponse (..),
    renderResponse,
  )
where

import Data.Aeson
  ( FromJSON (..),
    ToJSON (..),
    object,
    pairs,
    (.=),
  )
import qualified Data.Aeson as Aeson
  ( Value (..),
  )
import Data.Morpheus.Ext.Result
  ( Result (..),
  )
import Data.Morpheus.Internal.Utils
  ( toAssoc,
  )
import Data.Morpheus.Types.Internal.AST
  ( FieldName,
    GQLError (..),
    ValidValue,
  )
import Relude hiding
  ( decodeUtf8,
    encodeUtf8,
  )

renderResponse :: Result GQLError ValidValue -> GQLResponse
renderResponse :: Result GQLError ValidValue -> GQLResponse
renderResponse (Failure NonEmpty GQLError
errors) = [GQLError] -> GQLResponse
Errors forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> [a]
sort forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty GQLError
errors
renderResponse Success {ValidValue
result :: forall err a. Result err a -> a
result :: ValidValue
result} = ValidValue -> GQLResponse
Data ValidValue
result

-- | GraphQL HTTP Request Body
data GQLRequest = GQLRequest
  { GQLRequest -> Maybe FieldName
operationName :: Maybe FieldName,
    GQLRequest -> Text
query :: Text,
    GQLRequest -> Maybe Value
variables :: Maybe Aeson.Value
  }
  deriving (Int -> GQLRequest -> ShowS
[GQLRequest] -> ShowS
GQLRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GQLRequest] -> ShowS
$cshowList :: [GQLRequest] -> ShowS
show :: GQLRequest -> String
$cshow :: GQLRequest -> String
showsPrec :: Int -> GQLRequest -> ShowS
$cshowsPrec :: Int -> GQLRequest -> ShowS
Show, forall x. Rep GQLRequest x -> GQLRequest
forall x. GQLRequest -> Rep GQLRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GQLRequest x -> GQLRequest
$cfrom :: forall x. GQLRequest -> Rep GQLRequest x
Generic, Value -> Parser [GQLRequest]
Value -> Parser GQLRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GQLRequest]
$cparseJSONList :: Value -> Parser [GQLRequest]
parseJSON :: Value -> Parser GQLRequest
$cparseJSON :: Value -> Parser GQLRequest
FromJSON, [GQLRequest] -> Encoding
[GQLRequest] -> Value
GQLRequest -> Encoding
GQLRequest -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GQLRequest] -> Encoding
$ctoEncodingList :: [GQLRequest] -> Encoding
toJSONList :: [GQLRequest] -> Value
$ctoJSONList :: [GQLRequest] -> Value
toEncoding :: GQLRequest -> Encoding
$ctoEncoding :: GQLRequest -> Encoding
toJSON :: GQLRequest -> Value
$ctoJSON :: GQLRequest -> Value
ToJSON)

-- | GraphQL Response
data GQLResponse
  = Data ValidValue
  | Errors [GQLError]
  deriving (Int -> GQLResponse -> ShowS
[GQLResponse] -> ShowS
GQLResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GQLResponse] -> ShowS
$cshowList :: [GQLResponse] -> ShowS
show :: GQLResponse -> String
$cshow :: GQLResponse -> String
showsPrec :: Int -> GQLResponse -> ShowS
$cshowsPrec :: Int -> GQLResponse -> ShowS
Show, forall x. Rep GQLResponse x -> GQLResponse
forall x. GQLResponse -> Rep GQLResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GQLResponse x -> GQLResponse
$cfrom :: forall x. GQLResponse -> Rep GQLResponse x
Generic)

instance FromJSON GQLResponse where
  parseJSON :: Value -> Parser GQLResponse
parseJSON (Aeson.Object Object
hm) = case forall k (m :: * -> *) a. IsMap k m => m a -> [(k, a)]
toAssoc Object
hm of
    [(Key
"data", Value
value)] -> ValidValue -> GQLResponse
Data forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
    [(Key
"errors", Value
value)] -> [GQLError] -> GQLResponse
Errors forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
    [Pair]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid GraphQL Response"
  parseJSON Value
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid GraphQL Response"

instance ToJSON GQLResponse where
  toJSON :: GQLResponse -> Value
toJSON (Data ValidValue
gqlData) = [Pair] -> Value
object [Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON ValidValue
gqlData]
  toJSON (Errors [GQLError]
errors) = [Pair] -> Value
object [Key
"errors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON [GQLError]
errors]

  ----------------------------------------------------------
  toEncoding :: GQLResponse -> Encoding
toEncoding (Data ValidValue
_data) = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ValidValue
_data
  toEncoding (Errors [GQLError]
_errors) = Series -> Encoding
pairs forall a b. (a -> b) -> a -> b
$ Key
"errors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [GQLError]
_errors