{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
module Aeson.Match.QQ.Internal.Parse
  ( parse
  ) where

import           Control.Applicative ((<|>), optional)
import qualified Data.Aeson.Parser as Aeson
import qualified Data.ByteString as ByteString
-- cannot use .Text here due to .Aeson parsers being tied to .ByteString
import qualified Data.Attoparsec.ByteString as Atto
import           Data.Bool (bool)
import           Data.ByteString (ByteString)
import qualified Data.Char as Char
import           Data.Foldable (asum)
import qualified Data.HashMap.Strict as HashMap
import           Data.Maybe (isJust)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Vector as Vector
import           Data.Word (Word8)
import           Language.Haskell.Meta.Parse (parseExp)
import           Language.Haskell.TH (Exp(..))
import           Prelude hiding (any, null)

import           Aeson.Match.QQ.Internal.Value (Value(..), Box(..), TypeSig(..), Type(..), Nullable(..))


parse :: ByteString -> Either String (Value Exp)
parse :: ByteString -> Either String (Value Exp)
parse =
  Parser (Value Exp) -> ByteString -> Either String (Value Exp)
forall a. Parser a -> ByteString -> Either String a
Atto.parseOnly Parser (Value Exp)
value

value :: Atto.Parser (Value Exp)
value :: Parser (Value Exp)
value = do
  Parser ()
spaces
  Word8
b <- Parser Word8
Atto.peekWord8'
  case Word8
b of
    Word8
AnyP ->
      Parser (Value Exp)
any
    Word8
NP ->
      Parser (Value Exp)
null
    Word8
FP ->
      Parser (Value Exp)
false
    Word8
TP ->
      Parser (Value Exp)
true
    Word8
DoubleQuoteP ->
      Parser (Value Exp)
string
    Word8
OpenSquareBracketP ->
      Parser (Value Exp)
array
    Word8
OpenCurlyBracketP ->
      Parser (Value Exp)
object
    Word8
HashP ->
      Parser (Value Exp)
haskellExp
    Word8
_ | Word8 -> Bool
startOfNumber Word8
b ->
        Parser (Value Exp)
number
      | Bool
otherwise ->
        String -> Parser (Value Exp)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"a value cannot start with " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
b)
 where
  startOfNumber :: Word8 -> Bool
startOfNumber Word8
b =
    Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
ZeroP Bool -> Bool -> Bool
&& Word8
b Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
NineP Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
MinusP

any :: Atto.Parser (Value Exp)
any :: Parser (Value Exp)
any = do
  Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
AnyP
  Maybe Text
name <- (Text -> Maybe Text)
-> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Maybe Text
forall a. a -> Maybe a
Just Parser ByteString Text
key Parser ByteString (Maybe Text)
-> Parser ByteString (Maybe Text) -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
  Parser ()
spaces
  Maybe TypeSig
expectedType <- Parser ByteString TypeSig -> Parser ByteString (Maybe TypeSig)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser ByteString TypeSig
typeSig
  Value Exp -> Parser (Value Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TypeSig -> Maybe Text -> Value Exp
forall ext. Maybe TypeSig -> Maybe Text -> Value ext
Any Maybe TypeSig
expectedType Maybe Text
name)

null :: Atto.Parser (Value Exp)
null :: Parser (Value Exp)
null =
  Value Exp
