module Miso.GraphQL.Lexer where

import Control.Applicative (Alternative (many, some), optional, (<|>))
import Control.Monad (guard, replicateM)
import Data.Foldable (Foldable (fold, toList))
import Data.Functor (void)
import Data.Ix (Ix (inRange))
import Data.Maybe (catMaybes, isJust)
import GHC.Generics (Generic)
import Miso.GraphQL.AST
import Miso.Prelude
import Miso.String qualified as MisoString
import Miso.Util.Lexer hiding (token)

lex :: Lexer a -> MisoString -> Either LexerError a
lex :: forall a. Lexer a -> MisoString -> Either LexerError a
lex Lexer a
lexer = ((a, Stream) -> a)
-> Either LexerError (a, Stream) -> Either LexerError a
forall a b. (a -> b) -> Either LexerError a -> Either LexerError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, Stream) -> a
forall a b. (a, b) -> a
fst (Either LexerError (a, Stream) -> Either LexerError a)
-> (MisoString -> Either LexerError (a, Stream))
-> MisoString
-> Either LexerError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lexer a -> Stream -> Either LexerError (a, Stream)
forall token.
Lexer token -> Stream -> Either LexerError (token, Stream)
runLexer Lexer a
lexer (Stream -> Either LexerError (a, Stream))
-> (MisoString -> Stream)
-> MisoString
-> Either LexerError (a, Stream)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MisoString -> Stream
mkStream

-- | Token unit for lexing the GraphQL specification
-- https://spec.graphql.org/draft/#Token
data Token
    = TokenPunctuator Char
    | TokenEllipsis
    | TokenName Name
    | TokenInt Int
    | TokenFloat Double
    | TokenString StringValue
    deriving stock (Int -> Token -> ShowS
[Token] -> ShowS
Token -> [Char]
(Int -> Token -> ShowS)
-> (Token -> [Char]) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> [Char]
show :: Token -> [Char]
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, (forall x. Token -> Rep Token x)
-> (forall x. Rep Token x -> Token) -> Generic Token
forall x. Rep Token x -> Token
forall x. Token -> Rep Token x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Token -> Rep Token x
from :: forall x. Token -> Rep Token x
$cto :: forall x. Rep Token x -> Token
to :: forall x. Rep Token x -> Token
Generic)

concatM :: (Traversable t, Monad m, Monoid a) => t (m a) -> m a
concatM :: forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m a) -> m a
concatM t (m a)
xs = t a -> a
forall m. Monoid m => t m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (t a -> a) -> m (t a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (m a) -> m (t a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)
sequence t (m a)
xs

concatMaybeM :: (Traversable t, Monad m, Monoid a) => t (m (Maybe a)) -> m a
concatMaybeM :: forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m (Maybe a)) -> m a
concatMaybeM t (m (Maybe a))
xs = [a] -> a
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([a] -> a) -> (t (Maybe a) -> [a]) -> t (Maybe a) -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Maybe a] -> [a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe a] -> [a])
-> (t (Maybe a) -> [Maybe a]) -> t (Maybe a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t (Maybe a) -> [Maybe a]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (t (Maybe a) -> a) -> m (t (Maybe a)) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (m (Maybe a)) -> m (t (Maybe a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => t (m a) -> m (t a)
sequence t (m (Maybe a))
xs

inAnyRange :: (Foldable t, Ix a) => t (a, a) -> a -> Bool
inAnyRange :: forall (t :: * -> *) a. (Foldable t, Ix a) => t (a, a) -> a -> Bool
inAnyRange = (a -> t (a, a) -> Bool) -> t (a, a) -> a -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> t (a, a) -> Bool) -> t (a, a) -> a -> Bool)
-> (a -> t (a, a) -> Bool) -> t (a, a) -> a -> Bool
forall a b. (a -> b) -> a -> b
$ ((a, a) -> Bool) -> t (a, a) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (((a, a) -> Bool) -> t (a, a) -> Bool)
-> (a -> (a, a) -> Bool) -> a -> t (a, a) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((a, a) -> a -> Bool) -> a -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a, a) -> a -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange

-- | https://spec.graphql.org/draft/#SourceCharacter
sourceCharacter :: Lexer Char
sourceCharacter :: Lexer Char
sourceCharacter = (Char -> Bool) -> Lexer Char
satisfy ((Char -> Bool) -> Lexer Char) -> (Char -> Bool) -> Lexer Char
forall a b. (a -> b) -> a -> b
$ Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True

