{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Parsing.Request.Parser (parseGQL) where

--
-- MORPHEUS
import qualified Data.Aeson as Aeson
  ( Value (..),
  )
import Data.HashMap.Lazy (toList)
import Data.Morpheus.Internal.Utils
  ( fromElems,
    toLBS,
  )
import Data.Morpheus.Parsing.Internal.Internal
  ( Parser,
    processParser,
  )
import Data.Morpheus.Parsing.Internal.Terms
  ( ignoredTokens,
  )
import Data.Morpheus.Parsing.Request.Operation
  ( parseOperation,
  )
import Data.Morpheus.Parsing.Request.Selection
  ( parseFragmentDefinition,
  )
import Data.Morpheus.Types.IO (GQLRequest (..))
import Data.Morpheus.Types.Internal.AST
  ( FieldName (..),
    GQLQuery (..),
    ResolvedValue,
    replaceValue,
  )
import Data.Morpheus.Types.Internal.Resolving
  ( Eventless,
  )
import Relude hiding
  ( many,
    toList,
  )
import Text.Megaparsec
  ( eof,
    label,
    many,
  )

request :: Parser GQLQuery
request :: Parser GQLQuery
request =
  String -> Parser GQLQuery -> Parser GQLQuery
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"GQLQuery" (Parser GQLQuery -> Parser GQLQuery)
-> Parser GQLQuery -> Parser GQLQuery
forall a b. (a -> b) -> a -> b
$
    ( [(FieldName, ResolvedValue)]
-> Operation RAW -> Fragments RAW -> GQLQuery
GQLQuery []
        (Operation RAW -> Fragments RAW -> GQLQuery)
-> ParsecT MyError ByteString Eventless (Operation RAW)
-> ParsecT MyError ByteString Eventless (Fragments RAW -> GQLQuery)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
ignoredTokens Parser ()
-> ParsecT MyError ByteString Eventless (Operation RAW)
-> ParsecT MyError ByteString Eventless (Operation RAW)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT MyError ByteString Eventless (Operation RAW)
parseOperation)
        ParsecT MyError ByteString Eventless (Fragments RAW -> GQLQuery)
-> ParsecT MyError ByteString Eventless (Fragments RAW)
-> Parser GQLQuery
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT MyError ByteString Eventless (Fragment RAW)
-> ParsecT MyError ByteString Eventless [Fragment RAW]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT MyError ByteString Eventless (Fragment RAW)
parseFragmentDefinition ParsecT MyError ByteString Eventless [Fragment RAW]
-> ([Fragment RAW]
    -> ParsecT MyError ByteString Eventless (Fragments RAW))
-> ParsecT MyError ByteString Eventless (Fragments RAW)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Eventless (Fragments RAW)
-> ParsecT MyError ByteString Eventless (Fragments RAW)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Eventless (Fragments RAW)
 -> ParsecT MyError ByteString Eventless (Fragments RAW))
-> ([Fragment RAW] -> Eventless (Fragments RAW))
-> [Fragment RAW]
-> ParsecT MyError ByteString Eventless (Fragments RAW)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Fragment RAW] -> Eventless (Fragments RAW)
forall k (m :: k -> *) a (coll :: k).
FromElems m a coll =>
[a] -> m coll
fromElems)
    )
      Parser GQLQuery -> Parser () -> Parser GQLQuery
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
      Parser GQLQuery -> Parser () -> Parser GQLQuery
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

parseGQL :: GQLRequest -> Eventless GQLQuery
parseGQL :: GQLRequest -> Eventless GQLQuery
parseGQL GQLRequest {Text
query :: GQLRequest -> Text
query :: Text
query, Maybe Value
variables :: GQLRequest -> Maybe Value
variables :: Maybe Value
variables} =
  GQLQuery -> GQLQuery
setVariables
    (GQLQuery -> GQLQuery) -> Eventless GQLQuery -> Eventless GQLQuery
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser GQLQuery -> ByteString -> Eventless GQLQuery
forall a. Parser a -> ByteString -> Eventless a
processParser Parser GQLQuery
request (Text -> ByteString
toLBS Text
query)
  where
    setVariables :: GQLQuery -> GQLQuery
setVariables GQLQuery
root = GQLQuery
root {$sel:inputVariables:GQLQuery :: [(FieldName, ResolvedValue)]
inputVariables = Maybe Value -> [(FieldName, ResolvedValue)]
toVariableMap Maybe Value
variables}
    toVariableMap :: Maybe Aeson.Value -> [(FieldName, ResolvedValue)]
    toVariableMap :: Maybe Value -> [(FieldName, ResolvedValue)]
toVariableMap (Just (Aeson.Object Object
x)) = ((Text, Value) -> (FieldName, ResolvedValue))
-> [(Text, Value)] -> [(FieldName, ResolvedValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> (FieldName, ResolvedValue)
forall (a :: Stage). (Text, Value) -> (FieldName, Value a)
toMorpheusValue (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
toList Object
x)
      where
        toMorpheusValue :: (Text, Value) -> (FieldName, Value a)
toMorpheusValue (Text
key, Value
value) = (Text -> FieldName
FieldName Text
key, Value -> Value a
forall (a :: Stage). Value -> Value a
replaceValue Value
value)
    toVariableMap Maybe Value
_ = []