-- 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 = GenLanguageDef Text () Identity -> GenTokenParser Text () Identity
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 :: forall s u (m :: * -> *).
String
-> String
-> String
-> Bool
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m Char
-> [String]
-> [String]
-> Bool
-> GenLanguageDef s u m
LanguageDef
  { commentStart :: String
commentStart = String
""
  , commentEnd :: String
commentEnd = String
""
  , commentLine :: String
commentLine = String
"#"
  , nestedComments :: Bool
nestedComments = Bool
False
  , identStart :: ParsecT Text () Identity Char
identStart = ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
letter ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'_'
  , identLetter :: ParsecT Text () Identity Char
identLetter = ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alphaNum ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"_'"
  , opStart :: ParsecT Text () Identity Char
opStart = ParsecT Text () Identity Char
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  , opLetter :: ParsecT Text () Identity Char
opLetter = ParsecT Text () Identity Char
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
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
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
Eq Field
-> (Field -> Field -> Ordering)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Bool)
-> (Field -> Field -> Field)
-> (Field -> Field -> Field)
-> Ord 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
$cp1Ord :: Eq Field
Ord,Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
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
Eq Key
-> (Key -> Key -> Ordering)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Bool)
-> (Key -> Key -> Key)
-> (Key -> Key -> Key)
-> Ord 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
$cp1Ord :: Eq Key
Ord,Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
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
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
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
Eq Value
-> (Value -> Value -> Ordering)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Bool)
-> (Value -> Value -> Value)
-> (Value -> Value -> Value)
-> Ord 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
$cp1Ord :: Eq Value
Ord,Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
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) = ShowS
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) = Integer -> String
forall a. Show a => a -> String
show Integer
k
    show (ExtensionKey [String]
name) = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [String]
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
    show (UnknownExtensionKey Integer
k) = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
k String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"

parser :: Parser Message
parser :: Parser [Field]
parser = GenTokenParser Text () Identity -> ParsecT Text () Identity ()
forall s u (m :: * -> *). GenTokenParser s u m -> ParsecT s u m ()
whiteSpace GenTokenParser Text () Identity
ptp ParsecT Text () Identity () -> Parser [Field] -> Parser [Field]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser [Field]
parseMessage Parser [Field] -> ParsecT Text () Identity () -> Parser [Field]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  where
    parseMessage :: Parser [Field]
parseMessage = ParsecT Text () Identity Field -> Parser [Field]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ParsecT Text () Identity Field
parseField
    parseField :: ParsecT Text () Identity Field
parseField = (Key -> Value -> Field)
-> ParsecT Text () Identity Key
-> ParsecT Text () Identity Value
-> ParsecT Text () Identity Field
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 =
        (String -> Key)