-- | https://spec.graphql.org/draft/#Letter
letter :: Lexer Char
letter :: Lexer Char
letter = (Char -> Bool) -> Lexer Char
satisfy ((Char -> Bool) -> Lexer Char) -> (Char -> Bool) -> Lexer Char
forall a b. (a -> b) -> a -> b
$ [(Char, Char)] -> Char -> Bool
forall (t :: * -> *) a. (Foldable t, Ix a) => t (a, a) -> a -> Bool
inAnyRange [(Char
'A', Char
'Z'), (Char
'a', Char
'z')]

-- | https://spec.graphql.org/draft/#Digit
digit :: Lexer Char
digit :: Lexer Char
digit = (Char -> Bool) -> Lexer Char
satisfy ((Char -> Bool) -> Lexer Char) -> (Char -> Bool) -> Lexer Char
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'0', Char
'9')

-- | https://spec.graphql.org/draft/#HexDigit
hexDigit :: Lexer Char
hexDigit :: Lexer Char
hexDigit = (Char -> Bool) -> Lexer Char
satisfy ((Char -> Bool) -> Lexer Char) -> (Char -> Bool) -> Lexer Char
forall a b. (a -> b) -> a -> b
$ [(Char, Char)] -> Char -> Bool
forall (t :: * -> *) a. (Foldable t, Ix a) => t (a, a) -> a -> Bool
inAnyRange [(Char
'0', Char
'9'), (Char
'A', Char
'F'), (Char
'a', Char
'f')]

-- | https://spec.graphql.org/draft/#NonZeroDigit
nonZeroDigit :: Lexer Char
nonZeroDigit :: Lexer Char
nonZeroDigit = (Char -> Bool) -> Lexer Char
satisfy ((Char -> Bool) -> Lexer Char) -> (Char -> Bool) -> Lexer Char
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> Char -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Char
'1', Char
'9')

-- | https://spec.graphql.org/draft/#IntegerPart
integerPart :: Lexer MisoString
integerPart :: Lexer MisoString
integerPart =
    [Lexer (Maybe MisoString)] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m (Maybe a)) -> m a
concatMaybeM
        [ Lexer MisoString -> Lexer (Maybe MisoString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Lexer MisoString -> Lexer (Maybe MisoString))
-> Lexer MisoString -> Lexer (Maybe MisoString)
forall a b. (a -> b) -> a -> b
$ MisoString -> Lexer MisoString
string MisoString
"-"
        , MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just
            (MisoString -> Maybe MisoString)
-> Lexer MisoString -> Lexer (Maybe MisoString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexer MisoString] -> Lexer MisoString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
                [ MisoString -> Lexer MisoString
string MisoString
"0"
                , [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([Char] -> MisoString) -> Lexer [Char] -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> ShowS) -> Lexer Char -> Lexer [Char] -> Lexer [Char]
forall a b c. (a -> b -> c) -> Lexer a -> Lexer b -> Lexer c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) Lexer Char
nonZeroDigit (Lexer Char -> Lexer [Char]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Lexer Char
digit)
                ]
        ]

-- | https://spec.graphql.org/draft/#IntValue
intValue :: Lexer Int
intValue :: Lexer Int
intValue = MisoString -> Int
forall a. FromMisoString a => MisoString -> a
fromMisoString (MisoString -> Int) -> Lexer MisoString -> Lexer Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer MisoString
integerPart

-- | https://spec.graphql.org/draft/#FractionalPart
fractionalPart :: Lexer MisoString
fractionalPart :: Lexer MisoString
fractionalPart =
    [Lexer MisoString] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m a) -> m a
concatM
        [ MisoString -> Lexer MisoString
string MisoString
"."
        , [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([Char] -> MisoString) -> Lexer [Char] -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char -> Lexer [Char]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Lexer Char
digit
        ]

-- | https://spec.graphql.org/draft/#ExponentIndicator
exponentIndicator :: Lexer Char
exponentIndicator :: Lexer Char
exponentIndicator = Char -> Lexer Char
char Char
'e' Lexer Char -> Lexer Char -> Lexer Char
forall a. Lexer a -> Lexer a -> Lexer a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Lexer Char
char Char
'E'

-- | https://spec.graphql.org/draft/#Sign
sign :: Lexer Char
sign :: Lexer Char
sign = Char -> Lexer Char
char Char
'+' Lexer Char -> Lexer Char -> Lexer Char
forall a. Lexer a -> Lexer a -> Lexer a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Lexer Char
char Char
'-'

-- | https://spec.graphql.org/draft/#ExponentPart
exponentPart :: Lexer MisoString
exponentPart :: Lexer MisoString
exponentPart =
    [Lexer (Maybe MisoString)] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m (Maybe a)) -> m a
