{-# language OverloadedStrings #-}
{-# language ViewPatterns      #-}
module Mu.GraphQL.Quasi.LostParser (
  parseTypeSysDefinition, parseDoc
) where

import           Data.Foldable        (toList)
import qualified Data.Text            as T
import           Language.GraphQL.AST (document)
import qualified Language.GraphQL.AST as GQL
import           Text.Megaparsec      (runParser)

parseDoc :: T.Text -> Either T.Text [GQL.Definition]
parseDoc :: Text -> Either Text [Definition]
parseDoc Text
s =
  case Parsec Void Text Document
-> String -> Text -> Either (ParseErrorBundle Text Void) Document
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text Document
document String
"<doc>" Text
s of
    Right Document
d -> [Definition] -> Either Text [Definition]
forall a b. b -> Either a b
Right (Document -> [Definition]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Document
d)
    Left  ParseErrorBundle Text Void
e -> Text -> Either Text [Definition]
forall a b. a -> Either a b
Left (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show ParseErrorBundle Text Void
e)

parseTypeSysDefinition :: T.Text -> Either T.Text [GQL.TypeSystemDefinition]
parseTypeSysDefinition :: Text -> Either Text [TypeSystemDefinition]
parseTypeSysDefinition Text
s =
  case Parsec Void Text Document
-> String -> Text -> Either (ParseErrorBundle Text Void) Document
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
runParser Parsec Void Text Document
document String
"<doc>" Text
s of
    Right (Document -> [Definition]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList -> [Definition]
d)
      -> let tds :: [TypeSystemDefinition]
tds = [TypeSystemDefinition
td | GQL.TypeSystemDefinition TypeSystemDefinition
td Location
_ <- [Definition]
d]
         in if [Definition] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Definition]
d Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [TypeSystemDefinition] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeSystemDefinition]
tds
               then [TypeSystemDefinition] -> Either Text [TypeSystemDefinition]
forall a b. b -> Either a b
Right [TypeSystemDefinition]
tds
               else Text -> Either Text [TypeSystemDefinition]
forall a b. a -> Either a b
Left Text
"unexpected query or type system extension"
    Left ParseErrorBundle Text Void
e
      -> Text -> Either Text [TypeSystemDefinition]
forall a b. a -> Either a b
Left (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void -> String
forall a. Show a => a -> String
show ParseErrorBundle Text Void
e)