-> ParsecT Text () Identity String -> ParsecT Text () Identity Key
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Key
Key (GenTokenParser Text () Identity -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
identifier GenTokenParser Text () Identity
ptp) ParsecT Text () Identity Key
-> ParsecT Text () Identity Key -> ParsecT Text () Identity Key
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Integer -> Key)
-> ParsecT Text () Identity Integer -> ParsecT Text () Identity Key
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Integer -> Key
UnknownKey (GenTokenParser Text () Identity -> ParsecT Text () Identity Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
natural GenTokenParser Text () Identity
ptp) ParsecT Text () Identity Key
-> ParsecT Text () Identity Key -> ParsecT Text () Identity Key
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        ([String] -> Key)
-> ParsecT Text () Identity [String]
-> ParsecT Text () Identity Key
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [String] -> Key
ExtensionKey (GenTokenParser Text () Identity
-> ParsecT Text () Identity [String]
-> ParsecT Text () Identity [String]
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 (GenTokenParser Text () Identity -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
identifier GenTokenParser Text () Identity
ptp ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity [String]
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` GenTokenParser Text () Identity -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
dot GenTokenParser Text () Identity
ptp)) ParsecT Text () Identity Key
-> ParsecT Text () Identity Key -> ParsecT Text () Identity Key
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        (Integer -> Key)
-> ParsecT Text () Identity Integer -> ParsecT Text () Identity Key
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Integer -> Key
UnknownExtensionKey (GenTokenParser Text () Identity
-> ParsecT Text () Identity Integer
-> ParsecT Text () Identity Integer
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 (GenTokenParser Text () Identity -> ParsecT Text () Identity Integer
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m Integer
natural GenTokenParser Text () Identity
ptp))
    parseValue :: ParsecT Text () Identity Value
parseValue =
        GenTokenParser Text () Identity -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
colon GenTokenParser Text () Identity
ptp ParsecT Text () Identity String
-> ParsecT Text () Identity Value -> ParsecT Text () Identity Value
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ParsecT Text () Identity Value] -> ParsecT Text () Identity Value
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] ParsecT Text () Identity Value
-> ParsecT Text () Identity Value -> ParsecT Text () Identity Value
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 <- (GenTokenParser Text () Identity
-> String -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> String -> ParsecT s u m String
symbol GenTokenParser Text () Identity
ptp String
"-" ParsecT Text () Identity String
-> ParsecT Text () Identity Bool -> ParsecT Text () Identity Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> ParsecT Text () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) ParsecT Text () Identity Bool
-> ParsecT Text () Identity Bool -> ParsecT Text () Identity Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ParsecT Text () Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Either Integer Double
value <- GenTokenParser Text () Identity
-> ParsecT Text () Identity (Either Integer Double)
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m (Either Integer Double)
naturalOrFloat GenTokenParser Text () Identity
ptp
        Value -> ParsecT Text () Identity Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> ParsecT Text () Identity Value)
-> Value -> ParsecT Text () Identity Value
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 = ([ByteString] -> Value)
-> ParsecT Text () Identity [ByteString]
-> ParsecT Text () Identity Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (ByteString -> Value
ByteStringValue (ByteString -> Value)
-> ([ByteString] -> ByteString) -> [ByteString] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat)
        (ParsecT Text () Identity [ByteString]
 -> ParsecT Text () Identity Value)
-> ParsecT Text () Identity [ByteString]
-> ParsecT Text () Identity Value
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity ByteString
-> ParsecT Text () Identity [ByteString]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT Text () Identity ByteString
 -> ParsecT Text () Identity [ByteString])
-> ParsecT Text () Identity ByteString
-> ParsecT Text () Identity [ByteString]
forall a b. (a -> b) -> a -> b
$ GenTokenParser Text () Identity
-> forall a.
   ParsecT Text () Identity a -> ParsecT Text () Identity a
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 (ParsecT Text () Identity ByteString
 -> ParsecT Text () Identity ByteString)
-> ParsecT Text () Identity ByteString
-> ParsecT Text () Identity ByteString
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity ByteString
protoStringLiteral
    parseEnumValue :: ParsecT Text () Identity Value
parseEnumValue = (String -> Value)
-> ParsecT Text () Identity String
-> ParsecT Text () Identity Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Value
EnumValue (GenTokenParser Text () Identity -> ParsecT Text () Identity String
forall s u (m :: * -> *).
GenTokenParser s u m -> ParsecT s u m String
identifier GenTokenParser Text () Identity
ptp)
    parseMessageValue :: ParsecT Text () Identity Value
parseMessageValue =
        GenTokenParser Text () Identity
-> ParsecT Text () Identity Value -> ParsecT Text () Identity Value
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 ParsecT Text () Identity Value
-> ParsecT Text () Identity Value -> ParsecT Text () Identity Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                    ([Field] -> Value)
-> Parser [Field] -> ParsecT Text () Identity Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe Text -> [Field] -> Value
MessageValue Maybe Text
forall a. Maybe a
Nothing) Parser [Field]
parseMessage) ParsecT Text () Identity Value
-> ParsecT Text () Identity Value -> ParsecT Text () Identity Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        GenTokenParser Text () Identity
-> ParsecT Text () Identity Value -> ParsecT Text () Identity Value
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 (([Field] -> Value)
-> Parser [Field] -> ParsecT Text () Identity Value
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Maybe Text -> [Field] -> Value
MessageValue Maybe Text
forall a. Maybe a
Nothing) Parser [Field]
parseMessage)

    typeUri :: ParsecT Text u Identity Text
typeUri = (String -> Text)
-> ParsecT Text u Identity String -> ParsecT Text u Identity Text
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM String -> Text
StrictText.pack (ParsecT Text u Identity Char -> ParsecT Text u Identity String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isSpace Char
c)))) ParsecT Text u Identity Text
-> String -> ParsecT Text u Identity Text
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 = (Maybe Text -> [Field] -> Value)
-> ParsecT Text () Identity (Maybe Text)
-> Parser [Field]
-> ParsecT Text () Identity Value
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Maybe Text -> [Field] -> Value
MessageValue ((Text -> Maybe Text)
-> ParsecT Text () Identity Text
-> ParsecT Text () Identity (Maybe Text)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Text -> Maybe Text
forall a. a -> Maybe a
Just (GenTokenParser Text () Identity
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
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 ParsecT Text () Identity Text
forall u. ParsecT Text u Identity Text
typeUri))
                                   (GenTokenParser Text () Identity -> Parser [Field] -> Parser [Field]
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 (Integer -> Integer
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 (Double -> Double
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 <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\'' ParsecT Text () Identity Char
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ParsecT Text () Identity Char
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
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
          [ParsecT Text () Identity Builder]
-> ParsecT Text () Identity Builder
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
            [ Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'a'   ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\a'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'b'   ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\b'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'f'   ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\f'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'n'   ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\n'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'r'   ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\r'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
't'   ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\t'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'v'   ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\v'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'  ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\\'
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\''  ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\''
            , Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\"'  ParsecT Text () Identity Char
-> Builder -> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Char -> Builder
char8 Char
'\"'
            , String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"xX" ParsecT Text () Identity Char
-> ParsecT Text () Identity Builder
-> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Char
-> Int -> (Int, Int) -> ParsecT Text () Identity Builder
parse8BitToBuilder ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit Int
16 (Int
1, Int
2)
            , String -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"uU" ParsecT Text () Identity Char
-> ParsecT Text () Identity Builder
-> ParsecT Text () Identity Builder
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT Text () Identity Builder
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 ParsecT Text () Identity Char
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 (Char -> Builder)
-> ParsecT Text u Identity Char -> ParsecT Text u Identity Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> ParsecT Text u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
initialQuoteChar)
    [Builder]
builders <- ParsecT Text () Identity Builder
-> ParsecT Text () Identity [Builder]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ParsecT Text () Identity Builder
 -> ParsecT Text () Identity [Builder])
-> ParsecT Text () Identity Builder
-> ParsecT Text () Identity [Builder]
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity Builder
quoted ParsecT Text () Identity Builder
-> ParsecT Text () Identity Builder
-> ParsecT Text () Identity Builder
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Text () Identity Builder
forall u. ParsecT Text u Identity Builder
unquoted
    Char
_ <- Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
initialQuoteChar
    ByteString -> ParsecT Text () Identity ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ParsecT Text () Identity ByteString)
-> ByteString -> ParsecT Text () Identity ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
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 :: Parser a -> (Int, Int) -> Parser [a]
manyN Parser a
_ (Int
_, Int
0) = [a] -> Parser [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    manyN Parser a
p (Int
0, Int
maX) = ((:) (a -> [a] -> [a])
-> Parser a -> ParsecT Text () Identity ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p ParsecT Text () Identity ([a] -> [a]) -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> (Int, Int) -> Parser [a]
forall a. Parser a -> (Int, Int) -> Parser [a]
manyN Parser a
p (Int
0, Int
maX Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)) Parser [a] -> Parser [a] -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [a] -> Parser [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    manyN Parser a
p (Int
miN, Int
maX) = (:) (a -> [a] -> [a])
-> Parser a -> ParsecT Text () Identity ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p ParsecT Text () Identity ([a] -> [a]) -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> (Int, Int) -> Parser [a]
forall a. Parser a -> (Int, Int) -> Parser [a]
manyN Parser a
p (Int
miN Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
maX Int -> Int -> Int
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 <- (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
digitToInt (String -> [Int])
-> ParsecT Text () Identity String
-> ParsecT Text () Identity [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> (Int, Int) -> ParsecT Text () Identity String
forall a. Parser a -> (Int, Int) -> Parser [a]
manyN ParsecT Text () Identity Char
p (Int, Int)
range
      Int -> Parser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Parser Int) -> Int -> Parser Int
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Int
a Int
d -> Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
base Int -> Int -> Int
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
      Bool -> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
value Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
256) (ParsecT Text () Identity () -> ParsecT Text () Identity ())
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT Text () Identity ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Escaped number is not 8-bit"
      Builder -> ParsecT Text () Identity Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> ParsecT Text () Identity Builder)
-> Builder -> ParsecT Text () Identity Builder
forall a b. (a -> b) -> a -> b
$ Word8 -> Builder
word8 (Word8 -> Builder) -> Word8 -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
value