-- Copyright 2016 Google Inc. All Rights Reserved.
--
-- Use of this source code is governed by a BSD-style
-- license that can be found in the LICENSE file or at
-- https://developers.google.com/open-source/licenses/bsd

-- | Helper utilities to parse the human-readable text format into a
-- proto-agnostic syntax tree.
{-# LANGUAGE FlexibleContexts #-}

module Data.ProtoLens.TextFormat.Parser
    ( Message
    , Field(..)
    , Key(..)
    , Value(..)
    , parser
    ) where

import Control.Applicative ((<|>), many)
import Control.Monad (liftM, liftM2, mzero, unless)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder, char8, charUtf8, toLazyByteString, word8)
import Data.ByteString.Lazy (toStrict)
import Data.Char (digitToInt, isSpace)
import Data.Functor (($>))
import Data.Functor.Identity (Identity)
import Data.List (intercalate)
import qualified Data.Text as StrictText
import Data.Text.Lazy (Text)
import Text.Parsec ((<?>))
import Text.Parsec.Char
  (alphaNum, char, hexDigit, letter, octDigit, oneOf, satisfy)
import Text.Parsec.Text.Lazy (Parser)
import Text.Parsec.Combinator (choice, eof, many1, sepBy1)
import Text.Parsec.Token hiding (octal)

-- | A 'TokenParser' for the protobuf text format.
ptp :: GenTokenParser Text () Identity
ptp :: GenTokenParser Text () Identity
ptp = forall s (m :: * -> *) u.
Stream s m Char =>
GenLanguageDef s u m -> GenTokenParser s u m
makeTokenParser GenLanguageDef Text () Identity
protobufLangDef

protobufLangDef :: GenLanguageDef Text () Identity
-- We need to fill in the fields manually, since the LanguageDefs provided
-- by Parsec are restricted to parsers of Strings.
protobufLangDef :: GenLanguageDef Text () Identity
protobufLangDef = LanguageDef
  { commentStart :: String
commentStart = String
""
  , commentEnd :: String
commentEnd = String
""
  , commentLine :: String
commentLine = String
"#"
  , nestedComments :: Bool
nestedComments = Bool
False
  , identStart :: ParsecT Text () Identity Char
identStart = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
  , identLetter :: ParsecT Text () Identity Char
identLetter = forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_'"
  , opStart :: ParsecT Text () Identity Char
opStart = forall (m :: * -> *) a. MonadPlus m => m a
mzero
  , opLetter :: ParsecT Text () Identity Char
opLetter = forall (m :: * -> *) a. MonadPlus m => m a
mzero
  , reservedNames :: [String]
reservedNames = []
  , reservedOpNames :: [String]
reservedOpNames = []
  , caseSensitive :: Bool
caseSensitive = Bool
True
  }

type Message = [Field]

data Field = Field Key Value
  deriving (Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show,Eq Field
Field -> Field -> Bool
Field -> Field -> Ordering
Field -> Field -> Field
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Field -> Field -> Field
$cmin :: Field -> Field -> Field
max :: Field -> Field -> Field
$cmax :: Field -> Field -> Field
>= :: Field -> Field -> Bool
$c>= :: Field -> Field -> Bool
> :: Field -> Field -> Bool
$c> :: Field -> Field -> Bool
<= :: Field -> Field -> Bool
$c<= :: Field -> Field -> Bool
< :: Field -> Field -> Bool
$c< :: Field -> Field -> Bool
compare :: Field -> Field -> Ordering
$ccompare :: Field -> Field -> Ordering
Ord,Field -> Field -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq)

data Key = Key String  -- ^ A standard key that is just a string.
  | UnknownKey Integer  -- ^ A key that has been written out as a number
  | ExtensionKey [String]  -- ^ An extension, with namespaces and extension.
  | UnknownExtensionKey Integer  -- ^ An extension that has been written out
                                 -- as a number.
  deriving (Eq Key
Key -> Key -> Bool
Key -> Key -> Ordering
Key -> Key -> Key
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Key -> Key -> Key
$cmin :: Key -> Key -> Key
max :: Key -> Key -> Key
$cmax :: Key -> Key -> Key
>= :: Key -> Key -> Bool
$c>= :: Key -> Key -> Bool
> :: Key -> Key -> Bool
$c> :: Key -> Key -> Bool
<= :: Key -> Key -> Bool
$c<= :: Key -> Key -> Bool
< :: Key -> Key -> Bool
$c< :: Key -> Key -> Bool
compare :: Key -> Key -> Ordering
$ccompare :: Key -> Key -> Ordering
Ord,Key -> Key -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: Key -> Key -> Bool
Eq)

data Value = IntValue Integer  -- ^ An integer
  | DoubleValue Double  -- ^ Any floating point number
  | ByteStringValue ByteString    -- ^ A string or bytes literal
  | MessageValue (Maybe StrictText.Text) Message  -- ^ A sub message, with an optional type URI
  | EnumValue String  -- ^ Any undelimited string (including false & true)
  deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Value] -> ShowS