forall ext. Value ext
Null Value Exp -> Parser ByteString ByteString -> Parser (Value Exp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
Atto.string ByteString
"null"

false :: Atto.Parser (Value Exp)
false :: Parser (Value Exp)
false =
  Bool -> Value Exp
forall ext. Bool -> Value ext
Bool Bool
False Value Exp -> Parser ByteString ByteString -> Parser (Value Exp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
Atto.string ByteString
"false"

true :: Atto.Parser (Value Exp)
true :: Parser (Value Exp)
true =
  Bool -> Value Exp
forall ext. Bool -> Value ext
Bool Bool
True Value Exp -> Parser ByteString ByteString -> Parser (Value Exp)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
Atto.string ByteString
"true"

number :: Atto.Parser (Value Exp)
number :: Parser (Value Exp)
number =
  (Scientific -> Value Exp)
-> Parser ByteString Scientific -> Parser (Value Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Scientific -> Value Exp
forall ext. Scientific -> Value ext
Number Parser ByteString Scientific
Aeson.scientific

string :: Atto.Parser (Value Exp)
string :: Parser (Value Exp)
string =
  (Text -> Value Exp) -> Parser ByteString Text -> Parser (Value Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Value Exp
forall ext. Text -> Value ext
String Parser ByteString Text
Aeson.jstring

array :: Atto.Parser (Value Exp)
array :: Parser (Value Exp)
array = do
  Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
OpenSquareBracketP
  Parser ()
spaces
  Word8
b <- Parser Word8
Atto.peekWord8'
  case Word8
b of
    Word8
CloseSquareBracketP -> do
      Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
CloseSquareBracketP
      Value Exp -> Parser (Value Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Array Exp -> Value Exp
forall ext. Array ext -> Value ext
Array Box :: forall a. a -> Bool -> Box a
Box {knownValues :: Vector (Value Exp)
knownValues = Vector (Value Exp)
forall a. Vector a
Vector.empty, extendable :: Bool
extendable = Bool
False})
    Word8
_ -> do
      [Value Exp] -> Int -> Parser (Value Exp)
loop [] Int
0
 where
  loop :: [Value Exp] -> Int -> Parser (Value Exp)
loop [Value Exp]
values !Int
n = do
    Value Exp
val <- Parser (Value Exp)
value
    Parser ()
spaces
    Word8
b <- (Word8 -> Bool) -> Parser Word8
Atto.satisfy (\Word8
w -> Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CommaP Bool -> Bool -> Bool
|| Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CloseSquareBracketP) Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
Atto.<?> String
"',' or ']'"
    case Word8
b of
      Word8
CommaP -> do
        Parser ()
spaces
        Word8
b' <- Parser Word8
Atto.peekWord8'
        case Word8
b' of
          Word8
DotP -> do
            Parser ()
rest
            Parser ()
spaces
            Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
CloseSquareBracketP
            Value Exp -> Parser (Value Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Exp -> Parser (Value Exp))
-> Value Exp -> Parser (Value Exp)
forall a b. (a -> b) -> a -> b
$ Array Exp -> Value Exp
forall ext. Array ext -> Value ext
Array Box :: forall a. a -> Bool -> Box a
Box
              { knownValues :: Vector (Value Exp)
knownValues = Int -> [Value Exp] -> Vector (Value Exp)
forall a. Int -> [a] -> Vector a
Vector.fromListN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Value Exp] -> [Value Exp]
forall a. [a] -> [a]
reverse (Value Exp
val Value Exp -> [Value Exp] -> [Value Exp]
forall a. a -> [a] -> [a]
: [Value Exp]
values))
              , extendable :: Bool
extendable = Bool
True
              }
          Word8
_ ->
            [Value Exp] -> Int -> Parser (Value Exp)
loop (Value Exp
val Value Exp -> [Value Exp] -> [Value Exp]
forall a. a -> [a] -> [a]
: [Value Exp]
values) (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      Word8
CloseSquareBracketP ->
        Value Exp -> Parser (Value Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Exp -> Parser (Value Exp))
-> Value Exp -> Parser (Value Exp)
forall a b. (a -> b) -> a -> b
$ Array Exp -> Value Exp
forall ext. Array ext -> Value ext
Array Box :: forall a. a -> Bool -> Box a
Box
          { knownValues :: Vector (Value Exp)
knownValues = Int -> [Value Exp] -> Vector (Value Exp)
forall a. Int -> [a] -> Vector a
Vector.fromListN (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) ([Value Exp] -> [Value Exp]
forall a. [a] -> [a]
reverse (Value Exp
val Value Exp -> [Value Exp] -> [Value Exp]
forall a. a -> [a] -> [a]
: [Value Exp]
values))
          , extendable :: Bool
extendable = Bool
False
          }
      Word8
_ ->
        String -> Parser (Value Exp)
forall a. HasCallStack => String -> a
error String
"impossible"

object :: Atto.Parser (Value Exp)
object :: Parser (Value Exp)
object = do
  Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
OpenCurlyBracketP
  Parser ()
spaces
  Word8
b <- Parser Word8
Atto.peekWord8'
  case Word8
b of
    Word8
CloseCurlyBracketP -> do
      Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
CloseCurlyBracketP
      Value Exp -> Parser (Value Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Object Exp -> Value Exp
forall ext. Object ext -> Value ext
Object Box :: forall a. a -> Bool -> Box a
Box {knownValues :: HashMap Text (Value Exp)
knownValues = HashMap Text (Value Exp)
forall k v. HashMap k v
HashMap.empty, extendable :: Bool
extendable = Bool
False})
    Word8
_ ->
      [(Text, Value Exp)] -> Parser (Value Exp)
loop []
 where
  loop :: [(Text, Value Exp)] -> Parser (Value Exp)
loop [(Text, Value Exp)]
values = do
    Text
k <- Parser ByteString Text
key
    Parser ()
spaces
    Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
ColonP
    Parser ()
spaces
    Value Exp
val <- Parser (Value Exp)
value
    Parser ()
spaces
    Word8
b <- (Word8 -> Bool) -> Parser Word8
Atto.satisfy (\Word8
b -> Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CommaP Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CloseCurlyBracketP) Parser Word8 -> String -> Parser Word8
forall i a. Parser i a -> String -> Parser i a
Atto.<?> String
"',' or '}'"
    case Word8
b of
      Word8
CommaP -> do
        Parser ()
spaces
        Word8
b' <- Parser Word8
Atto.peekWord8'
        case Word8
b' of
          Word8
DotP -> do
            Parser ()
rest
            Parser ()
spaces
            Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
CloseCurlyBracketP
            Value Exp -> Parser (Value Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Exp -> Parser (Value Exp))
-> Value Exp -> Parser (Value Exp)
forall a b. (a -> b) -> a -> b
$ Object Exp -> Value Exp
forall ext. Object ext -> Value ext
Object Box :: forall a. a -> Bool -> Box a
Box
              { knownValues :: HashMap Text (Value Exp)
knownValues = [(Text, Value Exp)] -> HashMap Text (Value Exp)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ((Text
k, Value Exp
val) (Text, Value Exp) -> [(Text, Value Exp)] -> [(Text, Value Exp)]
forall a. a -> [a] -> [a]
: [(Text, Value Exp)]
values)
              , extendable :: Bool
extendable = Bool
True
              }
          Word8
_ ->
            [(Text, Value Exp)] -> Parser (Value Exp)
loop ((Text
k, Value Exp
val) (Text, Value Exp) -> [(Text, Value Exp)] -> [(Text, Value Exp)]
forall a. a -> [a] -> [a]
: [(Text, Value Exp)]
values)
      Word8
CloseCurlyBracketP ->
        Value Exp -> Parser (Value Exp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value Exp -> Parser (Value Exp))
-> Value Exp -> Parser (Value Exp)
forall a b. (a -> b) -> a -> b
$ Object Exp -> Value Exp
forall ext. Object ext -> Value ext
Object Box :: forall a. a -> Bool -> Box a
Box
          { knownValues :: HashMap Text (Value Exp)
knownValues = [(Text, Value Exp)] -> HashMap Text (Value Exp)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ((Text
k, Value Exp
val) (Text, Value Exp) -> [(Text, Value Exp)] -> [(Text, Value Exp)]
forall a. a -> [a] -> [a]
: [(Text, Value Exp)]
values)
          , extendable :: Bool
extendable = Bool
False
          }
      Word8
_ ->
        String -> Parser (Value Exp)
forall a. HasCallStack => String -> a
error String
"impossible"

key :: Atto.Parser Text
key :: Parser ByteString Text
key =
  Parser ByteString Text
Aeson.jstring Parser ByteString Text
-> Parser ByteString Text -> Parser ByteString Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    ([Word8] -> Text)
-> Parser ByteString [Word8] -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> ([Word8] -> ByteString) -> [Word8] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
ByteString.pack) (Parser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
Atto.many1 ((Word8 -> Bool) -> Parser Word8
Atto.satisfy (\Word8
c -> Int -> Char
Char.chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c) Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
"\\ \":;><${}[]," :: String))))

