{-# 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 (..),
  )

-- White Space
#define TABULATION 0x0009
#define NEW_LINE 0x000A
#define SPACE 0x0020
#define CARRIAGE_RETURN 0x000D
#define UNICODE_BOM 0xFEFF
#define NON_CHARACTER 0xFFFF

-- Non-alphabetic characters
#define DOUBLE_QUOTE 34
#define BACKSLASH 92
#define COMMA 44
#define HASH_TAG 35

-- Alphabetic characters
#define CHAR_b 98
#define CHAR_f 102
#define CHAR_n 110
#define CHAR_r 114
#define CHAR_t 116

-- https://spec.graphql.org/June2018/#sec-Source-Text
-- SourceCharacter : [\u0009\u000A\u000D\u0020-\uFFFF]/
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 #-}

-- Ignored Tokens : https://graphql.github.io/graphql-spec/June2018/#sec-Source-Text.Ignored-Tokens
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 #-}

-- isIgnored :: UnicodeBOM, WhiteSpace, LineTerminator, Comment , Comma
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 #-}