$cshowList :: [Value] -> ShowS
show :: Value -> String
$cshow :: Value -> String
showsPrec :: Int -> Value -> ShowS
$cshowsPrec :: Int -> Value -> ShowS
Show,Eq Value
Value -> Value -> Bool
Value -> Value -> Ordering
Value -> Value -> Value
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Value -> Value -> Value
$cmin :: Value -> Value -> Value
max :: Value -> Value -> Value
$cmax :: Value -> Value -> Value
>= :: Value -> Value -> Bool
$c>= :: Value -> Value -> Bool
> :: Value -> Value -> Bool
$c> :: Value -> Value -> Bool
<= :: Value -> Value -> Bool
$c<= :: Value -> Value -> Bool
< :: Value -> Value -> Bool
$c< :: Value -> Value -> Bool
compare :: Value -> Value -> Ordering
$ccompare :: Value -> Value -> Ordering
Ord,Value -> Value -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c== :: Value -> Value -> Bool
Eq)

instance Show Key
  where
    show :: Key -> String
show (Key String
name) = forall a. Show a => a -> String
show String
name  -- Quoting field names (i.e., `"field"` vs `field`
                                 -- leads to nicer error messages.
    show (UnknownKey Integer
k) = forall a. Show a => a -> String
show Integer
k
    show (ExtensionKey [String]
name) = String
"[" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
name forall a. [a] -> [a] -> [a]
++ String
"]"
    show (UnknownExtensionKey Integer
k) = String
"[" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
k forall a. [a] -> [a] -> [a]
++ String
"]"

parser :: Parser Message
parser :: Parser [Field]
parser = forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
whiteSpace GenTokenParser Text () Identity
ptp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Field]
parseMessage forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  where
    parseMessage :: Parser [Field]
parseMessage = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Text () Identity Field
parseField
    parseField :: ParsecT Text () Identity Field
parseField = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Key -> Value -> Field
Field ParsecT Text () Identity Key
parseKey ParsecT Text () Identity Value
parseValue
    parseKey :: ParsecT Text () Identity Key
parseKey =
        forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Key