rest :: Atto.Parser ()
rest :: Parser ()
rest =
  () () -> Parser ByteString ByteString -> Parser ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ByteString -> Parser ByteString ByteString
Atto.string ByteString
"..."

haskellExp :: Atto.Parser (Value Exp)
haskellExp :: Parser (Value Exp)
haskellExp =
  (Exp -> Value Exp) -> Parser ByteString Exp -> Parser (Value Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Value Exp
forall ext. ext -> Value ext
Ext (ByteString -> Parser ByteString ByteString
Atto.string ByteString
"#{" Parser ByteString ByteString
-> Parser ByteString Exp -> Parser ByteString Exp
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Exp
go)
 where
  go :: Parser ByteString Exp
go = do
    ByteString
str <- (Word8 -> Bool) -> Parser ByteString ByteString
Atto.takeWhile1 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
CloseCurlyBracketP) Parser ByteString ByteString
-> Parser Word8 -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Word8 -> Parser Word8
Atto.word8 Word8
CloseCurlyBracketP
    (String -> Parser ByteString Exp)
-> (Exp -> Parser ByteString Exp)
-> Either String Exp
-> Parser ByteString Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser ByteString Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail Exp -> Parser ByteString Exp
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String Exp
parseExp (Text -> String
Text.unpack (ByteString -> Text
Text.decodeUtf8 ByteString
str)))

typeSig :: Atto.Parser TypeSig
typeSig :: Parser ByteString TypeSig
typeSig = do
  Word8
