{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

#ifdef WITH_JSON
-- | This module provides the functions to parse and execute @GraphQL@ queries.
--
-- The content of this module depends on the value of the __json__ flag, which
-- is currently on by default. This behavior will change in the future, the flag
-- will be switched off by default and then removed.
--
-- This documentation is generated with the enabled __json__ flag and functions
-- described here support JSON and are deprecated. JSON instances are provided
-- now by an additional package, __graphql-spice__. To start using the new
-- package create __cabal.project__ in the root directory of your project with
-- the following contents:
--
-- @
-- packages: .
-- constraints: graphql -json
-- @
--
-- Then add __graphql-spice__ as dependency.
--
-- The new version of this module defines only one function, @graphql@, which
-- works with the internal GraphQL value representation used by this lbirary.
-- Refer to @Language.GraphQL.JSON.graphql@ in __graphql-spice__ for the
-- function that accepts and returns JSON.
module Language.GraphQL
    ( graphql
    , graphqlSubs
    ) where

import Control.Monad.Catch (MonadCatch)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (catMaybes)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import Language.GraphQL.AST
import Language.GraphQL.Error
import Language.GraphQL.Execute
import qualified Language.GraphQL.Validate as Validate
import Language.GraphQL.Type.Schema (Schema)
import Text.Megaparsec (parse)

{-# DEPRECATED graphql "Use graphql-spice package instead" #-}
-- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema'.
graphql :: MonadCatch m
    => Schema m -- ^ Resolvers.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphql schema = graphqlSubs schema mempty mempty

{-# DEPRECATED graphqlSubs "Use graphql-spice package instead" #-}
-- | If the text parses correctly as a @GraphQL@ query the substitution is
-- applied to the query and the query is then executed using to the given
-- 'Schema'.
graphqlSubs :: MonadCatch m
    => Schema m -- ^ Resolvers.
    -> Maybe Text -- ^ Operation name.
    -> Aeson.Object -- ^ Variable substitution function.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m (Either (ResponseEventStream m Aeson.Value) Aeson.Object) -- ^ Response.
graphqlSubs schema operationName variableValues document' =
    case parse document "" document' of
        Left errorBundle -> pure . formatResponse <$> parseError errorBundle
        Right parsed ->
            case validate parsed of
                Seq.Empty -> fmap formatResponse
                    <$> execute schema operationName variableValues parsed
                errors -> pure $ pure
                    $ HashMap.singleton "errors"
                    $ Aeson.toJSON
                    $ fromValidationError <$> errors
  where
    validate = Validate.document schema Validate.specifiedRules
    formatResponse (Response data'' Seq.Empty) = HashMap.singleton "data" data''
    formatResponse (Response data'' errors') = HashMap.fromList
        [ ("data", data'')
        , ("errors", Aeson.toJSON $ fromError <$> errors')
        ]
    fromError Error{..} = Aeson.object $ catMaybes
        [ Just ("message", Aeson.toJSON message)
        , toMaybe fromLocation "locations" locations
        , toMaybe fromPath "path" path
        ]
    fromValidationError Validate.Error{..} = Aeson.object
        [ ("message", Aeson.toJSON message)
        , ("locations", Aeson.listValue fromLocation locations)
        ]
    toMaybe _ _ [] = Nothing
    toMaybe f key xs = Just (key, Aeson.listValue f xs)
    fromPath (Segment segment) = Aeson.String segment
    fromPath (Index index) = Aeson.toJSON index
    fromLocation Location{..} = Aeson.object
        [ ("line", Aeson.toJSON line)
        , ("column", Aeson.toJSON column)
        ]
#else
-- | This module provides the functions to parse and execute @GraphQL@ queries.
module Language.GraphQL
    ( graphql
    ) where

import Control.Monad.Catch (MonadCatch)
import Data.HashMap.Strict (HashMap)
import qualified Data.Sequence as Seq
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Language.GraphQL.AST as Full
import Language.GraphQL.Error
import Language.GraphQL.Execute
import qualified Language.GraphQL.Validate as Validate
import Language.GraphQL.Type.Schema (Schema)
import Prelude hiding (null)
import Text.Megaparsec (parse)

-- | If the text parses correctly as a @GraphQL@ query the query is
-- executed using the given 'Schema'.
--
-- An operation name can be given if the document contains multiple operations.
graphql :: (MonadCatch m, VariableValue a, Serialize b)
    => Schema m -- ^ Resolvers.
    -> Maybe Text -- ^ Operation name.
    -> HashMap Full.Name a -- ^ Variable substitution function.
    -> Text -- ^ Text representing a @GraphQL@ request document.
    -> m (Either (ResponseEventStream m b) (Response b)) -- ^ Response.
graphql :: forall (m :: * -> *) a b.
(MonadCatch m, VariableValue a, Serialize b) =>
Schema m
-> Maybe Text
-> HashMap Text a
-> Text
-> m (Either (ResponseEventStream m b) (Response b))
graphql Schema m
schema Maybe Text
operationName HashMap Text a
variableValues Text
document' =
    case forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse Parser Document
Full.document String
"" Text
document' of
        Left ParseErrorBundle Text Void
errorBundle -> forall (f :: * -> *) a. Applicative f => a -> f a
pure  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a.
(Applicative f, Serialize a) =>
ParseErrorBundle Text Void -> f (Response a)
parseError ParseErrorBundle Text Void
errorBundle
        Right Document
parsed ->
            case Document -> Seq Error
validate Document
parsed of
                Seq Error
Seq.Empty -> forall (m :: * -> *) a b.
(MonadCatch m, VariableValue a, Serialize b) =>
Schema m
-> Maybe Text
-> HashMap Text a
-> Document
-> m (Either (ResponseEventStream m b) (Response b))
execute Schema m
schema Maybe Text
operationName HashMap Text a
variableValues Document
parsed
                Seq Error
errors -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure
                    forall a b. (a -> b) -> a -> b
$ forall a. a -> Seq Error -> Response a
Response forall a. Serialize a => a
null
                    forall a b. (a -> b) -> a -> b
$ Error -> Error
fromValidationError forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq Error
errors
  where
    validate :: Document -> Seq Error
validate = forall (m :: * -> *). Schema m -> [Rule m] -> Document -> Seq Error
Validate.document Schema m
schema forall (m :: * -> *). [Rule m]
Validate.specifiedRules
    fromValidationError :: Error -> Error
fromValidationError Validate.Error{String
[Location]
locations :: Error -> [Location]
message :: Error -> String
locations :: [Location]
message :: String
..} = Error
        { $sel:message:Error :: Text
message = String -> Text
Text.pack String
message
        , $sel:locations:Error :: [Location]
locations = [Location]
locations
        , $sel:path:Error :: [Path]
path = []
        }
#endif