{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-overflowed-literals #-}
module Data.Morpheus.Parsing.Internal.SourceText
( parseStringBS,
ignoredTokens,
ignoredTokens1,
)
where
import Data.ByteString.Lazy.Internal
( ByteString,
)
import Data.Morpheus.Parsing.Internal.Internal
( Parser,
)
import Relude hiding (ByteString, empty, many)
import Text.Megaparsec
( choice,
label,
many,
satisfy,
takeWhile1P,
takeWhileP,
unexpected,
)
import Text.Megaparsec.Byte
( char,
space1,
string,
)
import Text.Megaparsec.Error
( ErrorItem (..),
)
#define TABULATION 0x0009
#define NEW_LINE 0x000A
#define SPACE 0x0020
#define CARRIAGE_RETURN 0x000D
#define UNICODE_BOM 0xFEFF
#define NON_CHARACTER 0xFFFF
#define DOUBLE_QUOTE 34
#define BACKSLASH 92
#define COMMA 44
#define HASH_TAG 35
#define CHAR_b 98
#define CHAR_f 102
#define CHAR_n 110
#define CHAR_r 114
#define CHAR_t 116
isSourceCharacter :: Word8 -> Bool
isSourceCharacter :: Word8 -> Bool
isSourceCharacter TABULATION = True
isSourceCharacter NEW_LINE = True
isSourceCharacter CARRIAGE_RETURN = True
isSourceCharacter Word8
x = SPACE <= x && x <= NON_CHARACTER
{-# INLINE isSourceCharacter #-}
inlineString :: Parser ByteString
inlineString :: Parser ByteString
inlineString =
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"String" forall a b. (a -> b) -> a -> b
$
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char DOUBLE_QUOTE
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
parseContent
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
{-# INLINE inlineString #-}
parseContent :: Parser ByteString
parseContent :: Parser ByteString
parseContent = do
ByteString
xs <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token ByteString
x -> Word8 -> Bool
isSourceCharacter Token ByteString
x Bool -> Bool -> Bool
&& DOUBLE_QUOTE /= x && x /= BACKSLASH && NEW_LINE /= x)
Token ByteString
z <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (forall a b. a -> b -> a
const Bool
True)
case Token ByteString
z of
DOUBLE_QUOTE -> pure xs
BACKSLASH -> (xs <>) <$> ((<>) <$> escapeChar <*> parseContent)
Token ByteString
w -> forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
unexpected (forall t. NonEmpty t -> ErrorItem t
Tokens (Token ByteString
w forall a. a -> [a] -> NonEmpty a
:| []))
where
escapeChar :: Parser ByteString
escapeChar :: Parser ByteString
escapeChar =
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
[ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char CHAR_b $> "\b",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char CHAR_f $> "\f",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char CHAR_n $> "\n",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char CHAR_r $> "\r",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char CHAR_t $> "\t",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char BACKSLASH $> "\\",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char DOUBLE_QUOTE $> "\"",
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char Token ByteString
47 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ByteString
"/"
]
{-# INLINE escapeChar #-}
{-# INLINE parseContent #-}
blockString :: Parser ByteString
blockString :: Parser ByteString
blockString = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens ByteString
"\"\"\"" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString
content forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ignoredTokens
where
content :: Parser ByteString
content :: Parser ByteString
content = do
ByteString
text <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token ByteString
x -> Word8 -> Bool
isSourceCharacter Token ByteString
x Bool -> Bool -> Bool
&& Token ByteString
x forall a. Eq a => a -> a -> Bool
/= DOUBLE_QUOTE)
ByteString
doubleQuotes <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
== DOUBLE_QUOTE)
case ByteString
doubleQuotes of
ByteString
"\"\"\"" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
text
ByteString
_ -> ((ByteString
text forall a. Semigroup a => a -> a -> a
<> ByteString
doubleQuotes) forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
content
{-# INLINE content #-}
{-# INLINE blockString #-}
parseStringBS :: Parser ByteString
parseStringBS :: Parser ByteString
parseStringBS = Parser ByteString
blockString forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString
inlineString
{-# INLINE parseStringBS #-}
ignoredTokens :: Parser ()
ignoredTokens :: Parser ()
ignoredTokens = forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
label String
"IgnoredTokens" forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser ()
ignored forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
{-# INLINE ignoredTokens #-}
ignored :: Parser ()
ignored :: Parser ()
ignored = (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing forall {a}. (Ord a, Num a) => a -> Bool
isIgnored forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT MyError ByteString GQLResult (Tokens ByteString)
comment) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
where
isIgnored :: a -> Bool
isIgnored a
x =
(a
x forall a. Ord a => a -> a -> Bool
>= TABULATION && x <= CARRIAGE_RETURN)
Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== SPACE
Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== COMMA
Bool -> Bool -> Bool
|| a
x forall a. Eq a => a -> a -> Bool
== UNICODE_BOM
{-# INLINE isIgnored #-}
comment :: ParsecT MyError ByteString GQLResult (Tokens ByteString)
comment = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
Token s -> m (Token s)
char HASH_TAG *> takeWhileP Nothing (\x -> isSourceCharacter x && x /= NEW_LINE)
{-# INLINE comment #-}
{-# INLINE ignored #-}
ignoredTokens1 :: Parser ()
ignoredTokens1 :: Parser ()
ignoredTokens1 = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Word8) =>
m ()
space1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ignoredTokens
{-# INLINE ignoredTokens1 #-}