_ <- Word8 -> Parser Word8
Atto.word8 Word8
ColonP
  Parser ()
spaces
  [Parser ByteString TypeSig] -> Parser ByteString TypeSig
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ ByteString -> Type -> Parser ByteString TypeSig
p ByteString
"bool" Type
BoolT
    , ByteString -> Type -> Parser ByteString TypeSig
p ByteString
"number" Type
NumberT
    , ByteString -> Type -> Parser ByteString TypeSig
p ByteString
"string" Type
StringT
    , ByteString -> Type -> Parser ByteString TypeSig
p ByteString
"array" Type
ArrayT
    , ByteString -> Type -> Parser ByteString TypeSig
p ByteString
"object" Type
ObjectT
    ]
 where
  p :: ByteString -> Type -> Parser ByteString TypeSig
p ByteString
name Type
typeName = do
    ByteString
_ <- ByteString -> Parser ByteString ByteString
Atto.string ByteString
name
    Maybe Word8
q <- Parser Word8 -> Parser ByteString (Maybe Word8)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Word8 -> Parser Word8
Atto.word8 Word8
QuestionMarkP)
    TypeSig -> Parser ByteString TypeSig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Nullable -> TypeSig
TypeSig Type
typeName (Nullable -> Nullable -> Bool -> Nullable
forall a. a -> a -> Bool -> a
bool Nullable
NonNullable Nullable
Nullable (Maybe Word8 -> Bool
forall a. Maybe a -> Bool
isJust Maybe Word8
q)))

-- This function has been stolen from aeson.
-- ref: https://hackage.haskell.org/package/aeson-1.4.6.0/docs/src/Data.Aeson.Parser.Internal.html#skipSpace
spaces :: Atto.Parser ()
spaces :: Parser ()
spaces =
  (Word8 -> Bool) -> Parser ()
Atto.skipWhile (\Word8
b -> Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
SpaceP Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
NewLineP Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
CRP Bool -> Bool -> Bool
|| Word8
b Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
TabP)
{-# INLINE spaces #-}

pattern AnyP, NP, FP, TP, DoubleQuoteP, DotP, CommaP, HashP :: Word8
pattern $bAnyP :: Word8
$mAnyP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
AnyP = 95 -- '_'
pattern $bNP :: Word8
$mNP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
NP = 110 -- 'n'
pattern $bFP :: Word8
$mFP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
FP = 102 -- 'f'
pattern $bTP :: Word8
$mTP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
TP = 116 -- 't'
pattern $bDoubleQuoteP :: Word8
$mDoubleQuoteP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
DoubleQuoteP = 34 -- '"'
pattern $bCommaP :: Word8
$mCommaP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
CommaP = 44 -- ','
pattern $bDotP :: Word8
$mDotP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
DotP = 46 -- '.'
pattern $bHashP :: Word8
$mHashP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
HashP = 35 -- '#'

pattern OpenSquareBracketP, CloseSquareBracketP :: Word8
pattern $bOpenSquareBracketP :: Word8
$mOpenSquareBracketP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
OpenSquareBracketP = 91 -- '['
pattern $bCloseSquareBracketP :: Word8
$mCloseSquareBracketP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
CloseSquareBracketP = 93 -- ']'

pattern OpenCurlyBracketP, CloseCurlyBracketP, ColonP :: Word8
pattern $bOpenCurlyBracketP :: Word8
$mOpenCurlyBracketP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
OpenCurlyBracketP = 123 -- '{'
pattern $bCloseCurlyBracketP :: Word8
$mCloseCurlyBracketP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
CloseCurlyBracketP = 125 -- '}'
pattern $bColonP :: Word8
$mColonP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
ColonP = 58 -- ':'

pattern ZeroP, NineP, MinusP :: Word8
pattern $bZeroP :: Word8
$mZeroP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
ZeroP = 48 -- '0'
pattern $bNineP :: Word8
$mNineP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
NineP = 57 -- '9'
pattern $bMinusP :: Word8
$mMinusP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
MinusP = 45 -- '-'

pattern SpaceP, NewLineP, CRP, TabP :: Word8
pattern $bSpaceP :: Word8
$mSpaceP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
SpaceP = 0x20
pattern $bNewLineP :: Word8
$mNewLineP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
NewLineP = 0x0a
pattern $bCRP :: Word8
$mCRP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
CRP = 0x0d
pattern $bTabP :: Word8
$mTabP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
TabP = 0x09

pattern QuestionMarkP :: Word8
pattern $bQuestionMarkP :: Word8
$mQuestionMarkP :: forall r. Word8 -> (Void# -> r) -> (Void# -> r) -> r
QuestionMarkP = 63 -- '?'