{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-term-variable-capture #-}

module Miso.GraphQL.JSON where

import Control.Monad ((<=<))
import Data.List.NonEmpty (NonEmpty (..))
import GHC.Generics (Generic)
import Miso.GraphQL.AST hiding (Value)
import Miso.GraphQL.Printer ()
import Miso.JSON
import Miso.Prelude hiding (Object)

newtype Request = Request {Request -> MisoString
query :: MisoString}
    deriving stock ((forall x. Request -> Rep Request x)
-> (forall x. Rep Request x -> Request) -> Generic Request
forall x. Rep Request x -> Request
forall x. Request -> Rep Request x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Request -> Rep Request x
from :: forall x. Request -> Rep Request x
$cto :: forall x. Rep Request x -> Request
to :: forall x. Rep Request x -> Request
Generic)
    deriving anyclass (Request -> Value
(Request -> Value) -> ToJSON Request
forall a. (a -> Value) -> ToJSON a
$ctoJSON :: Request -> Value
toJSON :: Request -> Value
ToJSON)

class Operation op where
    type ReturnType op
    toOperation :: op -> OperationDefinition

execute
    :: forall op error parent model action
     . ( Operation op
       , FromJSON (ReturnType op)
       , FromJSVal error
       )
    => op
    -> MisoString
    -- ^ URL
    -> [(MisoString, MisoString)]
    -- ^ Headers
    -> (Response (Result (ReturnType op)) -> action)
    -- ^ successful callback
    -> (Response error -> action)
    -- ^ errorful callback
    -> Effect parent model action
execute :: forall op error parent model action.
(Operation op, FromJSON (ReturnType op), FromJSVal error) =>
op
-> MisoString
-> [(MisoString, MisoString)]
-> (Response (Result (ReturnType op)) -> action)
-> (Response error -> action)
-> Effect parent model action
execute op
op MisoString
url [(MisoString, MisoString)]
headers Response (Result (ReturnType op)) -> action
successful =
    MisoString
-> Request
-> [(MisoString, MisoString)]
-> (Response Value -> action)
-> (Response error -> action)
-> Effect parent model action
forall error body return action parent model.
(FromJSVal error, ToJSON body, FromJSON return) =>
MisoString
-> body
-> [(MisoString, MisoString)]
-> (Response return -> action)
-> (Response error -> action)
-> Effect parent model action
postJSON' MisoString
url Request{query :: MisoString
query = OperationDefinition -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString OperationDefinition
operation} [(MisoString, MisoString)]
headers \Response{Maybe Int
Maybe MisoString
Map MisoString MisoString
Value
status :: Maybe Int
headers :: Map MisoString MisoString
errorMessage :: Maybe MisoString
body :: Value
body :: forall body. Response body -> body
errorMessage :: forall body. Response body -> Maybe MisoString
headers :: forall body. Response body -> Map MisoString MisoString
status :: forall body. Response body -> Maybe Int
..} ->
        Response (Result (ReturnType op)) -> action
successful
            Response{body :: Result (ReturnType op)
body = (MisoString -> Result (ReturnType op))
-> (ReturnType op -> Result (ReturnType op))
-> Either MisoString (ReturnType op)
-> Result (ReturnType op)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MisoString -> Result (ReturnType op)
forall a. MisoString -> Result a
Error ReturnType op -> Result (ReturnType op)
forall a. a -> Result a
Success (Either MisoString (ReturnType op) -> Result (ReturnType op))
-> Either MisoString (ReturnType op) -> Result (ReturnType op)
forall a b. (a -> b) -> a -> b
$ (Value -> Parser (ReturnType op))
-> Value -> Either MisoString (ReturnType op)
forall a b. (a -> Parser b) -> a -> Either MisoString b
parseEither Value -> Parser (ReturnType op)
executionResult Value
body, Maybe Int
Maybe MisoString
Map MisoString MisoString
status :: Maybe Int
headers :: Map MisoString MisoString
errorMessage :: Maybe MisoString
errorMessage :: Maybe MisoString
headers :: Map MisoString MisoString
status :: Maybe Int
..}
  where
    operation :: OperationDefinition
operation = op -> OperationDefinition
forall op. Operation op => op -> OperationDefinition
toOperation op
op
    (Selection
selection :| [Selection]
_) = OperationDefinition -> NonEmpty Selection
operationSelectionSet OperationDefinition
operation
    executionResult :: Value -> Parser (ReturnType op)
    executionResult :: Value -> Parser (ReturnType op)
executionResult = MisoString
-> (Object -> Parser (ReturnType op))
-> Value
-> Parser (ReturnType op)
forall a. MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject MisoString
"ExecutionResult" ((Object -> Parser (ReturnType op))
 -> Value -> Parser (ReturnType op))
-> (Object -> Parser (ReturnType op))
-> Value
-> Parser (ReturnType op)
forall a b. (a -> b) -> a -> b
$ Value -> Parser (ReturnType op)
data_ (Value -> Parser (ReturnType op))
-> (Object -> Parser Value) -> Object -> Parser (ReturnType op)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Object -> MisoString -> Parser Value
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
"data")
    data_ :: Value -> Parser (ReturnType op)
    data_ :: Value -> Parser (ReturnType op)
data_ =
        case Selection
selection of
            SelectionField (Field Maybe Alias
_ (Name MisoString
name) Maybe Arguments
_ Maybe Directives
_ Maybe (NonEmpty Selection)
_) -> MisoString
-> (Object -> Parser (ReturnType op))
-> Value
-> Parser (ReturnType op)
forall a. MisoString -> (Object -> Parser a) -> Value -> Parser a
withObject MisoString
"Data" ((Object -> Parser (ReturnType op))
 -> Value -> Parser (ReturnType op))
-> (Object -> Parser (ReturnType op))
-> Value
-> Parser (ReturnType op)
forall a b. (a -> b) -> a -> b
$ Value -> Parser (ReturnType op)
forall a. FromJSON a => Value -> Parser a
parseJSON (Value -> Parser (ReturnType op))
-> (Object -> Parser Value) -> Object -> Parser (ReturnType op)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< (Object -> MisoString -> Parser Value
forall a. FromJSON a => Object -> MisoString -> Parser a
.: MisoString
name)
            Selection
_ -> Value -> Parser (ReturnType op)
forall a. FromJSON a => Value -> Parser a
parseJSON