Key (forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
identifier GenTokenParser Text () Identity
ptp) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Integer -> Key
UnknownKey (forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
natural GenTokenParser Text () Identity
ptp) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [String] -> Key
ExtensionKey (forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
brackets GenTokenParser Text () Identity
ptp (forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
identifier GenTokenParser Text () Identity
ptp forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy1` forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
dot GenTokenParser Text () Identity
ptp)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Integer -> Key
UnknownExtensionKey (forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
brackets GenTokenParser Text () Identity
ptp (forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
natural GenTokenParser Text () Identity
ptp))
    parseValue :: ParsecT Text () Identity Value
parseValue =
        forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
colon GenTokenParser Text () Identity
ptp forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
            [ParsecT Text () Identity Value
parseNumber, ParsecT Text () Identity Value
parseString, ParsecT Text () Identity Value
parseEnumValue, ParsecT Text () Identity Value
parseMessageValue] forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ParsecT Text () Identity Value
parseMessageValue

    parseNumber :: ParsecT Text () Identity Value
parseNumber = do
        Bool
negative <- (forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m String
symbol GenTokenParser Text () Identity
ptp String
"-" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Either Integer Double
value <- forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m (Either Integer Double)
naturalOrFloat GenTokenParser Text () Identity
ptp
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Bool -> Either Integer Double -> Value
makeNumberValue Bool
negative Either Integer Double
value
    parseString :: ParsecT Text () Identity Value
parseString = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> Value
ByteStringValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat)
        forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 forall a b. (a -> b) -> a -> b
$ forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
lexeme GenTokenParser Text () Identity
ptp forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity ByteString
protoStringLiteral
    parseEnumValue :: ParsecT Text () Identity Value
parseEnumValue = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Value
EnumValue (forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
identifier GenTokenParser Text () Identity
ptp)
    parseMessageValue :: ParsecT Text () Identity Value
parseMessageValue =
        forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
braces GenTokenParser Text () Identity
ptp (ParsecT Text () Identity Value
parseAny forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe Text -> [Field] -> Value
MessageValue forall a. Maybe a
Nothing) Parser [Field]
parseMessage) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
angles GenTokenParser Text () Identity
ptp (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe Text -> [Field] -> Value
MessageValue forall a. Maybe a
Nothing) Parser [Field]
parseMessage)

    typeUri :: ParsecT Text u Identity Text
typeUri = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Text
StrictText.pack (forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)))) forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?>
              String
"type URI"
    parseAny :: ParsecT Text () Identity Value
parseAny = forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe Text -> [Field] -> Value
MessageValue (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just (forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
brackets GenTokenParser Text () Identity
ptp forall {u}. ParsecT Text u Identity Text
typeUri))
                                   (forall s u (m :: * -> *).
GenTokenParser s u m
-> forall a. ParsecT s u m a -> ParsecT s u m a
braces GenTokenParser Text () Identity
ptp Parser [Field]
parseMessage)

    makeNumberValue :: Bool -> Either Integer Double -> Value
    makeNumberValue :: Bool -> Either Integer Double -> Value
makeNumberValue Bool
True (Left Integer
intValue) = Integer -> Value
IntValue (forall a. Num a => a -> a
negate Integer
intValue)
    makeNumberValue Bool
False (Left Integer
intValue) = Integer -> Value
IntValue Integer
intValue
    makeNumberValue Bool
True (Right Double
doubleValue) = Double -> Value
DoubleValue (forall a. Num a => a -> a
negate Double
doubleValue)
    makeNumberValue Bool
False (Right Double
doubleValue) = Double -> Value
DoubleValue Double
doubleValue

-- | Reads a literal string the way the Protocol Buffer distribution's
-- tokenizer.cc does.  This differs from Haskell string literals in treating,
-- e.g. "\11" as octal instead of decimal, so reading as 9 instead of 11.  Also,
-- like tokenizer.cc we assume octal and hex escapes can have at most three and
-- two digits, respectively.
--
-- TODO: implement reading of Unicode escapes.
protoStringLiteral :: Parser ByteString
protoStringLiteral :: ParsecT Text () Identity ByteString
protoStringLiteral = do
    Char
initialQuoteChar <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'
    let quoted :: ParsecT Text () Identity Builder
quoted = do
          Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
          forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
            [ forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'a'   forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\a'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'b'   forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\b'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f'   forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\f'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'n'   forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\n'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'r'   forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\r'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
't'   forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\t'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'v'   forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\v'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\\'
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\''
            , forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'  forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\"'
            , forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"xX" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char
-> Int -> (Int, Int) -> ParsecT Text () Identity Builder
parse8BitToBuilder forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit Int
16 (Int
1, Int
2)
            , forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"uU" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unicode in string literals not yet supported"
            ,               ParsecT Text () Identity Char
-> Int -> (Int, Int) -> ParsecT Text () Identity Builder
parse8BitToBuilder forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
octDigit Int
8 (Int
1, Int
3)
            ]
        unquoted :: ParsecT Text u Identity Builder
unquoted = Char -> Builder
charUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (forall a. Eq a => a -> a -> Bool
/= Char
initialQuoteChar)
    [Builder]
builders <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity Builder
quoted forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall {u}. ParsecT Text u Identity Builder
unquoted
    Char
_ <- forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
initialQuoteChar
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Builder]
builders
  where
    -- | Apply a parser between 'min' and 'max' times, failing otherwise.
    manyN :: Parser a -> (Int, Int) -> Parser [a]
    manyN :: forall a. Parser a -> (Int, Int) -> Parser [a]
manyN Parser a
_ (Int
_, Int
0) = forall (m :: * -> *) a. Monad m => a -> m a
return []
    manyN Parser a
p (Int
0, Int
maX) = ((:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> (Int, Int) -> Parser [a]
manyN Parser a
p (Int
0, Int
maX forall a. Num a => a -> a -> a
- Int
1)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    manyN Parser a
p (Int
miN, Int
maX) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> (Int, Int) -> Parser [a]
manyN Parser a
p (Int
miN forall a. Num a => a -> a -> a
- Int
1, Int
maX forall a. Num a => a -> a -> a
- Int
1)

    -- | Parse a number in 'base' with between 'min' and 'max' digits.
    parseNum :: Parser Char -> Int -> (Int, Int) -> Parser Int
    parseNum :: ParsecT Text () Identity Char -> Int -> (Int, Int) -> Parser Int
parseNum ParsecT Text () Identity Char
p Int
base (Int, Int)
range = do
      [Int]
digits <- forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
digitToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> (Int, Int) -> Parser [a]
manyN ParsecT Text () Identity Char
p (Int, Int)
range
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
a Int
d -> Int
a forall a. Num a => a -> a -> a
* Int
base forall a. Num a => a -> a -> a
+ Int
d) Int
0 [Int]
digits

    -- | Parse a number and return a builder for the 8-bit char it represents.
    parse8BitToBuilder :: Parser Char -> Int -> (Int, Int) -> Parser Builder
    parse8BitToBuilder :: ParsecT Text () Identity Char
-> Int -> (Int, Int) -> ParsecT Text () Identity Builder
parse8BitToBuilder ParsecT Text () Identity Char
p Int
base (Int, Int)
range = do
      Int
value <- ParsecT Text () Identity Char -> Int -> (Int, Int) -> Parser Int
parseNum ParsecT Text () Identity Char
p Int
base (Int, Int)
range
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
value forall a. Ord a => a -> a -> Bool
< Int
256) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Escaped number is not 8-bit"
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
word8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value