{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Parsing.Request.Selection
  ( parseSelectionSet,
    parseFragmentDefinition,
  )
where

--
-- MORPHEUS

import Data.Morpheus.Parsing.Internal.Arguments
  ( maybeArguments,
  )
import Data.Morpheus.Parsing.Internal.Internal
  ( Parser,
    getLocation,
  )
import Data.Morpheus.Parsing.Internal.Pattern
  ( optionalDirectives,
  )
import Data.Morpheus.Parsing.Internal.Terms
  ( keyword,
    parseAlias,
    parseName,
    parseTypeCondition,
    setOf,
    spreadLiteral,
  )
import Data.Morpheus.Types.Internal.AST
  ( Fragment (..),
    Position,
    RAW,
    Ref (..),
    Selection (..),
    SelectionContent (..),
    SelectionSet,
  )
import Data.Morpheus.Types.Internal.AST.Name
import Relude
import Text.Megaparsec
  ( label,
    try,
  )

-- Selection Sets : https://graphql.github.io/graphql-spec/June2018/#sec-Selection-Sets
--
-- SelectionSet:
--  { Selection(list) }
--
-- Selection:
--   Field
--   FragmentSpread
--   InlineFragment
--
parseSelectionSet :: Parser (SelectionSet RAW)
parseSelectionSet :: Parser (SelectionSet RAW)
parseSelectionSet = String -> Parser (SelectionSet RAW) -> Parser (SelectionSet RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"SelectionSet" (Parser (SelectionSet RAW) -> Parser (SelectionSet RAW))
-> Parser (SelectionSet RAW) -> Parser (SelectionSet RAW)
forall a b. (a -> b) -> a -> b
$ Parser (Selection RAW)
-> Parser (MergeMap 'True FieldName (Selection RAW))
forall (map :: * -> * -> *) k a.
(FromList GQLResult map k a, KeyOf k a) =>
Parser a -> Parser (map k a)
setOf Parser (Selection RAW)
parseSelection
  where
    parseSelection :: Parser (Selection RAW)
parseSelection =
      String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Selection" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$
        Parser (Selection RAW) -> Parser (Selection RAW)
forall a.
ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser (Selection RAW)
inlineFragment
          Parser (Selection RAW)
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a.
ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Selection RAW)
spread
          Parser (Selection RAW)
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a.
ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Selection RAW)
parseSelectionField

-- Fields: https://graphql.github.io/graphql-spec/June2018/#sec-Language.Fields
--
-- Field
-- Alias(opt) Name Arguments(opt) Directives(opt) SelectionSet(opt)
--
parseSelectionField :: Parser (Selection RAW)
parseSelectionField :: Parser (Selection RAW)
parseSelectionField =
  String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"SelectionField" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$
    Position
-> Maybe FieldName
-> FieldName
-> Arguments RAW
-> Directives RAW
-> SelectionContent RAW
-> Maybe FragmentName
-> Selection RAW
forall (s :: Stage).
Position
-> Maybe FieldName
-> FieldName
-> Arguments s
-> Directives s
-> SelectionContent s
-> Maybe FragmentName
-> Selection s
Selection
      (Position
 -> Maybe FieldName
 -> FieldName
 -> Arguments RAW
 -> Directives RAW
 -> SelectionContent RAW
 -> Maybe FragmentName
 -> Selection RAW)
-> ParsecT Void ByteString GQLResult Position
-> ParsecT
     Void
     ByteString
     GQLResult
     (Maybe FieldName
      -> FieldName
      -> Arguments RAW
      -> Directives RAW
      -> SelectionContent RAW
      -> Maybe FragmentName
      -> Selection RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void ByteString GQLResult Position
getLocation
      ParsecT
  Void
  ByteString
  GQLResult
  (Maybe FieldName
   -> FieldName
   -> Arguments RAW
   -> Directives RAW
   -> SelectionContent RAW
   -> Maybe FragmentName
   -> Selection RAW)
-> ParsecT Void ByteString GQLResult (Maybe FieldName)
-> ParsecT
     Void
     ByteString
     GQLResult
     (FieldName
      -> Arguments RAW
      -> Directives RAW
      -> SelectionContent RAW
      -> Maybe FragmentName
      -> Selection RAW)
forall a b.
ParsecT Void ByteString GQLResult (a -> b)
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString GQLResult (Maybe FieldName)
parseAlias
      ParsecT
  Void
  ByteString
  GQLResult
  (FieldName
   -> Arguments RAW
   -> Directives RAW
   -> SelectionContent RAW
   -> Maybe FragmentName
   -> Selection RAW)
-> ParsecT Void ByteString GQLResult FieldName
-> ParsecT
     Void
     ByteString
     GQLResult
     (Arguments RAW
      -> Directives RAW
      -> SelectionContent RAW
      -> Maybe FragmentName
      -> Selection RAW)
forall a b.
ParsecT Void ByteString GQLResult (a -> b)
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString GQLResult FieldName
forall (t :: NAME). Parser (Name t)
parseName
      ParsecT
  Void
  ByteString
  GQLResult
  (Arguments RAW
   -> Directives RAW
   -> SelectionContent RAW
   -> Maybe FragmentName
   -> Selection RAW)
-> ParsecT Void ByteString GQLResult (Arguments RAW)
-> ParsecT
     Void
     ByteString
     GQLResult
     (Directives RAW
      -> SelectionContent RAW -> Maybe FragmentName -> Selection RAW)
forall a b.
ParsecT Void ByteString GQLResult (a -> b)
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString GQLResult (Arguments RAW)
forall (s :: Stage). Parse (Value s) => Parser (Arguments s)
maybeArguments
      ParsecT
  Void
  ByteString
  GQLResult
  (Directives RAW
   -> SelectionContent RAW -> Maybe FragmentName -> Selection RAW)
-> ParsecT Void ByteString GQLResult (Directives RAW)
-> ParsecT
     Void
     ByteString
     GQLResult
     (SelectionContent RAW -> Maybe FragmentName -> Selection RAW)
forall a b.
ParsecT Void ByteString GQLResult (a -> b)
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString GQLResult (Directives RAW)
forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
      ParsecT
  Void
  ByteString
  GQLResult
  (SelectionContent RAW -> Maybe FragmentName -> Selection RAW)
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
-> ParsecT
     Void ByteString GQLResult (Maybe FragmentName -> Selection RAW)
forall a b.
ParsecT Void ByteString GQLResult (a -> b)
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void ByteString GQLResult (SelectionContent RAW)
parseSelectionContent
      ParsecT
  Void ByteString GQLResult (Maybe FragmentName -> Selection RAW)
-> ParsecT Void ByteString GQLResult (Maybe FragmentName)
-> Parser (Selection RAW)
forall a b.
ParsecT Void ByteString GQLResult (a -> b)
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe FragmentName
-> ParsecT Void ByteString GQLResult (Maybe FragmentName)
forall a. a -> ParsecT Void ByteString GQLResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FragmentName
forall a. Maybe a
forall (f :: * -> *) a. Alternative f => f a
empty

parseSelectionContent :: Parser (SelectionContent RAW)
parseSelectionContent :: ParsecT Void ByteString GQLResult (SelectionContent RAW)
parseSelectionContent =
  String
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"SelectionContent" (ParsecT Void ByteString GQLResult (SelectionContent RAW)
 -> ParsecT Void ByteString GQLResult (SelectionContent RAW))
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
forall a b. (a -> b) -> a -> b
$
    MergeMap 'True FieldName (Selection RAW) -> SelectionContent RAW
SelectionSet RAW -> SelectionContent RAW
forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet (MergeMap 'True FieldName (Selection RAW) -> SelectionContent RAW)
-> Parser (MergeMap 'True FieldName (Selection RAW))
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (MergeMap 'True FieldName (Selection RAW))
Parser (SelectionSet RAW)
parseSelectionSet
      ParsecT Void ByteString GQLResult (SelectionContent RAW)
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
forall a.
ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SelectionContent RAW
-> ParsecT Void ByteString GQLResult (SelectionContent RAW)
forall a. a -> ParsecT Void ByteString GQLResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SelectionContent RAW
forall (s :: Stage). SelectionContent s
SelectionField

--
-- Fragments: https://graphql.github.io/graphql-spec/June2018/#sec-Language.Fragments
--
--  FragmentName : Name
--

--  FragmentSpread
--    ...FragmentName Directives(opt)
--
spread :: Parser (Selection RAW)
spread :: Parser (Selection RAW)
spread = String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FragmentSpread" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$ do
  Position
refPosition <- ParsecT Void ByteString GQLResult Position
spreadLiteral
  FragmentName
refName <- Parser FragmentName
forall (t :: NAME). Parser (Name t)
parseName
  Directives RAW
directives <- ParsecT Void ByteString GQLResult (Directives RAW)
forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
  Selection RAW -> Parser (Selection RAW)
forall a. a -> ParsecT Void ByteString GQLResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Selection RAW -> Parser (Selection RAW))
-> Selection RAW -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$ Directives RAW -> Ref FragmentName -> Selection RAW
Spread Directives RAW
directives Ref {Position
FragmentName
refPosition :: Position
refName :: FragmentName
refName :: FragmentName
refPosition :: Position
..}

-- FragmentDefinition : https://graphql.github.io/graphql-spec/June2018/#FragmentDefinition
--
--  FragmentDefinition:
--   fragment FragmentName TypeCondition Directives(opt) SelectionSet
--
parseFragmentDefinition :: Parser (Fragment RAW)
parseFragmentDefinition :: Parser (Fragment RAW)
parseFragmentDefinition = String -> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"Fragment" (Parser (Fragment RAW) -> Parser (Fragment RAW))
-> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall a b. (a -> b) -> a -> b
$ do
  ByteString -> Parser ()
keyword ByteString
"fragment"
  Position
fragmentPosition <- ParsecT Void ByteString GQLResult Position
getLocation
  FragmentName
fragmentName <- Parser FragmentName
forall (t :: NAME). Parser (Name t)
parseName
  FragmentName -> Position -> Parser (Fragment RAW)
fragmentBody FragmentName
fragmentName Position
fragmentPosition

-- Inline Fragments : https://graphql.github.io/graphql-spec/June2018/#sec-Inline-Fragments
--
--  InlineFragment:
--  ... TypeCondition(opt) Directives(opt) SelectionSet
--
inlineFragment :: Parser (Selection RAW)
inlineFragment :: Parser (Selection RAW)
inlineFragment = String -> Parser (Selection RAW) -> Parser (Selection RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"InlineFragment" (Parser (Selection RAW) -> Parser (Selection RAW))
-> Parser (Selection RAW) -> Parser (Selection RAW)
forall a b. (a -> b) -> a -> b
$ do
  Position
fragmentPosition <- ParsecT Void ByteString GQLResult Position
spreadLiteral
  Fragment RAW -> Selection RAW
InlineFragment (Fragment RAW -> Selection RAW)
-> Parser (Fragment RAW) -> Parser (Selection RAW)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FragmentName -> Position -> Parser (Fragment RAW)
fragmentBody FragmentName
"INLINE_FRAGMENT" Position
fragmentPosition

fragmentBody :: FragmentName -> Position -> Parser (Fragment RAW)
fragmentBody :: FragmentName -> Position -> Parser (Fragment RAW)
fragmentBody FragmentName
fragmentName Position
fragmentPosition = String -> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall a.
String
-> ParsecT Void ByteString GQLResult a
-> ParsecT Void ByteString GQLResult a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"FragmentBody" (Parser (Fragment RAW) -> Parser (Fragment RAW))
-> Parser (Fragment RAW) -> Parser (Fragment RAW)
forall a b. (a -> b) -> a -> b
$ do
  TypeName
fragmentType <- Parser TypeName
parseTypeCondition
  Directives RAW
fragmentDirectives <- ParsecT Void ByteString GQLResult (Directives RAW)
forall (s :: Stage). Parse (Value s) => Parser (Directives s)
optionalDirectives
  MergeMap 'True FieldName (Selection RAW)
fragmentSelection <- Parser (MergeMap 'True FieldName (Selection RAW))
Parser (SelectionSet RAW)
parseSelectionSet
  Fragment RAW -> Parser (Fragment RAW)
forall a. a -> ParsecT Void ByteString GQLResult a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fragment RAW -> Parser (Fragment RAW))
-> Fragment RAW -> Parser (Fragment RAW)
forall a b. (a -> b) -> a -> b
$ Fragment {MergeMap 'True FieldName (Selection RAW)
SelectionSet RAW
Directives RAW
Position
TypeName
FragmentName
fragmentName :: FragmentName
fragmentPosition :: Position
fragmentType :: TypeName
fragmentDirectives :: Directives RAW
fragmentSelection :: MergeMap 'True FieldName (Selection RAW)
fragmentName :: FragmentName
fragmentType :: TypeName
fragmentPosition :: Position
fragmentSelection :: SelectionSet RAW
fragmentDirectives :: Directives RAW
..}