concatMaybeM
        [ MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just (MisoString -> Maybe MisoString)
-> (Char -> MisoString) -> Char -> Maybe MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Char -> Maybe MisoString)
-> Lexer Char -> Lexer (Maybe MisoString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char
exponentIndicator
        , (Char -> MisoString) -> Maybe Char -> Maybe MisoString
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Maybe Char -> Maybe MisoString)
-> Lexer (Maybe Char) -> Lexer (Maybe MisoString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char -> Lexer (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Lexer Char
sign
        , MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just (MisoString -> Maybe MisoString)
-> ([Char] -> MisoString) -> [Char] -> Maybe MisoString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([Char] -> Maybe MisoString)
-> Lexer [Char] -> Lexer (Maybe MisoString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char -> Lexer [Char]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Lexer Char
digit
        ]

-- | https://spec.graphql.org/draft/#FloatValue
floatValue :: Lexer Double
floatValue :: Lexer Double
floatValue =
    MisoString -> Double
forall a. FromMisoString a => MisoString -> a
fromMisoString
        (MisoString -> Double) -> Lexer MisoString -> Lexer Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexer (Maybe MisoString)] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m (Maybe a)) -> m a
concatMaybeM
            [ MisoString -> Maybe MisoString
forall a. a -> Maybe a
Just (MisoString -> Maybe MisoString)
-> Lexer MisoString -> Lexer (Maybe MisoString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer MisoString
integerPart
            , Lexer MisoString -> Lexer (Maybe MisoString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Lexer MisoString
fractionalPart
            , Lexer MisoString -> Lexer (Maybe MisoString)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Lexer MisoString
exponentPart
            ]

-- | https://spec.graphql.org/draft/#Name
name :: Lexer Name
name :: Lexer Name
name =
    MisoString -> Name
Name
        (MisoString -> Name) -> Lexer MisoString -> Lexer Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Lexer MisoString] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m a) -> m a
concatM
            [ Char -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Char -> MisoString) -> Lexer Char -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Lexer Char
letter Lexer Char -> Lexer Char -> Lexer Char
forall a. Lexer a -> Lexer a -> Lexer a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Lexer Char
char Char
'_')
            , [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([Char] -> MisoString) -> Lexer [Char] -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char -> Lexer [Char]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Lexer Char
letter Lexer Char -> Lexer Char -> Lexer Char
forall a. Lexer a -> Lexer a -> Lexer a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Lexer Char
digit Lexer Char -> Lexer Char -> Lexer Char
forall a. Lexer a -> Lexer a -> Lexer a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Lexer Char
char Char
'_')
            ]

-- | https://spec.graphql.org/draft/#StringValue
stringValue :: Lexer StringValue
stringValue :: Lexer StringValue
stringValue =
    [Lexer StringValue] -> Lexer StringValue
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
        [ MisoString -> StringValue
BlockString (MisoString -> StringValue)
-> Lexer MisoString -> Lexer StringValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer MisoString
blockString
        , MisoString -> StringValue
SingleLineString (MisoString -> StringValue)
-> Lexer MisoString -> Lexer StringValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer MisoString
singleLineString
        ]

singleLineString :: Lexer MisoString
singleLineString :: Lexer MisoString
singleLineString = Lexer ()
delimiter Lexer () -> Lexer MisoString -> Lexer MisoString
forall a b. Lexer a -> Lexer b -> Lexer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lexer MisoString
go
  where
    delimiter :: Lexer ()
    delimiter :: Lexer ()
delimiter = Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Lexer Char -> Lexer ()) -> Lexer Char -> Lexer ()
forall a b. (a -> b) -> a -> b
$ Char -> Lexer Char
char Char
'\"'
    -- https://spec.graphql.org/draft/#EscapedCharacter
    escapedCharacter :: Lexer Char
    escapedCharacter :: Lexer Char
escapedCharacter = [Lexer Char] -> Lexer Char
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf ([Lexer Char] -> Lexer Char) -> [Lexer Char] -> Lexer Char
forall a b. (a -> b) -> a -> b
$ Char -> Lexer Char
char (Char -> Lexer Char) -> [Char] -> [Lexer Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
"\"\\/bfnrt"
    -- https://spec.graphql.org/draft/#EscapedUnicode
    escapedUnicode :: Lexer MisoString
    escapedUnicode :: Lexer MisoString
escapedUnicode =
        [Lexer MisoString] -> Lexer MisoString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
            [ [Lexer MisoString] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m a) -> m a
concatM
                [ MisoString -> Lexer MisoString
string MisoString
"{"
                , [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([Char] -> MisoString) -> Lexer [Char] -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char -> Lexer [Char]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Lexer Char
hexDigit
                , MisoString -> Lexer MisoString
string MisoString
"}"
                ]
            , [Char] -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString ([Char] -> MisoString) -> Lexer [Char] -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Lexer Char -> Lexer [Char]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Lexer Char
hexDigit
            ]
    go :: Lexer MisoString
    go :: Lexer MisoString
go =
        Lexer () -> Lexer (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Lexer ()
delimiter Lexer (Maybe ())
-> (Maybe () -> Lexer MisoString) -> Lexer MisoString
forall a b. Lexer a -> (a -> Lexer b) -> Lexer b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just ()
_ -> MisoString -> Lexer MisoString
forall a. a -> Lexer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
""
            Maybe ()
Nothing ->
                [Lexer MisoString] -> Lexer MisoString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
                    [ [Lexer MisoString] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m a) -> m a
concatM [MisoString -> Lexer MisoString
string MisoString
"\\", Char -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Char -> MisoString) -> Lexer Char -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char
escapedCharacter, Lexer MisoString
go]
                    , [Lexer MisoString] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m a) -> m a
concatM [MisoString -> Lexer MisoString
string MisoString
"\\u", Lexer MisoString
escapedUnicode, Lexer MisoString
go]
                    , (Char -> MisoString -> MisoString)
-> Lexer Char -> Lexer MisoString -> Lexer MisoString
forall a b c. (a -> b -> c) -> Lexer a -> Lexer b -> Lexer c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> MisoString -> MisoString
MisoString.cons Lexer Char
nonLineTerminator Lexer MisoString
go
                    ]

-- | https://spec.graphql.org/draft/#BlockString
blockString :: Lexer MisoString
blockString :: Lexer MisoString
blockString = Lexer ()
delimiter Lexer () -> Lexer MisoString -> Lexer MisoString
forall a b. Lexer a -> Lexer b -> Lexer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lexer MisoString
go
  where
    delimiter :: Lexer ()
    delimiter :: Lexer ()
delimiter = Lexer MisoString -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Lexer MisoString -> Lexer ()) -> Lexer MisoString -> Lexer ()
forall a b. (a -> b) -> a -> b
$ MisoString -> Lexer MisoString
string MisoString
"\"\"\""
    go :: Lexer MisoString
    go :: Lexer MisoString
go =
        Lexer () -> Lexer (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Lexer ()
delimiter Lexer (Maybe ())
-> (Maybe () -> Lexer MisoString) -> Lexer MisoString
forall a b. Lexer a -> (a -> Lexer b) -> Lexer b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just ()
_ -> MisoString -> Lexer MisoString
forall a. a -> Lexer a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MisoString
""
            Maybe ()
Nothing ->
                [Lexer MisoString] -> Lexer MisoString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
                    [ MisoString
"" MisoString -> Lexer () -> Lexer MisoString
forall a b. a -> Lexer b -> Lexer a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lexer ()
delimiter
                    , [Lexer MisoString] -> Lexer MisoString
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m, Monoid a) =>
t (m a) -> m a
concatM
                        [ Char -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Char -> MisoString) -> Lexer Char -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Lexer Char
char Char
'\\'
                        , Char -> MisoString
forall str. ToMisoString str => str -> MisoString
toMisoString (Char -> MisoString) -> Lexer Char -> Lexer MisoString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char
sourceCharacter
                        , Lexer MisoString
go
                        ]
                    , (Char -> MisoString -> MisoString)
-> Lexer Char -> Lexer MisoString -> Lexer MisoString
forall a b c. (a -> b -> c) -> Lexer a -> Lexer b -> Lexer c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> MisoString -> MisoString
MisoString.cons Lexer Char
sourceCharacter Lexer MisoString
go
                    ]

-- | https://spec.graphql.org/draft/#Punctuator
punctuator :: Lexer Char
punctuator :: Lexer Char
punctuator = [Lexer Char] -> Lexer Char
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf ([Lexer Char] -> Lexer Char) -> [Lexer Char] -> Lexer Char
forall a b. (a -> b) -> a -> b
$ Char -> Lexer Char
char (Char -> Lexer Char) -> [Char] -> [Lexer Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char]
"!$&():=@[]{|}"

ellipsis :: Lexer ()
ellipsis :: Lexer ()
ellipsis = Lexer MisoString -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Lexer MisoString -> Lexer ()) -> Lexer MisoString -> Lexer ()
forall a b. (a -> b) -> a -> b
$ MisoString -> Lexer MisoString
string MisoString
"..."

-- | https://spec.graphql.org/draft/#NullValue
-- | https://spec.graphql.org/draft/#LineTerminator
lineTerminator :: Lexer ()
lineTerminator :: Lexer ()
lineTerminator = do
    Maybe Char
r <- Lexer Char -> Lexer (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Lexer Char -> Lexer (Maybe Char))
-> (Char -> Lexer Char) -> Char -> Lexer (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Lexer Char
char (Char -> Lexer (Maybe Char)) -> Char -> Lexer (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\r'
    Maybe Char
n <- Lexer Char -> Lexer (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Lexer Char -> Lexer (Maybe Char))
-> (Char -> Lexer Char) -> Char -> Lexer (Maybe Char)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Lexer Char
char (Char -> Lexer (Maybe Char)) -> Char -> Lexer (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char
'\n'
    Bool -> Lexer ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Lexer ()) -> Bool -> Lexer ()
forall a b. (a -> b) -> a -> b
$ Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
r Bool -> Bool -> Bool
|| Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust Maybe Char
n

nonLineTerminator :: Lexer Char
nonLineTerminator :: Lexer Char
nonLineTerminator = (Char -> Bool) -> Lexer Char
satisfy ((Char -> Bool) -> Lexer Char) -> (Char -> Bool) -> Lexer Char
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'\r', Char
'\n'])

-- | https://spec.graphql.org/draft/#Comment
comment :: Lexer ()
comment :: Lexer ()
comment = Lexer [Char] -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Lexer [Char] -> Lexer ()) -> Lexer [Char] -> Lexer ()
forall a b. (a -> b) -> a -> b
$ Char -> Lexer Char
char Char
'#' Lexer Char -> Lexer [Char] -> Lexer [Char]
forall a b. Lexer a -> Lexer b -> Lexer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lexer Char -> Lexer [Char]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Lexer Char
nonLineTerminator

-- | https://spec.graphql.org/draft/#Ignored
ignored :: Lexer ()
ignored :: Lexer ()
ignored =
    [Lexer ()] -> Lexer ()
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
        [ Lexer ()
unicodeBom
        , Lexer ()
whitespace
        , Lexer ()
lineTerminator
        , Lexer ()
comment
        , Lexer ()
comma
        ]
  where
    -- https://spec.graphql.org/draft/#UnicodeBOM
    unicodeBom :: Lexer ()
unicodeBom = Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Lexer Char -> Lexer ()) -> Lexer Char -> Lexer ()
forall a b. (a -> b) -> a -> b
$ Char -> Lexer Char
char Char
'\xFEFF'
    -- https://spec.graphql.org/draft/#Whitespace
    whitespace :: Lexer ()
whitespace = Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Lexer Char -> Lexer ()) -> Lexer Char -> Lexer ()
forall a b. (a -> b) -> a -> b
$ Char -> Lexer Char
char Char
'\t' Lexer Char -> Lexer Char -> Lexer Char
forall a. Lexer a -> Lexer a -> Lexer a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Lexer Char
char Char
' '
    -- https://spec.graphql.org/draft/#Comma
    comma :: Lexer ()
comma = Lexer Char -> Lexer ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Lexer Char -> Lexer ()) -> Lexer Char -> Lexer ()
forall a b. (a -> b) -> a -> b
$ Char -> Lexer Char
char Char
','

token :: Lexer Token
token :: Lexer Token
token =
    [Lexer Token] -> Lexer Token
forall (f :: * -> *) a. Alternative f => [f a] -> f a
oneOf
        [ Char -> Token
TokenPunctuator (Char -> Token) -> Lexer Char -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Char
punctuator
        , Token
TokenEllipsis Token -> Lexer () -> Lexer Token
forall a b. a -> Lexer b -> Lexer a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Lexer ()
ellipsis
        , Int -> Token
TokenInt (Int -> Token) -> Lexer Int -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Int
intValue
        , Double -> Token
TokenFloat (Double -> Token) -> Lexer Double -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Double
floatValue
        , StringValue -> Token
TokenString (StringValue -> Token) -> Lexer StringValue -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer StringValue
stringValue
        , Name -> Token
TokenName (Name -> Token) -> Lexer Name -> Lexer Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Lexer Name
name
        ]

tokens :: Lexer [Token]
tokens :: Lexer [Token]
tokens = Lexer Token -> Lexer [Token]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Lexer Token -> Lexer [Token]) -> Lexer Token -> Lexer [Token]
forall a b. (a -> b) -> a -> b
$ Lexer () -> Lexer [()]
forall a. Lexer a -> Lexer [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Lexer ()
ignored Lexer [()] -> Lexer Token -> Lexer Token
forall a b. Lexer a -> Lexer b -> Lexer b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Lexer Token
token