{-# LANGUAGE BangPatterns, RankNTypes, ScopedTypeVariables, CPP #-}
-- | This "Parser" module takes a filename and its contents as a
-- bytestring, and uses Lexer.hs to make a stream of tokens that it
-- parses. No IO is performed and the error function is not used.
-- Since the Lexer should also avoid such errors this should be a
-- reliably total function of the input.
--
-- The internals have been updated to handle Google's protobuf version
-- 2.0.3 formats, including EnumValueOptions.
module Text.ProtocolBuffers.ProtoCompile.Parser(parseProto,isValidPacked) where

import qualified Text.DescriptorProtos.DescriptorProto                as D(DescriptorProto)
import qualified Text.DescriptorProtos.DescriptorProto                as D.DescriptorProto(DescriptorProto(..))
-- import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D(ExtensionRange)
import qualified Text.DescriptorProtos.DescriptorProto.ExtensionRange as D.ExtensionRange(ExtensionRange(..))
import qualified Text.DescriptorProtos.EnumDescriptorProto            as D(EnumDescriptorProto)
import qualified Text.DescriptorProtos.EnumDescriptorProto            as D.EnumDescriptorProto(EnumDescriptorProto(..))
-- import qualified Text.DescriptorProtos.EnumOptions                    as D(EnumOptions)
import qualified Text.DescriptorProtos.EnumOptions                    as D.EnumOptions(EnumOptions(..))
import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D(EnumValueDescriptorProto)
import qualified Text.DescriptorProtos.EnumValueDescriptorProto       as D.EnumValueDescriptorProto(EnumValueDescriptorProto(..))
-- import qualified Text.DescriptorProtos.EnumValueOptions               as D(EnumValueOptions)
import qualified Text.DescriptorProtos.EnumValueOptions               as D.EnumValueOptions(EnumValueOptions(..))
import qualified Text.DescriptorProtos.FieldDescriptorProto           as D(FieldDescriptorProto)
import qualified Text.DescriptorProtos.FieldDescriptorProto           as D.FieldDescriptorProto(FieldDescriptorProto(..))
import           Text.DescriptorProtos.FieldDescriptorProto.Label
-- import qualified Text.DescriptorProtos.FieldDescriptorProto.Type      as D.FieldDescriptorProto(Type)
import           Text.DescriptorProtos.FieldDescriptorProto.Type         (Type(..))
-- import qualified Text.DescriptorProtos.FieldOptions                   as D(FieldOptions)
import qualified Text.DescriptorProtos.FieldOptions                   as D.FieldOptions(FieldOptions(..))
import qualified Text.DescriptorProtos.FileDescriptorProto            as D(FileDescriptorProto)
import qualified Text.DescriptorProtos.FileDescriptorProto            as D.FileDescriptorProto(FileDescriptorProto(..))
-- import qualified Text.DescriptorProtos.FileOptions                    as D(FileOptions)
import qualified Text.DescriptorProtos.FileOptions                    as D.FileOptions(FileOptions(..))
-- import qualified Text.DescriptorProtos.MessageOptions                 as D(MessageOptions)
import qualified Text.DescriptorProtos.MessageOptions                 as D.MessageOptions(MessageOptions(..))
import qualified Text.DescriptorProtos.MethodDescriptorProto          as D(MethodDescriptorProto)
import qualified Text.DescriptorProtos.MethodDescriptorProto          as D.MethodDescriptorProto(MethodDescriptorProto(..))
-- import qualified Text.DescriptorProtos.MethodOptions                  as D(MethodOptions)
import qualified Text.DescriptorProtos.MethodOptions                  as D.MethodOptions(MethodOptions(..))
import qualified Text.DescriptorProtos.OneofDescriptorProto           as D(OneofDescriptorProto)
import qualified Text.DescriptorProtos.OneofDescriptorProto           as D.OneofDescriptorProto(OneofDescriptorProto(..))
import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D(ServiceDescriptorProto)
import qualified Text.DescriptorProtos.ServiceDescriptorProto         as D.ServiceDescriptorProto(ServiceDescriptorProto(..))
-- import qualified Text.DescriptorProtos.ServiceOptions                 as D(ServiceOptions)
import qualified Text.DescriptorProtos.ServiceOptions                 as D.ServiceOptions(ServiceOptions(..))
import qualified Text.DescriptorProtos.UninterpretedOption            as D(UninterpretedOption)
import qualified Text.DescriptorProtos.UninterpretedOption            as D.UninterpretedOption(UninterpretedOption(..))
-- import qualified Text.DescriptorProtos.UninterpretedOption.NamePart   as D(NamePart)
import qualified Text.DescriptorProtos.UninterpretedOption.NamePart   as D.NamePart(NamePart(..))

import Text.ProtocolBuffers.Basic
import Text.ProtocolBuffers.Identifiers
import Text.ProtocolBuffers.Header(ReflectEnum(reflectEnumInfo),enumName)
import Text.ProtocolBuffers.ProtoCompile.Lexer(Lexed(..),alexScanTokens,getLinePos)
import Text.ProtocolBuffers.ProtoCompile.Instances(parseLabel,parseType)
-- import Text.ProtocolBuffers.Reflections()

import Control.Monad(when,liftM2,liftM3)
import qualified Data.ByteString.Lazy as L(unpack)
import qualified Data.ByteString.Lazy.Char8 as LC(notElem,head)
import qualified Data.ByteString.Lazy.UTF8 as U(fromString,toString)
import Data.Char(isUpper,toLower)
import Data.Ix(inRange)
import Data.Maybe(fromMaybe)
import Data.Monoid(mconcat)
import Data.Sequence((|>),(><))
import qualified Data.Sequence as Seq(fromList,length,empty)
import Data.Word(Word8)
import Numeric(showOct)
--import System.FilePath(takeFileName)
import Text.ParserCombinators.Parsec(GenParser,ParseError,runParser,sourceName,anyToken,many1,lookAhead,try
                                    ,getInput,setInput,getPosition,setPosition,getState,setState
                                    ,(<?>),(<|>),token,choice,between,eof,unexpected,skipMany)
import Text.ParserCombinators.Parsec.Pos(newPos)

default ()

#if MIN_VERSION_parsec(3,0,0)
type P st = GenParser Lexed st
#else
type P = GenParser Lexed
#endif

parseProto :: String -> ByteString -> Either ParseError D.FileDescriptorProto
parseProto :: String -> ByteString -> Either ParseError FileDescriptorProto
parseProto String
filename ByteString
fileContents = do
  let initial_line_number :: ParsecT [Lexed] FileDescriptorProto Identity ()
initial_line_number = case [Lexed]
lexed of
                              [] -> SourcePos -> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (String -> Line -> Line -> SourcePos
newPos String
filename Line
0 Line
0)
                              (Lexed
l:[Lexed]
_) -> SourcePos -> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition (String -> Line -> Line -> SourcePos
newPos String
filename (Lexed -> Line
getLinePos Lexed
l) Line
0)
      initState :: FileDescriptorProto
initState = FileDescriptorProto
forall a. Default a => a
defaultValue {name :: Maybe Utf8
D.FileDescriptorProto.name=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just (String -> Utf8
uFromString String
filename)}
      lexed :: [Lexed]
lexed = ByteString -> [Lexed]
alexScanTokens ByteString
fileContents
  GenParser Lexed FileDescriptorProto FileDescriptorProto
-> FileDescriptorProto
-> String
-> [Lexed]
-> Either ParseError FileDescriptorProto
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser (ParsecT [Lexed] FileDescriptorProto Identity ()
initial_line_number ParsecT [Lexed] FileDescriptorProto Identity ()
-> GenParser Lexed FileDescriptorProto FileDescriptorProto
-> GenParser Lexed FileDescriptorProto FileDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed FileDescriptorProto FileDescriptorProto
parser) FileDescriptorProto
initState String
filename [Lexed]
lexed


{-# INLINE mayRead #-}
mayRead :: ReadS a -> String -> Maybe a
mayRead :: ReadS a -> String -> Maybe a
mayRead ReadS a
f String
s = case ReadS a
f String
s of [(a
a,String
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
a; [(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing

true,false :: ByteString
true :: ByteString
true = String -> ByteString
U.fromString String
"true"
false :: ByteString
false = String -> ByteString
U.fromString String
"false"

-- Use 'token' via 'tok' to make all the parsers for the Lexed values
tok :: (Lexed -> Maybe a) -> P s a
tok :: (Lexed -> Maybe a) -> P s a
tok Lexed -> Maybe a
f = (Lexed -> String)
-> (Lexed -> SourcePos) -> (Lexed -> Maybe a) -> P s a
forall s t a u.
Stream s Identity t =>
(t -> String) -> (t -> SourcePos) -> (t -> Maybe a) -> Parsec s u a
token Lexed -> String
forall a. Show a => a -> String
show (\Lexed
lexed -> String -> Line -> Line -> SourcePos
newPos String
"" (Lexed -> Line
getLinePos Lexed
lexed) Line
0) Lexed -> Maybe a
f

pChar :: Char -> P s ()
pChar :: Char -> P s ()
pChar Char
c = (Lexed -> Maybe ()) -> P s ()
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L Line
_ Char
x -> if (Char
xChar -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
c) then () -> Maybe ()
forall (m :: * -> *) a. Monad m => a -> m a
return () else Maybe ()
forall a. Maybe a
Nothing
                              Lexed
_ -> Maybe ()
forall a. Maybe a
Nothing) P s () -> String -> P s ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"character "String -> String -> String
forall a. [a] -> [a] -> [a]
++Char -> String
forall a. Show a => a -> String
show Char
c)

eol,eols :: P s ()
eol :: P s ()
eol = Char -> P s ()
forall s. Char -> P s ()
pChar Char
';'
eols :: P s ()
eols = P s () -> P s ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany P s ()
forall s. P s ()
eol

pName :: ByteString -> P s Utf8
pName :: ByteString -> P s Utf8
pName ByteString
name = (Lexed -> Maybe Utf8) -> P s Utf8
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Name Line
_ ByteString
x -> if (ByteString
xByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
==ByteString
name) then Utf8 -> Maybe Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Utf8
Utf8 ByteString
x) else Maybe Utf8
forall a. Maybe a
Nothing
                                 Lexed
_ -> Maybe Utf8
forall a. Maybe a
Nothing) P s Utf8 -> String -> P s Utf8
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"name "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show (ByteString -> String
U.toString ByteString
name))

rawStrMany :: P s (ByteString,ByteString) -- used for any and all access to L_String
rawStrMany :: P s (ByteString, ByteString)
rawStrMany = ([(ByteString, ByteString)] -> (ByteString, ByteString))
-> ParsecT [Lexed] s Identity [(ByteString, ByteString)]
-> P s (ByteString, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ByteString, ByteString)] -> (ByteString, ByteString)
forall a. Monoid a => [a] -> a
mconcat (P s (ByteString, ByteString)
-> ParsecT [Lexed] s Identity [(ByteString, ByteString)]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 P s (ByteString, ByteString)
forall s. P s (ByteString, ByteString)
singleStringLit)
  where singleStringLit :: P s (ByteString,ByteString)
        singleStringLit :: P s (ByteString, ByteString)
singleStringLit = (Lexed -> Maybe (ByteString, ByteString))
-> P s (ByteString, ByteString)
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_String Line
_ ByteString
raw ByteString
x -> (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
raw,ByteString
x)
                                              Lexed
_ -> Maybe (ByteString, ByteString)
forall a. Maybe a
Nothing) P s (ByteString, ByteString)
-> String -> P s (ByteString, ByteString)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"expected string literal in single or double quotes"

-- In Google's version 2.4.0 there can be default message values which are curly-brace delimited
-- aggregates.  The lexer eats these fine, and this parser routine should recognized a balanced
-- expression.  Used with 'undoLexer'.
--
-- This assumes the initial (L _ '{' ) has already been parsed.
getAggregate :: P s [Lexed]
getAggregate :: P s [Lexed]
getAggregate = do
  [Lexed]
input <- P s [Lexed]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  let count :: Int -> Int -> P s [Lexed]
      count :: Line -> Line -> P s [Lexed]
count !Line
n !Line
depth = do
        -- Not using getNextToken so that the value of 'n' in count is correct.
        Lexed
t <- ParsecT [Lexed] s Identity Lexed
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
        case Lexed
t  of
          L Line
_ Char
'{' -> Line -> Line -> P s [Lexed]
forall s. Line -> Line -> P s [Lexed]
count (Line -> Line
forall a. Enum a => a -> a
succ Line
n) (Line -> Line
forall a. Enum a => a -> a
succ Line
depth)
          L Line
_ Char
'}' -> let n' :: Line
n' = Line -> Line
forall a. Enum a => a -> a
succ Line
n
                         depth' :: Line
depth' = Line -> Line
forall a. Enum a => a -> a
pred Line
depth
                     in if Line
0Line -> Line -> Bool
forall a. Eq a => a -> a -> Bool
==Line
depth' then [Lexed] -> P s [Lexed]
forall (m :: * -> *) a. Monad m => a -> m a
return (Line -> [Lexed] -> [Lexed]
forall a. Line -> [a] -> [a]
take Line
n' [Lexed]
input)
                          else Line -> Line -> P s [Lexed]
forall s. Line -> Line -> P s [Lexed]
count Line
n' Line
depth'
          Lexed
_ -> Line -> Line -> P s [Lexed]
forall s. Line -> Line -> P s [Lexed]
count (Line -> Line
forall a. Enum a => a -> a
succ Line
n) Line
depth
  [Lexed]
ls <- Line -> Line -> P s [Lexed]
forall s. Line -> Line -> P s [Lexed]
count Line
0 Line
1
  [Lexed] -> P s [Lexed]
forall (m :: * -> *) a. Monad m => a -> m a
return [Lexed]
ls

getNextToken :: P s Lexed -- used in storing value for UninterpretedOption
getNextToken :: P s Lexed
getNextToken = do
  Lexed
l <- P s Lexed -> P s Lexed
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead P s Lexed
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken
  case Lexed
l of
    L_String Line
line ByteString
_ ByteString
_ -> P s (ByteString, ByteString)
forall s. P s (ByteString, ByteString)
rawStrMany P s (ByteString, ByteString)
-> ((ByteString, ByteString) -> P s Lexed) -> P s Lexed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ByteString
raw,ByteString
bs) -> Lexed -> P s Lexed
forall (m :: * -> *) a. Monad m => a -> m a
return (Line -> ByteString -> ByteString -> Lexed
L_String Line
line ByteString
raw ByteString
bs)
    Lexed
_ -> P s Lexed
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken

bsLit :: P s ByteString
bsLit :: P s ByteString
bsLit = ((ByteString, ByteString) -> ByteString)
-> ParsecT [Lexed] s Identity (ByteString, ByteString)
-> P s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ParsecT [Lexed] s Identity (ByteString, ByteString)
forall s. P s (ByteString, ByteString)
rawStrMany P s ByteString -> String -> P s ByteString
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"quoted bytes literal, raw form"

strLit :: P s Utf8
strLit :: P s Utf8
strLit = ((ByteString, ByteString) -> ByteString)
-> ParsecT [Lexed] s Identity (ByteString, ByteString)
-> ParsecT [Lexed] s Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ParsecT [Lexed] s Identity (ByteString, ByteString)
forall s. P s (ByteString, ByteString)
rawStrMany ParsecT [Lexed] s Identity ByteString
-> (ByteString -> P s Utf8) -> P s Utf8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ ByteString
x -> case ByteString -> Maybe Line
isValidUTF8 ByteString
x of
                                          Maybe Line
Nothing -> Utf8 -> P s Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Utf8
Utf8 ByteString
x)
                                          Just Line
n -> String -> P s Utf8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> P s Utf8) -> String -> P s Utf8
forall a b. (a -> b) -> a -> b
$ String
"bad utf-8 byte in string literal position # "String -> String -> String
forall a. [a] -> [a] -> [a]
++Line -> String
forall a. Show a => a -> String
show Line
n

intLit,fieldInt,enumInt :: (Num a) => P s a
intLit :: P s a
intLit = (Lexed -> Maybe a) -> P s a
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Integer Line
_ Integer
x -> a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)
                             Lexed
_ -> Maybe a
forall a. Maybe a
Nothing) P s a -> String -> P s a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"integer literal"

fieldInt :: P s a
fieldInt = (Lexed -> Maybe a) -> P s a
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Integer Line
_ Integer
x | (Integer, Integer) -> Integer -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Integer, Integer)
validRange Integer
x Bool -> Bool -> Bool
&& Bool -> Bool
not ((Integer, Integer) -> Integer -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Integer, Integer)
reservedRange Integer
x) -> a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)
                               Lexed
_ -> Maybe a
forall a. Maybe a
Nothing) P s a -> String -> P s a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"field number (from 0 to 2^29-1 and not in 19000 to 19999)"
  where validRange :: (Integer, Integer)
validRange = (Integer
0,(Integer
2Integer -> Line -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^(Line
29::Int))Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)
        reservedRange :: (Integer, Integer)
reservedRange = (Integer
19000,Integer
19999)

enumInt :: P s a
enumInt = (Lexed -> Maybe a) -> P s a
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Integer Line
_ Integer
x | (Integer, Integer) -> Integer -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Integer, Integer)
validRange Integer
x -> a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
x)
                              Lexed
_ -> Maybe a
forall a. Maybe a
Nothing) P s a -> String -> P s a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"enum value (from -2^31 to 2^31-1)"
  where validRange :: (Integer, Integer)
validRange = (Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32
forall a. Bounded a => a
minBound :: Int32), Int32 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int32
forall a. Bounded a => a
maxBound :: Int32))

doubleLit :: P s Double
doubleLit :: P s Double
doubleLit = (Lexed -> Maybe Double) -> P s Double
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Double Line
_ Double
x -> Double -> Maybe Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
x
                                L_Integer Line
_ Integer
x -> Double -> Maybe Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
x)
                                L_Name Line
_ ByteString
s | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
U.fromString String
"inf" -> Double -> Maybe Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
                                           | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
U.fromString String
"-inf" -> Double -> Maybe Double
forall (m :: * -> *) a. Monad m => a -> m a
return (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
                                           | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
U.fromString String
"nan" -> Double -> Maybe Double
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
0Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)
                                Lexed
_ -> Maybe Double
forall a. Maybe a
Nothing) P s Double -> String -> P s Double
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"double (or integer) literal or nan, inf, -inf"

floatLit :: P s Float
floatLit :: P s Float
floatLit = (Lexed -> Maybe Float) -> P s Float
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Double Line
_ Double
x -> Float -> Maybe Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float -> Maybe Float)
-> (Double -> Float) -> Double -> Maybe Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Float
forall a. Fractional a => Rational -> a
fromRational (Rational -> Float) -> (Double -> Rational) -> Double -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Rational
forall a. Real a => a -> Rational
toRational (Double -> Maybe Float) -> Double -> Maybe Float
forall a b. (a -> b) -> a -> b
$ Double
x
                               L_Integer Line
_ Integer
x -> Float -> Maybe Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> Float
forall a. Num a => Integer -> a
fromInteger Integer
x)
                               L_Name Line
_ ByteString
s | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
U.fromString String
"inf" -> Float -> Maybe Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
                                          | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
U.fromString String
"-inf" -> Float -> Maybe Float
forall (m :: * -> *) a. Monad m => a -> m a
return (-Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
                                          | ByteString
s ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
U.fromString String
"nan" -> Float -> Maybe Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
0Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
0)
                               Lexed
_ -> Maybe Float
forall a. Maybe a
Nothing) P s Float -> String -> P s Float
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"float (or integer) literal or nan, inf, -inf"

ident,ident1,ident_package :: P s Utf8
ident :: P s Utf8
ident = (Lexed -> Maybe Utf8) -> P s Utf8
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Name Line
_ ByteString
x -> Utf8 -> Maybe Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Utf8
Utf8 ByteString
x)
                            Lexed
_ -> Maybe Utf8
forall a. Maybe a
Nothing) P s Utf8 -> String -> P s Utf8
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"identifier (perhaps dotted)"

ident1 :: P s Utf8
ident1 = (Lexed -> Maybe Utf8) -> P s Utf8
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Name Line
_ ByteString
x | Char -> ByteString -> Bool
LC.notElem Char
'.' ByteString
x -> Utf8 -> Maybe Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Utf8
Utf8 ByteString
x)
                             Lexed
_ -> Maybe Utf8
forall a. Maybe a
Nothing) P s Utf8 -> String -> P s Utf8
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"identifier (not dotted)"

ident_package :: P s Utf8
ident_package = (Lexed -> Maybe Utf8) -> P s Utf8
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Name Line
_ ByteString
x | ByteString -> Char
LC.head ByteString
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.' -> Utf8 -> Maybe Utf8
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Utf8
Utf8 ByteString
x)
                                    Lexed
_ -> Maybe Utf8
forall a. Maybe a
Nothing) P s Utf8 -> String -> P s Utf8
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"package name (no leading dot)"

boolLit :: P s Bool
boolLit :: P s Bool
boolLit = (Lexed -> Maybe Bool) -> P s Bool
forall a s. (Lexed -> Maybe a) -> P s a
tok (\Lexed
l-> case Lexed
l of L_Name Line
_ ByteString
x | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
true -> Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                                         | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
false -> Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                              Lexed
_ -> Maybe Bool
forall a. Maybe a
Nothing) P s Bool -> String -> P s Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"boolean literal ('true' or 'false')"

enumLit :: forall s a. (Read a,ReflectEnum a) => P s a -- This is very polymorphic, and with a good error message
enumLit :: P s a
enumLit = do
  String
s <- (Utf8 -> String)
-> ParsecT [Lexed] s Identity Utf8
-> ParsecT [Lexed] s Identity String
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
fmap' Utf8 -> String
uToString ParsecT [Lexed] s Identity Utf8
forall s. P s Utf8
ident1
  case ReadS a -> String -> Maybe a
forall a. ReadS a -> String -> Maybe a
mayRead ReadS a
forall a. Read a => ReadS a
reads String
s of
    Just a
x -> a -> P s a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
    Maybe a
Nothing -> let self :: ProtoName
self = EnumInfo -> ProtoName
enumName (a -> EnumInfo
forall e. ReflectEnum e => e -> EnumInfo
reflectEnumInfo (a
forall a. HasCallStack => a
undefined :: a))
               in String -> P s a
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> P s a) -> String -> P s a
forall a b. (a -> b) -> a -> b
$ String
"Enum value not recognized: "String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
forall a. Show a => a -> String
show String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
", wanted enum value of type "String -> String -> String
forall a. [a] -> [a] -> [a]
++ProtoName -> String
forall a. Show a => a -> String
show ProtoName
self

-- -------------------------------------------------------------------
-- subParser changes the user state. It is a bit of a hack and is used
-- to define an interesting style of parsing.
subParser :: forall t sSub a s. Show t => GenParser t sSub a -> sSub -> GenParser t s sSub
subParser :: GenParser t sSub a -> sSub -> GenParser t s sSub
subParser GenParser t sSub a
doSub sSub
inSub = do
  [t]
in1 <- ParsecT [t] s Identity [t]
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
  SourcePos
pos1 <- ParsecT [t] s Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
  let out :: Either ParseError (sSub, [t], SourcePos)
out = GenParser t sSub (sSub, [t], SourcePos)
-> sSub
-> String
-> [t]
-> Either ParseError (sSub, [t], SourcePos)
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser (SourcePos -> ParsecT [t] sSub Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos1 ParsecT [t] sSub Identity ()
-> GenParser t sSub a -> GenParser t sSub a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser t sSub a
doSub GenParser t sSub a
-> GenParser t sSub (sSub, [t], SourcePos)
-> GenParser t sSub (sSub, [t], SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser t sSub (sSub, [t], SourcePos)
forall b a. ParsecT b a Identity (a, b, SourcePos)
getStatus) sSub
inSub (SourcePos -> String
sourceName SourcePos
pos1) [t]
in1
  case Either ParseError (sSub, [t], SourcePos)
out of
    Left ParseError
pe -> do
      let anyTok :: Int -> GenParser t s [t]
          anyTok :: Line -> ParsecT [t] s Identity [t]
anyTok Line
i | Line
iLine -> Line -> Bool
forall a. Ord a => a -> a -> Bool
<=Line
0 = [t] -> ParsecT [t] s Identity [t]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                   | Bool
otherwise = ParsecT [t] s Identity [t] -> ParsecT [t] s Identity [t]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ((t -> [t] -> [t])
-> ParsecT [t] s Identity t
-> ParsecT [t] s Identity [t]
-> ParsecT [t] s Identity [t]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (:) ParsecT [t] s Identity t
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m t
anyToken (Line -> ParsecT [t] s Identity [t]
anyTok (Line -> Line
forall a. Enum a => a -> a
pred Line
i))) ParsecT [t] s Identity [t]
-> ParsecT [t] s Identity [t] -> ParsecT [t] s Identity [t]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([t] -> ParsecT [t] s Identity [t]
forall (m :: * -> *) a. Monad m => a -> m a
return [])
      [t]
context <- Line -> ParsecT [t] s Identity [t]
anyTok Line
10
      String -> GenParser t s sSub
forall (m :: * -> *) a. MonadFail m => String -> m a
fail ( [String] -> String
unlines [ String
"The error message from the nested subParser was:\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++String -> String
indent (ParseError -> String
forall a. Show a => a -> String
show ParseError
pe)
                     , String
"  The next 10 tokens were "String -> String -> String
forall a. [a] -> [a] -> [a]
++[t] -> String
forall a. Show a => a -> String
show [t]
context ] )
    Right (sSub
outSub,[t]
in2,SourcePos
pos2) -> [t] -> ParsecT [t] s Identity ()
forall (m :: * -> *) s u. Monad m => s -> ParsecT s u m ()
setInput [t]
in2 ParsecT [t] s Identity ()
-> ParsecT [t] s Identity () -> ParsecT [t] s Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SourcePos -> ParsecT [t] s Identity ()
forall (m :: * -> *) s u. Monad m => SourcePos -> ParsecT s u m ()
setPosition SourcePos
pos2 ParsecT [t] s Identity ()
-> GenParser t s sSub -> GenParser t s sSub
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> sSub -> GenParser t s sSub
forall (m :: * -> *) a. Monad m => a -> m a
return sSub
outSub
 where getStatus :: ParsecT b a Identity (a, b, SourcePos)
getStatus = (a -> b -> SourcePos -> (a, b, SourcePos))
-> ParsecT b a Identity a
-> ParsecT b a Identity b
-> ParsecT b a Identity SourcePos
-> ParsecT b a Identity (a, b, SourcePos)
forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 (,,) ParsecT b a Identity a
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT b a Identity b
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput ParsecT b a Identity SourcePos
forall (m :: * -> *) s u. Monad m => ParsecT s u m SourcePos
getPosition
       indent :: String -> String
indent = [String] -> String
unlines ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
s -> Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines

{-# INLINE return' #-}
return' :: (Monad m) => a -> m a
return' :: a -> m a
return' a
a = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! a
a

{-# INLINE fmap' #-}
fmap' :: (Monad m) => (a->b) -> m a -> m b
fmap' :: (a -> b) -> m a -> m b
fmap' a -> b
f m a
m = m a
m m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> a -> m b -> m b
seq a
a (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> m b) -> b -> m b
forall a b. (a -> b) -> a -> b
$! (a -> b
f a
a))

{-# INLINE update' #-}
update' :: (s -> s) -> P s ()
update' :: (s -> s) -> P s ()
update' s -> s
f = ParsecT [Lexed] s Identity s
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Lexed] s Identity s -> (s -> P s ()) -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \s
s -> s -> P s ()
forall (m :: * -> *) u s. Monad m => u -> ParsecT s u m ()
setState (s -> P s ()) -> s -> P s ()
forall a b. (a -> b) -> a -> b
$! (s -> s
f s
s)

parser :: P D.FileDescriptorProto D.FileDescriptorProto
parser :: GenParser Lexed FileDescriptorProto FileDescriptorProto
parser = ParsecT [Lexed] FileDescriptorProto Identity ()
proto ParsecT [Lexed] FileDescriptorProto Identity ()
-> GenParser Lexed FileDescriptorProto FileDescriptorProto
-> GenParser Lexed FileDescriptorProto FileDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed FileDescriptorProto FileDescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  where proto :: ParsecT [Lexed] FileDescriptorProto Identity ()
proto = ParsecT [Lexed] FileDescriptorProto Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([ParsecT [Lexed] FileDescriptorProto Identity ()]
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. P s ()
eol
                                , ParsecT [Lexed] FileDescriptorProto Identity ()
importFile
                                , ParsecT [Lexed] FileDescriptorProto Identity ()
package
                                , ParsecT [Lexed] FileDescriptorProto Identity ()
fileOption
                                , (DescriptorProto
 -> ParsecT [Lexed] FileDescriptorProto Identity ())
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (DescriptorProto -> P s ()) -> P s ()
message DescriptorProto -> ParsecT [Lexed] FileDescriptorProto Identity ()
upTopMsg
                                , (EnumDescriptorProto
 -> ParsecT [Lexed] FileDescriptorProto Identity ())
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (EnumDescriptorProto -> P s ()) -> P s ()
enum EnumDescriptorProto
-> ParsecT [Lexed] FileDescriptorProto Identity ()
upTopEnum
                                , (DescriptorProto
 -> ParsecT [Lexed] FileDescriptorProto Identity ())
-> (FieldDescriptorProto
    -> ParsecT [Lexed] FileDescriptorProto Identity ())
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s.
(DescriptorProto -> P s ())
-> (FieldDescriptorProto -> P s ()) -> P s ()
extend DescriptorProto -> ParsecT [Lexed] FileDescriptorProto Identity ()
upTopMsg FieldDescriptorProto
-> ParsecT [Lexed] FileDescriptorProto Identity ()
upTopExt
                                , ParsecT [Lexed] FileDescriptorProto Identity ()
service
                                , ParsecT [Lexed] FileDescriptorProto Identity ()
syntax
                                ] ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] FileDescriptorProto Identity ()
proto)
        upTopMsg :: DescriptorProto -> ParsecT [Lexed] FileDescriptorProto Identity ()
upTopMsg DescriptorProto
msg = (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {message_type :: Seq DescriptorProto
D.FileDescriptorProto.message_type=FileDescriptorProto -> Seq DescriptorProto
D.FileDescriptorProto.message_type FileDescriptorProto
s Seq DescriptorProto -> DescriptorProto -> Seq DescriptorProto
forall a. Seq a -> a -> Seq a
|> DescriptorProto
msg})
        upTopEnum :: EnumDescriptorProto
-> ParsecT [Lexed] FileDescriptorProto Identity ()
upTopEnum EnumDescriptorProto
e  = (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {enum_type :: Seq EnumDescriptorProto
D.FileDescriptorProto.enum_type=FileDescriptorProto -> Seq EnumDescriptorProto
D.FileDescriptorProto.enum_type FileDescriptorProto
s Seq EnumDescriptorProto
-> EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Seq a -> a -> Seq a
|> EnumDescriptorProto
e})
        upTopExt :: FieldDescriptorProto
-> ParsecT [Lexed] FileDescriptorProto Identity ()
upTopExt FieldDescriptorProto
f   = (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {extension :: Seq FieldDescriptorProto
D.FileDescriptorProto.extension=FileDescriptorProto -> Seq FieldDescriptorProto
D.FileDescriptorProto.extension FileDescriptorProto
s Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
|> FieldDescriptorProto
f})

importFile,package,fileOption,service :: P D.FileDescriptorProto.FileDescriptorProto ()
importFile :: ParsecT [Lexed] FileDescriptorProto Identity ()
importFile = ByteString -> P FileDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"import") P FileDescriptorProto Utf8
-> P FileDescriptorProto Utf8 -> P FileDescriptorProto Utf8
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P FileDescriptorProto Utf8
forall s. P s Utf8
strLit P FileDescriptorProto Utf8
-> (Utf8 -> ParsecT [Lexed] FileDescriptorProto Identity ())
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Utf8
p -> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. P s ()
eol ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {dependency :: Seq Utf8
D.FileDescriptorProto.dependency=(FileDescriptorProto -> Seq Utf8
D.FileDescriptorProto.dependency FileDescriptorProto
s) Seq Utf8 -> Utf8 -> Seq Utf8
forall a. Seq a -> a -> Seq a
|> Utf8
p})

package :: ParsecT [Lexed] FileDescriptorProto Identity ()
package = ByteString -> P FileDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"package") P FileDescriptorProto Utf8
-> ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Utf8
p <- P FileDescriptorProto Utf8
forall s. P s Utf8
ident_package
  ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. P s ()
eol
  (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {package :: Maybe Utf8
D.FileDescriptorProto.package=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
p})

-- This parses the new extensible option name format of Google's protobuf verison 2.0.2
-- "foo.(bar.baz).qux" goes to Left [("foo",False),("bar.baz",True),("qux",False)]
pOptionE :: P s (Either D.UninterpretedOption String)
pOptionE :: P s (Either UninterpretedOption String)
pOptionE = do
  let pieces :: ParsecT [Lexed] u Identity [(Utf8, Bool)]
pieces = ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall u. ParsecT [Lexed] u Identity [(Utf8, Bool)]
withParens ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall u. ParsecT [Lexed] u Identity [(Utf8, Bool)]
withoutParens
      withParens :: ParsecT [Lexed] u Identity [(Utf8, Bool)]
withParens = do
        Utf8
part <- ParsecT [Lexed] u Identity ()
-> ParsecT [Lexed] u Identity ()
-> ParsecT [Lexed] u Identity Utf8
-> ParsecT [Lexed] u Identity Utf8
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT [Lexed] u Identity ()
forall s. Char -> P s ()
pChar Char
'(') (Char -> ParsecT [Lexed] u Identity ()
forall s. Char -> P s ()
pChar Char
')') ParsecT [Lexed] u Identity Utf8
forall s. P s Utf8
ident
        ([(Utf8, Bool)] -> [(Utf8, Bool)])
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Utf8
part,Bool
True) (Utf8, Bool) -> [(Utf8, Bool)] -> [(Utf8, Bool)]
forall a. a -> [a] -> [a]
:) ( [ParsecT [Lexed] u Identity [(Utf8, Bool)]]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Char -> ParsecT [Lexed] u Identity ()
forall s. Char -> P s ()
pChar Char
'=' ParsecT [Lexed] u Identity ()
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Utf8, Bool)] -> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                                      , Char -> ParsecT [Lexed] u Identity ()
forall s. Char -> P s ()
pChar Char
'.' ParsecT [Lexed] u Identity ()
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] u Identity [(Utf8, Bool)]
withParens
                                      , ParsecT [Lexed] u Identity [(Utf8, Bool)]
withoutParens ] )
      withoutParens :: ParsecT [Lexed] u Identity [(Utf8, Bool)]
withoutParens = do
        [Utf8]
parts <- (Utf8 -> [Utf8])
-> ParsecT [Lexed] u Identity Utf8
-> ParsecT [Lexed] u Identity [Utf8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Utf8 -> [Utf8]
forall a. Dotted a => a -> [a]
split ParsecT [Lexed] u Identity Utf8
forall s. P s Utf8
ident
        let prepend :: [(Utf8, Bool)] -> [(Utf8, Bool)]
prepend [(Utf8, Bool)]
rest = (Utf8 -> [(Utf8, Bool)] -> [(Utf8, Bool)])
-> [(Utf8, Bool)] -> [Utf8] -> [(Utf8, Bool)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Utf8
part [(Utf8, Bool)]
xs -> (Utf8
part,Bool
False)(Utf8, Bool) -> [(Utf8, Bool)] -> [(Utf8, Bool)]
forall a. a -> [a] -> [a]
:[(Utf8, Bool)]
xs) [(Utf8, Bool)]
rest [Utf8]
parts
        ([(Utf8, Bool)] -> [(Utf8, Bool)])
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Utf8, Bool)] -> [(Utf8, Bool)]
prepend ( [ParsecT [Lexed] u Identity [(Utf8, Bool)]]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ Char -> ParsecT [Lexed] u Identity ()
forall s. Char -> P s ()
pChar Char
'=' ParsecT [Lexed] u Identity ()
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [(Utf8, Bool)] -> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                              , Char -> ParsecT [Lexed] u Identity ()
forall s. Char -> P s ()
pChar Char
'.' ParsecT [Lexed] u Identity ()
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
-> ParsecT [Lexed] u Identity [(Utf8, Bool)]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] u Identity [(Utf8, Bool)]
withParens ] )
  [(Utf8, Bool)]
nameParts <- ParsecT [Lexed] s Identity [(Utf8, Bool)]
forall u. ParsecT [Lexed] u Identity [(Utf8, Bool)]
pieces
  case [(Utf8, Bool)]
nameParts of
    [(Utf8
optName,Bool
False)] -> Either UninterpretedOption String
-> P s (Either UninterpretedOption String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either UninterpretedOption String
forall a b. b -> Either a b
Right (Utf8 -> String
uToString Utf8
optName))
    [(Utf8, Bool)]
_ -> do UninterpretedOption
uno <- UninterpretedOption -> P s UninterpretedOption
forall s. UninterpretedOption -> P s UninterpretedOption
pUnValue ([(Utf8, Bool)] -> UninterpretedOption
makeUninterpetedOption [(Utf8, Bool)]
nameParts)
            Either UninterpretedOption String
-> P s (Either UninterpretedOption String)
forall (m :: * -> *) a. Monad m => a -> m a
return (UninterpretedOption -> Either UninterpretedOption String
forall a b. a -> Either a b
Left UninterpretedOption
uno)

pOptionWith :: P s t -> P s (Either D.UninterpretedOption String, t)
pOptionWith :: P s t -> P s (Either UninterpretedOption String, t)
pOptionWith = (Either UninterpretedOption String
 -> t -> (Either UninterpretedOption String, t))
-> ParsecT [Lexed] s Identity (Either UninterpretedOption String)
-> P s t
-> P s (Either UninterpretedOption String, t)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) (ByteString -> P s Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"option") P s Utf8
-> ParsecT [Lexed] s Identity (Either UninterpretedOption String)
-> ParsecT [Lexed] s Identity (Either UninterpretedOption String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] s Identity (Either UninterpretedOption String)
forall s. P s (Either UninterpretedOption String)
pOptionE)

-- This does not handle D.UninterpretedOption.aggregate_value yet
pUnValue :: D.UninterpretedOption -> P s D.UninterpretedOption
pUnValue :: UninterpretedOption -> P s UninterpretedOption
pUnValue UninterpretedOption
uno = P s Lexed
forall s. P s Lexed
getNextToken P s Lexed
-> (Lexed -> P s UninterpretedOption) -> P s UninterpretedOption
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Lexed -> P s UninterpretedOption
storeLexed where
  storeLexed :: Lexed -> P s UninterpretedOption
storeLexed (L_Name Line
_ ByteString
bs) = UninterpretedOption -> P s UninterpretedOption
forall (m :: * -> *) a. Monad m => a -> m a
return (UninterpretedOption -> P s UninterpretedOption)
-> UninterpretedOption -> P s UninterpretedOption
forall a b. (a -> b) -> a -> b
$ UninterpretedOption
uno {identifier_value :: Maybe Utf8
D.UninterpretedOption.identifier_value = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just (ByteString -> Utf8
Utf8 ByteString
bs)}
  storeLexed (L_Integer Line
_ Integer
i) | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 =
    UninterpretedOption -> P s UninterpretedOption
forall (m :: * -> *) a. Monad m => a -> m a
return (UninterpretedOption -> P s UninterpretedOption)
-> UninterpretedOption -> P s UninterpretedOption
forall a b. (a -> b) -> a -> b
$ UninterpretedOption
uno { positive_int_value :: Maybe Word64
D.UninterpretedOption.positive_int_value = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
i) }
                             | Bool
otherwise =
    UninterpretedOption -> P s UninterpretedOption
forall (m :: * -> *) a. Monad m => a -> m a
return (UninterpretedOption -> P s UninterpretedOption)
-> UninterpretedOption -> P s UninterpretedOption
forall a b. (a -> b) -> a -> b
$ UninterpretedOption
uno { negative_int_value :: Maybe Int64
D.UninterpretedOption.negative_int_value = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Integer -> Int64
forall a. Num a => Integer -> a
fromInteger Integer
i) }
  storeLexed (L_Double Line
_ Double
d) = UninterpretedOption -> P s UninterpretedOption
forall (m :: * -> *) a. Monad m => a -> m a
return (UninterpretedOption -> P s UninterpretedOption)
-> UninterpretedOption -> P s UninterpretedOption
forall a b. (a -> b) -> a -> b
$ UninterpretedOption
uno {double_value :: Maybe Double
D.UninterpretedOption.double_value = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
d }
  storeLexed (L_String Line
_ ByteString
_raw ByteString
bs) = UninterpretedOption -> P s UninterpretedOption
forall (m :: * -> *) a. Monad m => a -> m a
return (UninterpretedOption -> P s UninterpretedOption)
-> UninterpretedOption -> P s UninterpretedOption
forall a b. (a -> b) -> a -> b
$ UninterpretedOption
uno {string_value :: Maybe ByteString
D.UninterpretedOption.string_value = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs }
  storeLexed l :: Lexed
l@(L Line
_ Char
'{') = do [Lexed]
ls <- P s [Lexed]
forall s. P s [Lexed]
getAggregate
                              let bs :: Utf8
bs = String -> Utf8
uFromString (String -> Utf8) -> ([Lexed] -> String) -> [Lexed] -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Lexed -> String) -> [Lexed] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Lexed -> String
undoLexer ([Lexed] -> Utf8) -> [Lexed] -> Utf8
forall a b. (a -> b) -> a -> b
$ Lexed
lLexed -> [Lexed] -> [Lexed]
forall a. a -> [a] -> [a]
:[Lexed]
ls
                              UninterpretedOption -> P s UninterpretedOption
forall (m :: * -> *) a. Monad m => a -> m a
return (UninterpretedOption -> P s UninterpretedOption)
-> UninterpretedOption -> P s UninterpretedOption
forall a b. (a -> b) -> a -> b
$ UninterpretedOption
uno {aggregate_value :: Maybe Utf8
D.UninterpretedOption.aggregate_value = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
bs }
  storeLexed Lexed
_ = String -> P s UninterpretedOption
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> P s UninterpretedOption)
-> String -> P s UninterpretedOption
forall a b. (a -> b) -> a -> b
$ String
"Could not the parse value of an custom (uninterpreted) option"

makeUninterpetedOption :: [(Utf8,Bool)] -> D.UninterpretedOption
makeUninterpetedOption :: [(Utf8, Bool)] -> UninterpretedOption
makeUninterpetedOption [(Utf8, Bool)]
nameParts = UninterpretedOption
forall a. Default a => a
defaultValue { name :: Seq NamePart
D.UninterpretedOption.name = [NamePart] -> Seq NamePart
forall a. [a] -> Seq a
Seq.fromList ([NamePart] -> Seq NamePart)
-> ([(Utf8, Bool)] -> [NamePart]) -> [(Utf8, Bool)] -> Seq NamePart
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Utf8, Bool) -> NamePart) -> [(Utf8, Bool)] -> [NamePart]
forall a b. (a -> b) -> [a] -> [b]
map (Utf8, Bool) -> NamePart
makeNamePart ([(Utf8, Bool)] -> Seq NamePart) -> [(Utf8, Bool)] -> Seq NamePart
forall a b. (a -> b) -> a -> b
$ [(Utf8, Bool)]
nameParts }
  where makeNamePart :: (Utf8, Bool) -> NamePart
makeNamePart (Utf8
name_part,Bool
is_extension) = NamePart
forall a. Default a => a
defaultValue { name_part :: Utf8
D.NamePart.name_part = Utf8
name_part
                                                             , is_extension :: Bool
D.NamePart.is_extension =  Bool
is_extension }

fileOption :: ParsecT [Lexed] FileDescriptorProto Identity ()
fileOption = P FileDescriptorProto FileOptions
-> P FileDescriptorProto
     (Either UninterpretedOption String, FileOptions)
forall s t. P s t -> P s (Either UninterpretedOption String, t)
pOptionWith P FileDescriptorProto FileOptions
forall s. ParsecT s FileDescriptorProto Identity FileOptions
getOld P FileDescriptorProto
  (Either UninterpretedOption String, FileOptions)
-> ((Either UninterpretedOption String, FileOptions)
    -> P FileDescriptorProto FileOptions)
-> P FileDescriptorProto FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either UninterpretedOption String, FileOptions)
-> P FileDescriptorProto FileOptions
forall s.
(Either UninterpretedOption String, FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
setOption P FileDescriptorProto FileOptions
-> (FileOptions -> ParsecT [Lexed] FileDescriptorProto Identity ())
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FileOptions -> ParsecT [Lexed] FileDescriptorProto Identity ()
setNew ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. P s ()
eol where
  getOld :: ParsecT s FileDescriptorProto Identity FileOptions
getOld = (FileDescriptorProto -> FileOptions)
-> ParsecT s FileDescriptorProto Identity FileDescriptorProto
-> ParsecT s FileDescriptorProto Identity FileOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileOptions -> Maybe FileOptions -> FileOptions
forall a. a -> Maybe a -> a
fromMaybe FileOptions
forall a. Default a => a
defaultValue (Maybe FileOptions -> FileOptions)
-> (FileDescriptorProto -> Maybe FileOptions)
-> FileDescriptorProto
-> FileOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileDescriptorProto -> Maybe FileOptions
D.FileDescriptorProto.options) ParsecT s FileDescriptorProto Identity FileDescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  setNew :: FileOptions -> ParsecT [Lexed] FileDescriptorProto Identity ()
setNew FileOptions
p = (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {options :: Maybe FileOptions
D.FileDescriptorProto.options=FileOptions -> Maybe FileOptions
forall a. a -> Maybe a
Just FileOptions
p})
  setOption :: (Either UninterpretedOption String, FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
setOption (Left UninterpretedOption
uno,FileOptions
old) =
    FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {uninterpreted_option :: Seq UninterpretedOption
D.FileOptions.uninterpreted_option = FileOptions -> Seq UninterpretedOption
D.FileOptions.uninterpreted_option FileOptions
old Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
|> UninterpretedOption
uno})
  setOption (Right String
optName,FileOptions
old) =
    case String
optName of
      String
"java_package"          -> P s Utf8
forall s. P s Utf8
strLit  P s Utf8
-> (Utf8 -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Utf8
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {java_package :: Maybe Utf8
D.FileOptions.java_package        =Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
p})
      String
"java_outer_classname"  -> P s Utf8
forall s. P s Utf8
strLit  P s Utf8
-> (Utf8 -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Utf8
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {java_outer_classname :: Maybe Utf8
D.FileOptions.java_outer_classname=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
p})
      String
"java_multiple_files"   -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {java_multiple_files :: Maybe Bool
D.FileOptions.java_multiple_files =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"java_generate_equals_and_hash" -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {java_generate_equals_and_hash :: Maybe Bool
D.FileOptions.java_generate_equals_and_hash =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"java_string_check_utf8"-> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {java_string_check_utf8 :: Maybe Bool
D.FileOptions.java_string_check_utf8 = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"optimize_for"          -> P s OptimizeMode
forall s a. (Read a, ReflectEnum a) => P s a
enumLit P s OptimizeMode
-> (OptimizeMode -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \OptimizeMode
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {optimize_for :: Maybe OptimizeMode
D.FileOptions.optimize_for        =OptimizeMode -> Maybe OptimizeMode
forall a. a -> Maybe a
Just OptimizeMode
p})
      String
"go_package"            -> P s Utf8
forall s. P s Utf8
strLit  P s Utf8
-> (Utf8 -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Utf8
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {go_package :: Maybe Utf8
D.FileOptions.go_package          =Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
p})
      String
"cc_generic_services"   -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {cc_generic_services :: Maybe Bool
D.FileOptions.cc_generic_services =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"java_generic_services" -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {java_generic_services :: Maybe Bool
D.FileOptions.java_generic_services =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"py_generic_services"   -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {py_generic_services :: Maybe Bool
D.FileOptions.py_generic_services =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"deprecated"            -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {deprecated :: Maybe Bool
D.FileOptions.deprecated          =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"cc_enable_arenas"      -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {cc_enable_arenas :: Maybe Bool
D.FileOptions.cc_enable_arenas      =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"objc_class_prefix"     -> P s Utf8
forall s. P s Utf8
strLit  P s Utf8
-> (Utf8 -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Utf8
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {objc_class_prefix :: Maybe Utf8
D.FileOptions.objc_class_prefix   =Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
p})
      String
"csharp_namespace"      -> P s Utf8
forall s. P s Utf8
strLit  P s Utf8
-> (Utf8 -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Utf8
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {csharp_namespace :: Maybe Utf8
D.FileOptions.csharp_namespace    =Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
p})
      String
"javanano_use_deprecated_package" -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity FileOptions)
-> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FileOptions -> ParsecT [Lexed] s Identity FileOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FileOptions
old {javanano_use_deprecated_package :: Maybe Bool
D.FileOptions.javanano_use_deprecated_package =Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
_ -> String -> ParsecT [Lexed] s Identity FileOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> ParsecT [Lexed] s Identity FileOptions)
-> String -> ParsecT [Lexed] s Identity FileOptions
forall a b. (a -> b) -> a -> b
$ String
"FileOptions has no option named " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
optName

oneof :: (D.OneofDescriptorProto -> Seq D.FieldDescriptorProto -> P s ()) -> P s ()
oneof :: (OneofDescriptorProto -> Seq FieldDescriptorProto -> P s ())
-> P s ()
oneof OneofDescriptorProto -> Seq FieldDescriptorProto -> P s ()
up = ByteString -> P s Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"oneof") P s Utf8 -> P s () -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Utf8
self <- P s Utf8
forall s. P s Utf8
ident1
  (OneofDescriptorProto
o,Seq FieldDescriptorProto
fs) <- GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
-> (OneofDescriptorProto, Seq FieldDescriptorProto)
-> GenParser
     Lexed s (OneofDescriptorProto, Seq FieldDescriptorProto)
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall s. Char -> P s ()
pChar Char
'{' GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
subOneof) (OneofDescriptorProto
forall a. Default a => a
defaultValue {name :: Maybe Utf8
D.OneofDescriptorProto.name=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
self}, Seq FieldDescriptorProto
forall a. Seq a
Seq.empty)
  OneofDescriptorProto -> Seq FieldDescriptorProto -> P s ()
up OneofDescriptorProto
o Seq FieldDescriptorProto
fs

subOneof :: P (D.OneofDescriptorProto,Seq D.FieldDescriptorProto) ()
subOneof :: GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
subOneof = Char
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall s. Char -> P s ()
pChar Char
'}' GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([GenParser
   Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()]
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
                                 , P (OneofDescriptorProto, Seq FieldDescriptorProto)
  FieldDescriptorProto
forall s. P s FieldDescriptorProto
fieldOneof P (OneofDescriptorProto, Seq FieldDescriptorProto)
  FieldDescriptorProto
-> (FieldDescriptorProto
    -> GenParser
         Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ())
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldDescriptorProto
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall a a. a -> P (a, Seq a) ()
upMsgField] GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
-> GenParser
     Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed (OneofDescriptorProto, Seq FieldDescriptorProto) ()
subOneof)
  where upMsgField :: a -> P (a, Seq a) ()
upMsgField a
f = ((a, Seq a) -> (a, Seq a)) -> P (a, Seq a) ()
forall s. (s -> s) -> P s ()
update' (\(a
o,Seq a
fs) -> (a
o,Seq a
fs Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
|> a
f))                    


fieldOneof :: P s D.FieldDescriptorProto
fieldOneof :: P s FieldDescriptorProto
fieldOneof = do
  Utf8
sType <- P s Utf8
forall s. P s Utf8
ident
  -- parseType may return Nothing, this is fixed up in Text.ProtocolBuffers.ProtoCompile.Resolve.fqField
  let (Maybe Type
maybeTypeCode,Maybe Utf8
maybeTypeName) = case String -> Maybe Type
parseType (Utf8 -> String
uToString Utf8
sType) of
                                        Just Type
t -> (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
t,Maybe Utf8
forall a. Maybe a
Nothing)
                                        Maybe Type
Nothing -> (Maybe Type
forall a. Maybe a
Nothing, Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
sType)
  Utf8
name <- P s Utf8
forall s. P s Utf8
ident1
  Int32
number <- Char -> P s ()
forall s. Char -> P s ()
pChar Char
'=' P s ()
-> ParsecT [Lexed] s Identity Int32
-> ParsecT [Lexed] s Identity Int32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] s Identity Int32
forall a s. Num a => P s a
fieldInt
  let v1 :: FieldDescriptorProto
v1 = FieldDescriptorProto
forall a. Default a => a
defaultValue { name :: Maybe Utf8
D.FieldDescriptorProto.name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
name
                        , number :: Maybe Int32
D.FieldDescriptorProto.number = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
number
                        , label :: Maybe Label
D.FieldDescriptorProto.label = Label -> Maybe Label
forall a. a -> Maybe a
Just Label
LABEL_OPTIONAL
                        , type' :: Maybe Type
D.FieldDescriptorProto.type' = Maybe Type
maybeTypeCode
                        , type_name :: Maybe Utf8
D.FieldDescriptorProto.type_name = Maybe Utf8
maybeTypeName
                        }
  P s ()
forall s. P s ()
eol P s () -> P s FieldDescriptorProto -> P s FieldDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FieldDescriptorProto -> P s FieldDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FieldDescriptorProto
v1

message :: (D.DescriptorProto -> P s ()) -> P s ()
message :: (DescriptorProto -> P s ()) -> P s ()
message DescriptorProto -> P s ()
up = ByteString -> P s Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"message") P s Utf8 -> P s () -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Utf8
self <- P s Utf8
forall s. P s Utf8
ident1
  DescriptorProto -> P s ()
up (DescriptorProto -> P s ())
-> ParsecT [Lexed] s Identity DescriptorProto -> P s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenParser Lexed DescriptorProto ()
-> DescriptorProto -> ParsecT [Lexed] s Identity DescriptorProto
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char -> GenParser Lexed DescriptorProto ()
forall s. Char -> P s ()
pChar Char
'{' GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed DescriptorProto ()
subMessage) (DescriptorProto
forall a. Default a => a
defaultValue {name :: Maybe Utf8
D.DescriptorProto.name=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
self})

-- subMessage is also used to parse group declarations
subMessage,messageOption,extensions :: P D.DescriptorProto.DescriptorProto ()
subMessage :: GenParser Lexed DescriptorProto ()
subMessage = (Char -> GenParser Lexed DescriptorProto ()
forall s. Char -> P s ()
pChar Char
'}') GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([GenParser Lexed DescriptorProto ()]
-> GenParser Lexed DescriptorProto ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ GenParser Lexed DescriptorProto ()
forall s. P s ()
eol
                                     , (DescriptorProto -> GenParser Lexed DescriptorProto ())
-> Maybe Utf8 -> P DescriptorProto FieldDescriptorProto
forall s.
(DescriptorProto -> P s ())
-> Maybe Utf8 -> P s FieldDescriptorProto
field DescriptorProto -> GenParser Lexed DescriptorProto ()
upNestedMsg Maybe Utf8
forall a. Maybe a
Nothing P DescriptorProto FieldDescriptorProto
-> (FieldDescriptorProto -> GenParser Lexed DescriptorProto ())
-> GenParser Lexed DescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldDescriptorProto -> GenParser Lexed DescriptorProto ()
upMsgField
                                     , (DescriptorProto -> GenParser Lexed DescriptorProto ())
-> GenParser Lexed DescriptorProto ()
forall s. (DescriptorProto -> P s ()) -> P s ()
message DescriptorProto -> GenParser Lexed DescriptorProto ()
upNestedMsg
                                     , (EnumDescriptorProto -> GenParser Lexed DescriptorProto ())
-> GenParser Lexed DescriptorProto ()
forall s. (EnumDescriptorProto -> P s ()) -> P s ()
enum EnumDescriptorProto -> GenParser Lexed DescriptorProto ()
upNestedEnum
                                     , (OneofDescriptorProto
 -> Seq FieldDescriptorProto -> GenParser Lexed DescriptorProto ())
-> GenParser Lexed DescriptorProto ()
forall s.
(OneofDescriptorProto -> Seq FieldDescriptorProto -> P s ())
-> P s ()
oneof OneofDescriptorProto
-> Seq FieldDescriptorProto -> GenParser Lexed DescriptorProto ()
upMsgOneof
                                     , GenParser Lexed DescriptorProto ()
extensions
                                     , (DescriptorProto -> GenParser Lexed DescriptorProto ())
-> (FieldDescriptorProto -> GenParser Lexed DescriptorProto ())
-> GenParser Lexed DescriptorProto ()
forall s.
(DescriptorProto -> P s ())
-> (FieldDescriptorProto -> P s ()) -> P s ()
extend DescriptorProto -> GenParser Lexed DescriptorProto ()
upNestedMsg FieldDescriptorProto -> GenParser Lexed DescriptorProto ()
upExtField
                                     , GenParser Lexed DescriptorProto ()
messageOption] GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed DescriptorProto ()
subMessage
                                     )
  where upNestedMsg :: DescriptorProto -> GenParser Lexed DescriptorProto ()
upNestedMsg DescriptorProto
msg = (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\DescriptorProto
s -> DescriptorProto
s {nested_type :: Seq DescriptorProto
D.DescriptorProto.nested_type=DescriptorProto -> Seq DescriptorProto
D.DescriptorProto.nested_type DescriptorProto
s Seq DescriptorProto -> DescriptorProto -> Seq DescriptorProto
forall a. Seq a -> a -> Seq a
|> DescriptorProto
msg})
        upNestedEnum :: EnumDescriptorProto -> GenParser Lexed DescriptorProto ()
upNestedEnum EnumDescriptorProto
e  = (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\DescriptorProto
s -> DescriptorProto
s {enum_type :: Seq EnumDescriptorProto
D.DescriptorProto.enum_type=DescriptorProto -> Seq EnumDescriptorProto
D.DescriptorProto.enum_type DescriptorProto
s Seq EnumDescriptorProto
-> EnumDescriptorProto -> Seq EnumDescriptorProto
forall a. Seq a -> a -> Seq a
|> EnumDescriptorProto
e})
        upMsgField :: FieldDescriptorProto -> GenParser Lexed DescriptorProto ()
upMsgField FieldDescriptorProto
f    = (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\DescriptorProto
s -> DescriptorProto
s {field :: Seq FieldDescriptorProto
D.DescriptorProto.field=DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.field DescriptorProto
s Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
|> FieldDescriptorProto
f})
        upMsgOneof :: OneofDescriptorProto
-> Seq FieldDescriptorProto -> GenParser Lexed DescriptorProto ()
upMsgOneof OneofDescriptorProto
o Seq FieldDescriptorProto
xs  = (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall s. (s -> s) -> P s ()
update' ((DescriptorProto -> DescriptorProto)
 -> GenParser Lexed DescriptorProto ())
-> (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall a b. (a -> b) -> a -> b
$ \DescriptorProto
s ->
          let n :: Line
n = Seq OneofDescriptorProto -> Line
forall a. Seq a -> Line
Seq.length (DescriptorProto -> Seq OneofDescriptorProto
D.DescriptorProto.oneof_decl DescriptorProto
s)
              xs' :: Seq FieldDescriptorProto
xs' = (FieldDescriptorProto -> FieldDescriptorProto)
-> Seq FieldDescriptorProto -> Seq FieldDescriptorProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FieldDescriptorProto
s -> FieldDescriptorProto
s { oneof_index :: Maybe Int32
D.FieldDescriptorProto.oneof_index = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Line -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Line
n) }) Seq FieldDescriptorProto
xs
          in DescriptorProto
s {oneof_decl :: Seq OneofDescriptorProto
D.DescriptorProto.oneof_decl=DescriptorProto -> Seq OneofDescriptorProto
D.DescriptorProto.oneof_decl DescriptorProto
s Seq OneofDescriptorProto
-> OneofDescriptorProto -> Seq OneofDescriptorProto
forall a. Seq a -> a -> Seq a
|> OneofDescriptorProto
o
               ,field :: Seq FieldDescriptorProto
D.DescriptorProto.field=DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.field DescriptorProto
s Seq FieldDescriptorProto
-> Seq FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> Seq a -> Seq a
>< Seq FieldDescriptorProto
xs'
               }
           
        upExtField :: FieldDescriptorProto -> GenParser Lexed DescriptorProto ()
upExtField FieldDescriptorProto
f    = (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\DescriptorProto
s -> DescriptorProto
s {extension :: Seq FieldDescriptorProto
D.DescriptorProto.extension=DescriptorProto -> Seq FieldDescriptorProto
D.DescriptorProto.extension DescriptorProto
s Seq FieldDescriptorProto
-> FieldDescriptorProto -> Seq FieldDescriptorProto
forall a. Seq a -> a -> Seq a
|> FieldDescriptorProto
f})

messageOption :: GenParser Lexed DescriptorProto ()
messageOption = P DescriptorProto MessageOptions
-> P DescriptorProto
     (Either UninterpretedOption String, MessageOptions)
forall s t. P s t -> P s (Either UninterpretedOption String, t)
pOptionWith P DescriptorProto MessageOptions
forall s. ParsecT s DescriptorProto Identity MessageOptions
getOld P DescriptorProto
  (Either UninterpretedOption String, MessageOptions)
-> ((Either UninterpretedOption String, MessageOptions)
    -> P DescriptorProto MessageOptions)
-> P DescriptorProto MessageOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either UninterpretedOption String, MessageOptions)
-> P DescriptorProto MessageOptions
forall s.
(Either UninterpretedOption String, MessageOptions)
-> ParsecT [Lexed] s Identity MessageOptions
setOption P DescriptorProto MessageOptions
-> (MessageOptions -> GenParser Lexed DescriptorProto ())
-> GenParser Lexed DescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MessageOptions -> GenParser Lexed DescriptorProto ()
setNew GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed DescriptorProto ()
forall s. P s ()
eol where
  getOld :: ParsecT s DescriptorProto Identity MessageOptions
getOld = (DescriptorProto -> MessageOptions)
-> ParsecT s DescriptorProto Identity DescriptorProto
-> ParsecT s DescriptorProto Identity MessageOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MessageOptions -> Maybe MessageOptions -> MessageOptions
forall a. a -> Maybe a -> a
fromMaybe MessageOptions
forall a. Default a => a
defaultValue (Maybe MessageOptions -> MessageOptions)
-> (DescriptorProto -> Maybe MessageOptions)
-> DescriptorProto
-> MessageOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DescriptorProto -> Maybe MessageOptions
D.DescriptorProto.options) ParsecT s DescriptorProto Identity DescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  setNew :: MessageOptions -> GenParser Lexed DescriptorProto ()
setNew MessageOptions
p = (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\DescriptorProto
s -> DescriptorProto
s {options :: Maybe MessageOptions
D.DescriptorProto.options=MessageOptions -> Maybe MessageOptions
forall a. a -> Maybe a
Just MessageOptions
p})
  setOption :: (Either UninterpretedOption String, MessageOptions)
-> ParsecT [Lexed] s Identity MessageOptions
setOption (Left UninterpretedOption
uno,MessageOptions
old) =
    MessageOptions -> ParsecT [Lexed] s Identity MessageOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (MessageOptions
old {uninterpreted_option :: Seq UninterpretedOption
D.MessageOptions.uninterpreted_option = MessageOptions -> Seq UninterpretedOption
D.MessageOptions.uninterpreted_option MessageOptions
old Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
|> UninterpretedOption
uno })
  setOption (Right String
optName,MessageOptions
old) =
    case String
optName of
      String
"message_set_wire_format" -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity MessageOptions)
-> ParsecT [Lexed] s Identity MessageOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> MessageOptions -> ParsecT [Lexed] s Identity MessageOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (MessageOptions
old {message_set_wire_format :: Maybe Bool
D.MessageOptions.message_set_wire_format=Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
"no_standard_descriptor_accessor" -> P s Bool
forall s. P s Bool
boolLit P s Bool
-> (Bool -> ParsecT [Lexed] s Identity MessageOptions)
-> ParsecT [Lexed] s Identity MessageOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> MessageOptions -> ParsecT [Lexed] s Identity MessageOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (MessageOptions
old {no_standard_descriptor_accessor :: Maybe Bool
D.MessageOptions.no_standard_descriptor_accessor=Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
_ -> String -> ParsecT [Lexed] s Identity MessageOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> ParsecT [Lexed] s Identity MessageOptions)
-> String -> ParsecT [Lexed] s Identity MessageOptions
forall a b. (a -> b) -> a -> b
$ String
"MessageOptions has no option named "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optName

extend :: (D.DescriptorProto -> P s ()) -> (D.FieldDescriptorProto -> P s ()) -> P s ()
extend :: (DescriptorProto -> P s ())
-> (FieldDescriptorProto -> P s ()) -> P s ()
extend DescriptorProto -> P s ()
upGroup FieldDescriptorProto -> P s ()
upField = ByteString -> P s Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"extend") P s Utf8 -> P s () -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Utf8
typeExtendee <- P s Utf8
forall s. P s Utf8
ident
  Char -> P s ()
forall s. Char -> P s ()
pChar Char
'{'
  let rest :: P s ()
rest = ((DescriptorProto -> P s ())
-> Maybe Utf8 -> P s FieldDescriptorProto
forall s.
(DescriptorProto -> P s ())
-> Maybe Utf8 -> P s FieldDescriptorProto
field DescriptorProto -> P s ()
upGroup (Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
typeExtendee) P s FieldDescriptorProto
-> (FieldDescriptorProto -> P s ()) -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldDescriptorProto -> P s ()
upField) P s () -> P s () -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P s ()
forall s. P s ()
eols P s () -> P s () -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> P s ()
forall s. Char -> P s ()
pChar Char
'}' P s () -> P s () -> P s ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> P s ()
rest)
  P s ()
forall s. P s ()
eols P s () -> P s () -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> P s ()
rest

field :: (D.DescriptorProto -> P s ()) -> Maybe Utf8 -> P s D.FieldDescriptorProto
field :: (DescriptorProto -> P s ())
-> Maybe Utf8 -> P s FieldDescriptorProto
field DescriptorProto -> P s ()
upGroup Maybe Utf8
maybeExtendee = do
  let allowedLabels :: [String]
allowedLabels = case Maybe Utf8
maybeExtendee of
                        Maybe Utf8
Nothing -> [String
"optional",String
"repeated",String
"required"]
                        Just {} -> [String
"optional",String
"repeated"] -- cannot declare a required extension and an oneof extension. 
  Utf8
sLabel <- [ParsecT [Lexed] s Identity Utf8]
-> ParsecT [Lexed] s Identity Utf8
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice ([ParsecT [Lexed] s Identity Utf8]
 -> ParsecT [Lexed] s Identity Utf8)
-> ([String] -> [ParsecT [Lexed] s Identity Utf8])
-> [String]
-> ParsecT [Lexed] s Identity Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ParsecT [Lexed] s Identity Utf8)
-> [String] -> [ParsecT [Lexed] s Identity Utf8]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> ParsecT [Lexed] s Identity Utf8
forall s. ByteString -> P s Utf8
pName (ByteString -> ParsecT [Lexed] s Identity Utf8)
-> (String -> ByteString)
-> String
-> ParsecT [Lexed] s Identity Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
U.fromString) ([String] -> ParsecT [Lexed] s Identity Utf8)
-> [String] -> ParsecT [Lexed] s Identity Utf8
forall a b. (a -> b) -> a -> b
$ [String]
allowedLabels
  Label
theLabel <- ParsecT [Lexed] s Identity Label
-> (Label -> ParsecT [Lexed] s Identity Label)
-> Maybe Label
-> ParsecT [Lexed] s Identity Label
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ParsecT [Lexed] s Identity Label
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"not a valid Label :"String -> String -> String
forall a. [a] -> [a] -> [a]
++Utf8 -> String
forall a. Show a => a -> String
show Utf8
sLabel)) Label -> ParsecT [Lexed] s Identity Label
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Maybe Label
parseLabel (Utf8 -> String
uToString Utf8
sLabel))
  Utf8
sType <- ParsecT [Lexed] s Identity Utf8
forall s. P s Utf8
ident
  -- parseType may return Nothing, this is fixed up in Text.ProtocolBuffers.ProtoCompile.Resolve.fqField
  let (Maybe Type
maybeTypeCode,Maybe Utf8
maybeTypeName) = case String -> Maybe Type
parseType (Utf8 -> String
uToString Utf8
sType) of
                                        Just Type
t -> (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
t,Maybe Utf8
forall a. Maybe a
Nothing)
                                        Maybe Type
Nothing -> (Maybe Type
forall a. Maybe a
Nothing, Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
sType)
  Utf8
name <- ParsecT [Lexed] s Identity Utf8
forall s. P s Utf8
ident1
  Int32
number <- Char -> P s ()
forall s. Char -> P s ()
pChar Char
'=' P s ()
-> ParsecT [Lexed] s Identity Int32
-> ParsecT [Lexed] s Identity Int32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] s Identity Int32
forall a s. Num a => P s a
fieldInt
  let v1 :: FieldDescriptorProto
v1 = FieldDescriptorProto
forall a. Default a => a
defaultValue { name :: Maybe Utf8
D.FieldDescriptorProto.name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
name
                        , number :: Maybe Int32
D.FieldDescriptorProto.number = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
number
                        , label :: Maybe Label
D.FieldDescriptorProto.label = Label -> Maybe Label
forall a. a -> Maybe a
Just Label
theLabel
                        , type' :: Maybe Type
D.FieldDescriptorProto.type' = Maybe Type
maybeTypeCode
                        , type_name :: Maybe Utf8
D.FieldDescriptorProto.type_name = Maybe Utf8
maybeTypeName
                        , extendee :: Maybe Utf8
D.FieldDescriptorProto.extendee = Maybe Utf8
maybeExtendee }
  if Maybe Type
maybeTypeCode Maybe Type -> Maybe Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type -> Maybe Type
forall a. a -> Maybe a
Just Type
TYPE_GROUP
    then do let nameString :: String
nameString = Utf8 -> String
uToString Utf8
name
            Bool -> P s () -> P s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
nameString) (String -> P s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Impossible? ident1 for field name was empty")
            Bool -> P s () -> P s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Char -> Bool
isUpper (String -> Char
forall a. [a] -> a
head String
nameString))) (String -> P s ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> P s ()) -> String -> P s ()
forall a b. (a -> b) -> a -> b
$ String
"Group names must start with an upper case letter: "String -> String -> String
forall a. [a] -> [a] -> [a]
++Utf8 -> String
forall a. Show a => a -> String
show Utf8
name)
            DescriptorProto -> P s ()
upGroup (DescriptorProto -> P s ())
-> ParsecT [Lexed] s Identity DescriptorProto -> P s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenParser Lexed DescriptorProto ()
-> DescriptorProto -> ParsecT [Lexed] s Identity DescriptorProto
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char -> GenParser Lexed DescriptorProto ()
forall s. Char -> P s ()
pChar Char
'{' GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed DescriptorProto ()
subMessage) (DescriptorProto
forall a. Default a => a
defaultValue {name :: Maybe Utf8
D.DescriptorProto.name=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
name})
            let fieldName :: Maybe Utf8
fieldName = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just (Utf8 -> Maybe Utf8) -> Utf8 -> Maybe Utf8
forall a b. (a -> b) -> a -> b
$ String -> Utf8
uFromString ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
nameString)  -- down-case the whole name
                v :: FieldDescriptorProto
v = FieldDescriptorProto
v1 { name :: Maybe Utf8
D.FieldDescriptorProto.name = Maybe Utf8
fieldName
                       , type_name :: Maybe Utf8
D.FieldDescriptorProto.type_name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
name }
            FieldDescriptorProto -> P s FieldDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FieldDescriptorProto
v
    else (P s ()
forall s. P s ()
eol P s () -> P s FieldDescriptorProto -> P s FieldDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FieldDescriptorProto -> P s FieldDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return FieldDescriptorProto
v1) P s FieldDescriptorProto
-> P s FieldDescriptorProto -> P s FieldDescriptorProto
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (GenParser Lexed FieldDescriptorProto ()
-> FieldDescriptorProto -> P s FieldDescriptorProto
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char -> GenParser Lexed FieldDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'[' GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Label -> Maybe Type -> GenParser Lexed FieldDescriptorProto ()
subField Label
theLabel Maybe Type
maybeTypeCode) FieldDescriptorProto
v1)

subField,defaultConstant :: Label -> Maybe Type -> P D.FieldDescriptorProto ()
subField :: Label -> Maybe Type -> GenParser Lexed FieldDescriptorProto ()
subField Label
label Maybe Type
mt = do
  (Label -> Maybe Type -> GenParser Lexed FieldDescriptorProto ()
defaultConstant Label
label Maybe Type
mt GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Label -> Maybe Type -> GenParser Lexed FieldDescriptorProto ()
fieldOption Label
label Maybe Type
mt) GenParser Lexed FieldDescriptorProto ()
-> String -> GenParser Lexed FieldDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"expected \"default\" or a fieldOption"
  (Char -> GenParser Lexed FieldDescriptorProto ()
forall s. Char -> P s ()
pChar Char
']' GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed FieldDescriptorProto ()
forall s. P s ()
eol) GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> GenParser Lexed FieldDescriptorProto ()
forall s. Char -> P s ()
pChar Char
',' GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Label -> Maybe Type -> GenParser Lexed FieldDescriptorProto ()
subField Label
label Maybe Type
mt)

defaultConstant :: Label -> Maybe Type -> GenParser Lexed FieldDescriptorProto ()
defaultConstant Label
LABEL_REPEATED Maybe Type
_ = ByteString -> P FieldDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"default") P FieldDescriptorProto Utf8
-> GenParser Lexed FieldDescriptorProto ()
-> GenParser Lexed FieldDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> GenParser Lexed FieldDescriptorProto ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Repeated fields cannot have a default value"
defaultConstant Label
_ Maybe Type
mt = do
  Utf8
_ <- ByteString -> P FieldDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"default")
  Maybe ByteString
maybeDefault <- Char -> GenParser Lexed FieldDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'=' GenParser Lexed FieldDescriptorProto ()
-> ParsecT [Lexed] FieldDescriptorProto Identity (Maybe ByteString)
-> ParsecT [Lexed] FieldDescriptorProto Identity (Maybe ByteString)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ByteString -> Maybe ByteString)
-> ParsecT [Lexed] FieldDescriptorProto Identity ByteString
-> ParsecT [Lexed] FieldDescriptorProto Identity (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Maybe Type
-> ParsecT [Lexed] FieldDescriptorProto Identity ByteString
forall s. Maybe Type -> P s ByteString
constant Maybe Type
mt)
  -- XXX Hack: we lie about Utf8 for the default_value below
  (FieldDescriptorProto -> FieldDescriptorProto)
-> GenParser Lexed FieldDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\FieldDescriptorProto
s -> FieldDescriptorProto
s { default_value :: Maybe Utf8
D.FieldDescriptorProto.default_value = (ByteString -> Utf8) -> Maybe ByteString -> Maybe Utf8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Utf8
Utf8 Maybe ByteString
maybeDefault })

-- This does a type and range safe parsing of the default value,
-- except for enum constants which cannot be checked (the definition
-- may not have been parsed yet).
--
-- Double and Float are checked to be not-Nan and not-Inf.  The
-- int-like types are checked to be within the corresponding range.
constant :: Maybe Type -> P s ByteString
-- With Nothing the next item may be an enum constant or a '{' and an aggregate.
constant :: Maybe Type -> P s ByteString
constant Maybe Type
Nothing = P s ByteString
forall s. ParsecT [Lexed] s Identity ByteString
enumIdent P s ByteString -> String -> P s ByteString
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"expected the name of an enum or a curly-brace-enclosed aggregate value"
  where enumIdent :: ParsecT [Lexed] s Identity ByteString
enumIdent = (Utf8 -> ByteString)
-> ParsecT [Lexed] s Identity Utf8
-> ParsecT [Lexed] s Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Utf8 -> ByteString
utf8 ParsecT [Lexed] s Identity Utf8
forall s. P s Utf8
ident1 -- hopefully a matching enum; forget about Utf8
constant (Just Type
t) =
  case Type
t of
    Type
TYPE_DOUBLE  -> do Double
d <- P s Double
forall s. P s Double
doubleLit
--                       when (isNaN d || isInfinite d)
--                            (fail $ "default floating point literal "++show d++" is out of range for type "++show t)
                       ByteString -> P s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return' (Utf8 -> ByteString
utf8 (Utf8 -> ByteString) -> (Double -> Utf8) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8
uFromString (String -> Utf8) -> (Double -> String) -> Double -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> String
forall a. (Show a, RealFloat a) => a -> String
showRF (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
d)
    Type
TYPE_FLOAT   -> do Float
fl <- P s Float
forall s. P s Float
floatLit
{-
                       let fl :: Float
                           fl = read (show d)
--                       when (isNaN fl || isInfinite fl || (d==0) /= (fl==0))
--                            (fail $ "default floating point literal "++show d++" is out of range for type "++show t)
                       when (isNaN fl /= isNaN d || isInfinite fl /= isInfinite d  || (d==0) /= (fl==0))
                            (fail $ "default floating point literal "++show d++" is out of range for type "++show t)
-}
                       ByteString -> P s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return' (Utf8 -> ByteString
utf8 (Utf8 -> ByteString) -> (Float -> Utf8) -> Float -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8
uFromString (String -> Utf8) -> (Float -> String) -> Float -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> String
forall a. (Show a, RealFloat a) => a -> String
showRF (Float -> ByteString) -> Float -> ByteString
forall a b. (a -> b) -> a -> b
$ Float
fl)
    Type
TYPE_BOOL    -> P s Bool
forall s. P s Bool
boolLit P s Bool -> (Bool -> P s ByteString) -> P s ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
b -> ByteString -> P s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return' (ByteString -> P s ByteString) -> ByteString -> P s ByteString
forall a b. (a -> b) -> a -> b
$ if Bool
b then ByteString
true else ByteString
false
    Type
TYPE_STRING  -> P s Utf8
forall s. P s Utf8
strLit P s Utf8 -> (Utf8 -> P s ByteString) -> P s ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> P s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> P s ByteString)
-> (Utf8 -> ByteString) -> Utf8 -> P s ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8 -> ByteString
utf8
    Type
TYPE_BYTES   -> P s ByteString
forall s. ParsecT [Lexed] s Identity ByteString
bsLit
    Type
TYPE_GROUP   -> String -> P s ByteString
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> P s ByteString) -> String -> P s ByteString
forall a b. (a -> b) -> a -> b
$ String
"cannot have a default for field of "String -> String -> String
forall a. [a] -> [a] -> [a]
++Type -> String
forall a. Show a => a -> String
show Type
t
    Type
TYPE_MESSAGE -> String -> P s ByteString
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> P s ByteString) -> String -> P s ByteString
forall a b. (a -> b) -> a -> b
$ String
"cannot have a default for field of "String -> String -> String
forall a. [a] -> [a] -> [a]
++Type -> String
forall a. Show a => a -> String
show Type
t
    Type
TYPE_ENUM    -> (Utf8 -> ByteString) -> P s Utf8 -> P s ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Utf8 -> ByteString
utf8 P s Utf8
forall s. P s Utf8
ident1 -- IMPOSSIBLE : SHOULD HAVE HAD Maybe Type PARAMETER match Nothing
    Type
TYPE_SFIXED32 -> Int32 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Int32
forall a. HasCallStack => a
undefined :: Int32)
    Type
TYPE_SINT32   -> Int32 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Int32
forall a. HasCallStack => a
undefined :: Int32)
    Type
TYPE_INT32    -> Int32 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Int32
forall a. HasCallStack => a
undefined :: Int32)
    Type
TYPE_SFIXED64 -> Int64 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Int64
forall a. HasCallStack => a
undefined :: Int64)
    Type
TYPE_SINT64   -> Int64 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Int64
forall a. HasCallStack => a
undefined :: Int64)
    Type
TYPE_INT64    -> Int64 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Int64
forall a. HasCallStack => a
undefined :: Int64)
    Type
TYPE_FIXED32  -> Word32 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Word32
forall a. HasCallStack => a
undefined :: Word32)
    Type
TYPE_UINT32   -> Word32 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Word32
forall a. HasCallStack => a
undefined :: Word32)
    Type
TYPE_FIXED64  -> Word64 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Word64
forall a. HasCallStack => a
undefined :: Word64)
    Type
TYPE_UINT64   -> Word64 -> P s ByteString
forall a s. (Bounded a, Integral a) => a -> P s ByteString
f (Word64
forall a. HasCallStack => a
undefined :: Word64)
  where f :: (Bounded a,Integral a) => a -> P s ByteString
        f :: a -> P s ByteString
f a
u = do let range :: (Integer, Integer)
range = (a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
minBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
u),a -> Integer
forall a. Integral a => a -> Integer
toInteger (a
forall a. Bounded a => a
maxBound a -> a -> a
forall a. a -> a -> a
`asTypeOf` a
u))
                 Integer
i <- P s Integer
forall a s. Num a => P s a
intLit
                 Bool
-> ParsecT [Lexed] s Identity () -> ParsecT [Lexed] s Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ((Integer, Integer) -> Integer -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (Integer, Integer)
range Integer
i))
                      (String -> ParsecT [Lexed] s Identity ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT [Lexed] s Identity ())
-> String -> ParsecT [Lexed] s Identity ()
forall a b. (a -> b) -> a -> b
$ String
"default integer value "String -> String -> String
forall a. [a] -> [a] -> [a]
++Integer -> String
forall a. Show a => a -> String
show Integer
iString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" is out of range for type "String -> String -> String
forall a. [a] -> [a] -> [a]
++Type -> String
forall a. Show a => a -> String
show Type
t)
                 ByteString -> P s ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return' (Utf8 -> ByteString
utf8 (Utf8 -> ByteString) -> (Integer -> Utf8) -> Integer -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Utf8
uFromString (String -> Utf8) -> (Integer -> String) -> Integer -> Utf8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show (Integer -> ByteString) -> Integer -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer
i)

fieldOption :: Label -> Maybe Type -> P D.FieldDescriptorProto ()
fieldOption :: Label -> Maybe Type -> GenParser Lexed FieldDescriptorProto ()
fieldOption Label
label Maybe Type
mt = (Either UninterpretedOption String
 -> FieldOptions
 -> (Either UninterpretedOption String, FieldOptions))
-> ParsecT
     [Lexed]
     FieldDescriptorProto
     Identity
     (Either UninterpretedOption String)
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
-> ParsecT
     [Lexed]
     FieldDescriptorProto
     Identity
     (Either UninterpretedOption String, FieldOptions)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ParsecT
  [Lexed]
  FieldDescriptorProto
  Identity
  (Either UninterpretedOption String)
forall s. P s (Either UninterpretedOption String)
pOptionE ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall s. ParsecT s FieldDescriptorProto Identity FieldOptions
getOld ParsecT
  [Lexed]
  FieldDescriptorProto
  Identity
  (Either UninterpretedOption String, FieldOptions)
-> ((Either UninterpretedOption String, FieldOptions)
    -> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions)
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either UninterpretedOption String, FieldOptions)
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
setOption ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
-> (FieldOptions -> GenParser Lexed FieldDescriptorProto ())
-> GenParser Lexed FieldDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldOptions -> GenParser Lexed FieldDescriptorProto ()
setNew where
  getOld :: ParsecT s FieldDescriptorProto Identity FieldOptions
getOld = (FieldDescriptorProto -> FieldOptions)
-> ParsecT s FieldDescriptorProto Identity FieldDescriptorProto
-> ParsecT s FieldDescriptorProto Identity FieldOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FieldOptions -> Maybe FieldOptions -> FieldOptions
forall a. a -> Maybe a -> a
fromMaybe FieldOptions
forall a. Default a => a
defaultValue (Maybe FieldOptions -> FieldOptions)
-> (FieldDescriptorProto -> Maybe FieldOptions)
-> FieldDescriptorProto
-> FieldOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDescriptorProto -> Maybe FieldOptions
D.FieldDescriptorProto.options) ParsecT s FieldDescriptorProto Identity FieldDescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  setNew :: FieldOptions -> GenParser Lexed FieldDescriptorProto ()
setNew FieldOptions
p = (FieldDescriptorProto -> FieldDescriptorProto)
-> GenParser Lexed FieldDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\FieldDescriptorProto
s -> FieldDescriptorProto
s { options :: Maybe FieldOptions
D.FieldDescriptorProto.options = FieldOptions -> Maybe FieldOptions
forall a. a -> Maybe a
Just FieldOptions
p })
  setOption :: (Either UninterpretedOption String, FieldOptions)
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
setOption (Left UninterpretedOption
uno,FieldOptions
old) =
    FieldOptions
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FieldOptions
old {uninterpreted_option :: Seq UninterpretedOption
D.FieldOptions.uninterpreted_option = FieldOptions -> Seq UninterpretedOption
D.FieldOptions.uninterpreted_option FieldOptions
old Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
|> UninterpretedOption
uno })
  setOption (Right String
optName,FieldOptions
old) =
    case String
optName of
      String
"ctype" | (Type -> Maybe Type
forall a. a -> Maybe a
Just Type
TYPE_STRING) Maybe Type -> Maybe Type -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Type
mt -> do
        P FieldDescriptorProto CType
forall s a. (Read a, ReflectEnum a) => P s a
enumLit P FieldDescriptorProto CType
-> (CType
    -> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions)
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CType
p -> FieldOptions
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FieldOptions
old {ctype :: Maybe CType
D.FieldOptions.ctype=CType -> Maybe CType
forall a. a -> Maybe a
Just CType
p})
              | Bool
otherwise -> String
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String
 -> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions)
-> String
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall a b. (a -> b) -> a -> b
$ String
"field option cyte is only defined for string fields"
      -- "experimental_map_key" | Nothing == mt -> do
       -- strLit >>= \p -> return' (old {D.FieldOptions.experimental_map_key=Just p})
       --                      | otherwise -> unexpected $ "field option experimental_map_key is only defined for messages"
      String
"packed" | Label -> Maybe Type -> Bool
isValidPacked Label
label Maybe Type
mt -> do
        P FieldDescriptorProto Bool
forall s. P s Bool
boolLit P FieldDescriptorProto Bool
-> (Bool
    -> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions)
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FieldOptions
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FieldOptions
old {packed :: Maybe Bool
D.FieldOptions.packed=Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
               | Bool
otherwise -> String
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String
 -> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions)
-> String
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall a b. (a -> b) -> a -> b
$ String
"field option packed is not defined for this kind of field"
      String
"deprecated" -> P FieldDescriptorProto Bool
forall s. P s Bool
boolLit P FieldDescriptorProto Bool
-> (Bool
    -> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions)
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
p -> FieldOptions
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (FieldOptions
old {deprecated :: Maybe Bool
D.FieldOptions.deprecated=Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
p})
      String
_ -> String
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String
 -> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions)
-> String
-> ParsecT [Lexed] FieldDescriptorProto Identity FieldOptions
forall a b. (a -> b) -> a -> b
$ String
"FieldOptions has no option named "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optName

isValidPacked :: Label -> Maybe Type -> Bool
isValidPacked :: Label -> Maybe Type -> Bool
isValidPacked Label
LABEL_REPEATED Maybe Type
Nothing = Bool
True -- provisional, okay if Enum but wrong if Message, checked in Resolve.fqField
isValidPacked Label
LABEL_REPEATED (Just Type
typeCode) =
  case Type
typeCode of
    Type
TYPE_STRING -> Bool
False
    Type
TYPE_GROUP -> Bool
False
    Type
TYPE_BYTES -> Bool
False
    Type
TYPE_MESSAGE -> Bool
False -- Impossible value for typeCode from parseType, but here for completeness
    Type
TYPE_ENUM -> Bool
True     -- Impossible value for typeCode from parseType, but here for completeness
    Type
_ -> Bool
True
isValidPacked Label
_ Maybe Type
_ = Bool
False

enum :: (D.EnumDescriptorProto -> P s ()) -> P s ()
enum :: (EnumDescriptorProto -> P s ()) -> P s ()
enum EnumDescriptorProto -> P s ()
up = ByteString -> P s Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"enum") P s Utf8 -> P s () -> P s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Utf8
self <- P s Utf8
forall s. P s Utf8
ident1
  EnumDescriptorProto -> P s ()
up (EnumDescriptorProto -> P s ())
-> ParsecT [Lexed] s Identity EnumDescriptorProto -> P s ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< GenParser Lexed EnumDescriptorProto ()
-> EnumDescriptorProto
-> ParsecT [Lexed] s Identity EnumDescriptorProto
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char -> GenParser Lexed EnumDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'{' GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed EnumDescriptorProto ()
subEnum) (EnumDescriptorProto
forall a. Default a => a
defaultValue {name :: Maybe Utf8
D.EnumDescriptorProto.name=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
self})

subEnum,enumOption :: P D.EnumDescriptorProto.EnumDescriptorProto ()
subEnum :: GenParser Lexed EnumDescriptorProto ()
subEnum = GenParser Lexed EnumDescriptorProto ()
forall s. P s ()
eols GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed EnumDescriptorProto ()
rest -- Note: Must check enumOption before enumVal
  where rest :: GenParser Lexed EnumDescriptorProto ()
rest = (GenParser Lexed EnumDescriptorProto ()
enumOption GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Lexed EnumDescriptorProto ()
enumVal) GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed EnumDescriptorProto ()
forall s. P s ()
eols GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Char -> GenParser Lexed EnumDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'}' GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Lexed EnumDescriptorProto ()
rest)

enumOption :: GenParser Lexed EnumDescriptorProto ()
enumOption = P EnumDescriptorProto EnumOptions
-> P EnumDescriptorProto
     (Either UninterpretedOption String, EnumOptions)
forall s t. P s t -> P s (Either UninterpretedOption String, t)
pOptionWith P EnumDescriptorProto EnumOptions
forall s. ParsecT s EnumDescriptorProto Identity EnumOptions
getOld P EnumDescriptorProto
  (Either UninterpretedOption String, EnumOptions)
-> ((Either UninterpretedOption String, EnumOptions)
    -> P EnumDescriptorProto EnumOptions)
-> P EnumDescriptorProto EnumOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either UninterpretedOption String, EnumOptions)
-> P EnumDescriptorProto EnumOptions
forall s (m :: * -> *) t u.
Stream s m t =>
(Either UninterpretedOption String, EnumOptions)
-> ParsecT s u m EnumOptions
setOption P EnumDescriptorProto EnumOptions
-> (EnumOptions -> GenParser Lexed EnumDescriptorProto ())
-> GenParser Lexed EnumDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumOptions -> GenParser Lexed EnumDescriptorProto ()
setNew GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
-> GenParser Lexed EnumDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed EnumDescriptorProto ()
forall s. P s ()
eol where
  getOld :: ParsecT s EnumDescriptorProto Identity EnumOptions
getOld = (EnumDescriptorProto -> EnumOptions)
-> ParsecT s EnumDescriptorProto Identity EnumDescriptorProto
-> ParsecT s EnumDescriptorProto Identity EnumOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EnumOptions -> Maybe EnumOptions -> EnumOptions
forall a. a -> Maybe a -> a
fromMaybe EnumOptions
forall a. Default a => a
defaultValue (Maybe EnumOptions -> EnumOptions)
-> (EnumDescriptorProto -> Maybe EnumOptions)
-> EnumDescriptorProto
-> EnumOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumDescriptorProto -> Maybe EnumOptions
D.EnumDescriptorProto.options) ParsecT s EnumDescriptorProto Identity EnumDescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  setNew :: EnumOptions -> GenParser Lexed EnumDescriptorProto ()
setNew EnumOptions
p = (EnumDescriptorProto -> EnumDescriptorProto)
-> GenParser Lexed EnumDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\EnumDescriptorProto
s -> EnumDescriptorProto
s {options :: Maybe EnumOptions
D.EnumDescriptorProto.options=EnumOptions -> Maybe EnumOptions
forall a. a -> Maybe a
Just EnumOptions
p})
  setOption :: (Either UninterpretedOption String, EnumOptions)
-> ParsecT s u m EnumOptions
setOption (Left UninterpretedOption
uno,EnumOptions
old) =
    EnumOptions -> ParsecT s u m EnumOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (EnumOptions -> ParsecT s u m EnumOptions)
-> EnumOptions -> ParsecT s u m EnumOptions
forall a b. (a -> b) -> a -> b
$  (EnumOptions
old {uninterpreted_option :: Seq UninterpretedOption
D.EnumOptions.uninterpreted_option = EnumOptions -> Seq UninterpretedOption
D.EnumOptions.uninterpreted_option EnumOptions
old Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
|> UninterpretedOption
uno })
  setOption (Right String
optName,EnumOptions
_old) =
    case String
optName of
      String
_ -> String -> ParsecT s u m EnumOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> ParsecT s u m EnumOptions)
-> String -> ParsecT s u m EnumOptions
forall a b. (a -> b) -> a -> b
$ String
"EnumOptions has no option named "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optName

enumVal :: P D.EnumDescriptorProto ()
enumVal :: GenParser Lexed EnumDescriptorProto ()
enumVal = do
  Utf8
name <- P EnumDescriptorProto Utf8
forall s. P s Utf8
ident1
  Int32
number <- Char -> GenParser Lexed EnumDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'=' GenParser Lexed EnumDescriptorProto ()
-> ParsecT [Lexed] EnumDescriptorProto Identity Int32
-> ParsecT [Lexed] EnumDescriptorProto Identity Int32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT [Lexed] EnumDescriptorProto Identity Int32
forall a s. Num a => P s a
enumInt
  let v1 :: EnumValueDescriptorProto
v1 = EnumValueDescriptorProto
forall a. Default a => a
defaultValue { name :: Maybe Utf8
D.EnumValueDescriptorProto.name = Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
name
                        , number :: Maybe Int32
D.EnumValueDescriptorProto.number = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
number }
  EnumValueDescriptorProto
v <- (GenParser Lexed EnumDescriptorProto ()
forall s. P s ()
eol GenParser Lexed EnumDescriptorProto ()
-> ParsecT
     [Lexed] EnumDescriptorProto Identity EnumValueDescriptorProto
-> ParsecT
     [Lexed] EnumDescriptorProto Identity EnumValueDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> EnumValueDescriptorProto
-> ParsecT
     [Lexed] EnumDescriptorProto Identity EnumValueDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return EnumValueDescriptorProto
v1) ParsecT
  [Lexed] EnumDescriptorProto Identity EnumValueDescriptorProto
-> ParsecT
     [Lexed] EnumDescriptorProto Identity EnumValueDescriptorProto
-> ParsecT
     [Lexed] EnumDescriptorProto Identity EnumValueDescriptorProto
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Lexed EnumValueDescriptorProto ()
-> EnumValueDescriptorProto
-> ParsecT
     [Lexed] EnumDescriptorProto Identity EnumValueDescriptorProto
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char -> GenParser Lexed EnumValueDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'[' GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed EnumValueDescriptorProto ()
subEnumValue) EnumValueDescriptorProto
v1
  (EnumDescriptorProto -> EnumDescriptorProto)
-> GenParser Lexed EnumDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\EnumDescriptorProto
s -> EnumDescriptorProto
s {value :: Seq EnumValueDescriptorProto
D.EnumDescriptorProto.value=EnumDescriptorProto -> Seq EnumValueDescriptorProto
D.EnumDescriptorProto.value EnumDescriptorProto
s Seq EnumValueDescriptorProto
-> EnumValueDescriptorProto -> Seq EnumValueDescriptorProto
forall a. Seq a -> a -> Seq a
|> EnumValueDescriptorProto
v})

subEnumValue,enumValueOption :: P D.EnumValueDescriptorProto ()
subEnumValue :: GenParser Lexed EnumValueDescriptorProto ()
subEnumValue = GenParser Lexed EnumValueDescriptorProto ()
enumValueOption GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ( (Char -> GenParser Lexed EnumValueDescriptorProto ()
forall s. Char -> P s ()
pChar Char
']' GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed EnumValueDescriptorProto ()
forall s. P s ()
eol) GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> GenParser Lexed EnumValueDescriptorProto ()
forall s. Char -> P s ()
pChar Char
',' GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
-> GenParser Lexed EnumValueDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed EnumValueDescriptorProto ()
subEnumValue) )

enumValueOption :: GenParser Lexed EnumValueDescriptorProto ()
enumValueOption = (Either UninterpretedOption String
 -> EnumValueOptions
 -> (Either UninterpretedOption String, EnumValueOptions))
-> ParsecT
     [Lexed]
     EnumValueDescriptorProto
     Identity
     (Either UninterpretedOption String)
-> ParsecT
     [Lexed] EnumValueDescriptorProto Identity EnumValueOptions
-> ParsecT
     [Lexed]
     EnumValueDescriptorProto
     Identity
     (Either UninterpretedOption String, EnumValueOptions)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) ParsecT
  [Lexed]
  EnumValueDescriptorProto
  Identity
  (Either UninterpretedOption String)
forall s. P s (Either UninterpretedOption String)
pOptionE ParsecT [Lexed] EnumValueDescriptorProto Identity EnumValueOptions
forall s.
ParsecT s EnumValueDescriptorProto Identity EnumValueOptions
getOld ParsecT
  [Lexed]
  EnumValueDescriptorProto
  Identity
  (Either UninterpretedOption String, EnumValueOptions)
-> ((Either UninterpretedOption String, EnumValueOptions)
    -> ParsecT
         [Lexed] EnumValueDescriptorProto Identity EnumValueOptions)
-> ParsecT
     [Lexed] EnumValueDescriptorProto Identity EnumValueOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either UninterpretedOption String, EnumValueOptions)
-> ParsecT
     [Lexed] EnumValueDescriptorProto Identity EnumValueOptions
forall s (m :: * -> *) t u.
Stream s m t =>
(Either UninterpretedOption String, EnumValueOptions)
-> ParsecT s u m EnumValueOptions
setOption ParsecT [Lexed] EnumValueDescriptorProto Identity EnumValueOptions
-> (EnumValueOptions
    -> GenParser Lexed EnumValueDescriptorProto ())
-> GenParser Lexed EnumValueDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EnumValueOptions -> GenParser Lexed EnumValueDescriptorProto ()
setNew where
  getOld :: ParsecT s EnumValueDescriptorProto Identity EnumValueOptions
getOld = (EnumValueDescriptorProto -> EnumValueOptions)
-> ParsecT
     s EnumValueDescriptorProto Identity EnumValueDescriptorProto
-> ParsecT s EnumValueDescriptorProto Identity EnumValueOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (EnumValueOptions -> Maybe EnumValueOptions -> EnumValueOptions
forall a. a -> Maybe a -> a
fromMaybe EnumValueOptions
forall a. Default a => a
defaultValue (Maybe EnumValueOptions -> EnumValueOptions)
-> (EnumValueDescriptorProto -> Maybe EnumValueOptions)
-> EnumValueDescriptorProto
-> EnumValueOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumValueDescriptorProto -> Maybe EnumValueOptions
D.EnumValueDescriptorProto.options) ParsecT
  s EnumValueDescriptorProto Identity EnumValueDescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  setNew :: EnumValueOptions -> GenParser Lexed EnumValueDescriptorProto ()
setNew EnumValueOptions
p = (EnumValueDescriptorProto -> EnumValueDescriptorProto)
-> GenParser Lexed EnumValueDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\EnumValueDescriptorProto
s -> EnumValueDescriptorProto
s {options :: Maybe EnumValueOptions
D.EnumValueDescriptorProto.options=EnumValueOptions -> Maybe EnumValueOptions
forall a. a -> Maybe a
Just EnumValueOptions
p})
  setOption :: (Either UninterpretedOption String, EnumValueOptions)
-> ParsecT s u m EnumValueOptions
setOption (Left UninterpretedOption
uno,EnumValueOptions
old) =
    EnumValueOptions -> ParsecT s u m EnumValueOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (EnumValueOptions -> ParsecT s u m EnumValueOptions)
-> EnumValueOptions -> ParsecT s u m EnumValueOptions
forall a b. (a -> b) -> a -> b
$  (EnumValueOptions
old {uninterpreted_option :: Seq UninterpretedOption
D.EnumValueOptions.uninterpreted_option = EnumValueOptions -> Seq UninterpretedOption
D.EnumValueOptions.uninterpreted_option EnumValueOptions
old Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
|> UninterpretedOption
uno })
  setOption (Right String
optName,EnumValueOptions
_old) =
    case String
optName of
      String
_ -> String -> ParsecT s u m EnumValueOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> ParsecT s u m EnumValueOptions)
-> String -> ParsecT s u m EnumValueOptions
forall a b. (a -> b) -> a -> b
$ String
"EnumValueOptions has no option named "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optName

extensions :: GenParser Lexed DescriptorProto ()
extensions = ByteString -> P DescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"extensions") P DescriptorProto Utf8
-> GenParser Lexed DescriptorProto ()
-> GenParser Lexed DescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Int32
start <- P DescriptorProto Int32
forall a s. Num a => P s a
fieldInt
  let noEnd :: P DescriptorProto Int32
noEnd = GenParser Lexed DescriptorProto ()
forall s. P s ()
eol GenParser Lexed DescriptorProto ()
-> P DescriptorProto Int32 -> P DescriptorProto Int32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int32 -> P DescriptorProto Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Int32
forall a. Enum a => a -> a
succ Int32
start)
      toEnd :: ParsecT [Lexed] s Identity Int32
toEnd = ByteString -> P s Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"to") P s Utf8
-> ParsecT [Lexed] s Identity Int32
-> ParsecT [Lexed] s Identity Int32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (ParsecT [Lexed] s Identity Int32
forall a s. Num a => P s a
fieldInt ParsecT [Lexed] s Identity Int32
-> ParsecT [Lexed] s Identity Int32
-> ParsecT [Lexed] s Identity Int32
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ByteString -> P s Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"max") P s Utf8
-> ParsecT [Lexed] s Identity Int32
-> ParsecT [Lexed] s Identity Int32
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int32 -> ParsecT [Lexed] s Identity Int32
forall (m :: * -> *) a. Monad m => a -> m a
return (FieldId -> Int32
getFieldId FieldId
forall a. Bounded a => a
maxBound)))
  Int32
end <- [P DescriptorProto Int32] -> P DescriptorProto Int32
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ P DescriptorProto Int32
noEnd, P DescriptorProto Int32
forall s. ParsecT [Lexed] s Identity Int32
toEnd ]
  let e :: ExtensionRange
e = ExtensionRange
forall a. Default a => a
defaultValue { start :: Maybe Int32
D.ExtensionRange.start = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just Int32
start
                       , end :: Maybe Int32
D.ExtensionRange.end = Int32 -> Maybe Int32
forall a. a -> Maybe a
Just (Int32 -> Int32
forall a. Enum a => a -> a
succ Int32
end) }  -- One _past_ the end!
  (DescriptorProto -> DescriptorProto)
-> GenParser Lexed DescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\DescriptorProto
s -> DescriptorProto
s {extension_range :: Seq ExtensionRange
D.DescriptorProto.extension_range=DescriptorProto -> Seq ExtensionRange
D.DescriptorProto.extension_range DescriptorProto
s Seq ExtensionRange -> ExtensionRange -> Seq ExtensionRange
forall a. Seq a -> a -> Seq a
|> ExtensionRange
e})

service :: ParsecT [Lexed] FileDescriptorProto Identity ()
service = ByteString -> P FileDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"service") P FileDescriptorProto Utf8
-> ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Utf8
name <- P FileDescriptorProto Utf8
forall s. P s Utf8
ident1
  ServiceDescriptorProto
f <- GenParser Lexed ServiceDescriptorProto ()
-> ServiceDescriptorProto
-> GenParser Lexed FileDescriptorProto ServiceDescriptorProto
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char -> GenParser Lexed ServiceDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'{' GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed ServiceDescriptorProto ()
subService) (ServiceDescriptorProto
forall a. Default a => a
defaultValue {name :: Maybe Utf8
D.ServiceDescriptorProto.name=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
name})
  (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {service :: Seq ServiceDescriptorProto
D.FileDescriptorProto.service=FileDescriptorProto -> Seq ServiceDescriptorProto
D.FileDescriptorProto.service FileDescriptorProto
s Seq ServiceDescriptorProto
-> ServiceDescriptorProto -> Seq ServiceDescriptorProto
forall a. Seq a -> a -> Seq a
|> ServiceDescriptorProto
f})

 where subService :: GenParser Lexed ServiceDescriptorProto ()
subService = Char -> GenParser Lexed ServiceDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'}' GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([GenParser Lexed ServiceDescriptorProto ()]
-> GenParser Lexed ServiceDescriptorProto ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ GenParser Lexed ServiceDescriptorProto ()
forall s. P s ()
eol, GenParser Lexed ServiceDescriptorProto ()
rpc, GenParser Lexed ServiceDescriptorProto ()
serviceOption ] GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed ServiceDescriptorProto ()
subService)

syntax :: ParsecT [Lexed] FileDescriptorProto Identity ()
syntax = ByteString -> P FileDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"syntax") P FileDescriptorProto Utf8
-> ParsecT [Lexed] FileDescriptorProto Identity ()
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Char -> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. Char -> P s ()
pChar Char
'=' 
  Utf8
p <- P FileDescriptorProto Utf8
forall s. P s Utf8
strLit
  (FileDescriptorProto -> FileDescriptorProto)
-> ParsecT [Lexed] FileDescriptorProto Identity ()
forall s. (s -> s) -> P s ()
update' (\FileDescriptorProto
s -> FileDescriptorProto
s {syntax :: Maybe Utf8
D.FileDescriptorProto.syntax=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
p})

serviceOption,rpc :: P D.ServiceDescriptorProto ()
serviceOption :: GenParser Lexed ServiceDescriptorProto ()
serviceOption = P ServiceDescriptorProto ServiceOptions
-> P ServiceDescriptorProto
     (Either UninterpretedOption String, ServiceOptions)
forall s t. P s t -> P s (Either UninterpretedOption String, t)
pOptionWith P ServiceDescriptorProto ServiceOptions
forall s. ParsecT s ServiceDescriptorProto Identity ServiceOptions
getOld P ServiceDescriptorProto
  (Either UninterpretedOption String, ServiceOptions)
-> ((Either UninterpretedOption String, ServiceOptions)
    -> P ServiceDescriptorProto ServiceOptions)
-> P ServiceDescriptorProto ServiceOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either UninterpretedOption String, ServiceOptions)
-> P ServiceDescriptorProto ServiceOptions
forall s (m :: * -> *) t u.
Stream s m t =>
(Either UninterpretedOption String, ServiceOptions)
-> ParsecT s u m ServiceOptions
setOption P ServiceDescriptorProto ServiceOptions
-> (ServiceOptions -> GenParser Lexed ServiceDescriptorProto ())
-> GenParser Lexed ServiceDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ServiceOptions -> GenParser Lexed ServiceDescriptorProto ()
setNew GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed ServiceDescriptorProto ()
forall s. P s ()
eol where
  getOld :: ParsecT s ServiceDescriptorProto Identity ServiceOptions
getOld = (ServiceDescriptorProto -> ServiceOptions)
-> ParsecT s ServiceDescriptorProto Identity ServiceDescriptorProto
-> ParsecT s ServiceDescriptorProto Identity ServiceOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ServiceOptions -> Maybe ServiceOptions -> ServiceOptions
forall a. a -> Maybe a -> a
fromMaybe ServiceOptions
forall a. Default a => a
defaultValue (Maybe ServiceOptions -> ServiceOptions)
-> (ServiceDescriptorProto -> Maybe ServiceOptions)
-> ServiceDescriptorProto
-> ServiceOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServiceDescriptorProto -> Maybe ServiceOptions
D.ServiceDescriptorProto.options) ParsecT s ServiceDescriptorProto Identity ServiceDescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  setNew :: ServiceOptions -> GenParser Lexed ServiceDescriptorProto ()
setNew ServiceOptions
p = (ServiceDescriptorProto -> ServiceDescriptorProto)
-> GenParser Lexed ServiceDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\ServiceDescriptorProto
s -> ServiceDescriptorProto
s {options :: Maybe ServiceOptions
D.ServiceDescriptorProto.options=ServiceOptions -> Maybe ServiceOptions
forall a. a -> Maybe a
Just ServiceOptions
p})
  setOption :: (Either UninterpretedOption String, ServiceOptions)
-> ParsecT s u m ServiceOptions
setOption (Left UninterpretedOption
uno,ServiceOptions
old) =
    ServiceOptions -> ParsecT s u m ServiceOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (ServiceOptions
old {uninterpreted_option :: Seq UninterpretedOption
D.ServiceOptions.uninterpreted_option = ServiceOptions -> Seq UninterpretedOption
D.ServiceOptions.uninterpreted_option ServiceOptions
old Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
|> UninterpretedOption
uno })
  setOption (Right String
optName,ServiceOptions
_old) =
    case String
optName of
      String
_ -> String -> ParsecT s u m ServiceOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> ParsecT s u m ServiceOptions)
-> String -> ParsecT s u m ServiceOptions
forall a b. (a -> b) -> a -> b
$ String
"ServiceOptions has no option named "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optName

rpc :: GenParser Lexed ServiceDescriptorProto ()
rpc = ByteString -> P ServiceDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"rpc") P ServiceDescriptorProto Utf8
-> GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
  Utf8
name <- P ServiceDescriptorProto Utf8
forall s. P s Utf8
ident1
  Utf8
input <- GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
-> P ServiceDescriptorProto Utf8
-> P ServiceDescriptorProto Utf8
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> GenParser Lexed ServiceDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'(') (Char -> GenParser Lexed ServiceDescriptorProto ()
forall s. Char -> P s ()
pChar Char
')') P ServiceDescriptorProto Utf8
forall s. P s Utf8
ident
  Utf8
_ <- ByteString -> P ServiceDescriptorProto Utf8
forall s. ByteString -> P s Utf8
pName (String -> ByteString
U.fromString String
"returns")
  Utf8
output <- GenParser Lexed ServiceDescriptorProto ()
-> GenParser Lexed ServiceDescriptorProto ()
-> P ServiceDescriptorProto Utf8
-> P ServiceDescriptorProto Utf8
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> GenParser Lexed ServiceDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'(') (Char -> GenParser Lexed ServiceDescriptorProto ()
forall s. Char -> P s ()
pChar Char
')') P ServiceDescriptorProto Utf8
forall s. P s Utf8
ident
  let m1 :: MethodDescriptorProto
m1 = MethodDescriptorProto
forall a. Default a => a
defaultValue { name :: Maybe Utf8
D.MethodDescriptorProto.name=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
name
                        , input_type :: Maybe Utf8
D.MethodDescriptorProto.input_type=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
input
                        , output_type :: Maybe Utf8
D.MethodDescriptorProto.output_type=Utf8 -> Maybe Utf8
forall a. a -> Maybe a
Just Utf8
output }
  MethodDescriptorProto
m <- (GenParser Lexed ServiceDescriptorProto ()
forall s. P s ()
eol GenParser Lexed ServiceDescriptorProto ()
-> ParsecT
     [Lexed] ServiceDescriptorProto Identity MethodDescriptorProto
-> ParsecT
     [Lexed] ServiceDescriptorProto Identity MethodDescriptorProto
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MethodDescriptorProto
-> ParsecT
     [Lexed] ServiceDescriptorProto Identity MethodDescriptorProto
forall (m :: * -> *) a. Monad m => a -> m a
return MethodDescriptorProto
m1) ParsecT
  [Lexed] ServiceDescriptorProto Identity MethodDescriptorProto
-> ParsecT
     [Lexed] ServiceDescriptorProto Identity MethodDescriptorProto
-> ParsecT
     [Lexed] ServiceDescriptorProto Identity MethodDescriptorProto
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> GenParser Lexed MethodDescriptorProto ()
-> MethodDescriptorProto
-> ParsecT
     [Lexed] ServiceDescriptorProto Identity MethodDescriptorProto
forall t sSub a s.
Show t =>
GenParser t sSub a -> sSub -> GenParser t s sSub
subParser (Char -> GenParser Lexed MethodDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'{' GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed MethodDescriptorProto ()
subRpc) MethodDescriptorProto
m1
  (ServiceDescriptorProto -> ServiceDescriptorProto)
-> GenParser Lexed ServiceDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\ServiceDescriptorProto
s -> ServiceDescriptorProto
s {method :: Seq MethodDescriptorProto
D.ServiceDescriptorProto.method=ServiceDescriptorProto -> Seq MethodDescriptorProto
D.ServiceDescriptorProto.method ServiceDescriptorProto
s Seq MethodDescriptorProto
-> MethodDescriptorProto -> Seq MethodDescriptorProto
forall a. Seq a -> a -> Seq a
|> MethodDescriptorProto
m})

subRpc,rpcOption :: P D.MethodDescriptorProto ()
subRpc :: GenParser Lexed MethodDescriptorProto ()
subRpc = Char -> GenParser Lexed MethodDescriptorProto ()
forall s. Char -> P s ()
pChar Char
'}' GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ([GenParser Lexed MethodDescriptorProto ()]
-> GenParser Lexed MethodDescriptorProto ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ GenParser Lexed MethodDescriptorProto ()
forall s. P s ()
eol, GenParser Lexed MethodDescriptorProto ()
rpcOption ] GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed MethodDescriptorProto ()
subRpc)

rpcOption :: GenParser Lexed MethodDescriptorProto ()
rpcOption = P MethodDescriptorProto MethodOptions
-> P MethodDescriptorProto
     (Either UninterpretedOption String, MethodOptions)
forall s t. P s t -> P s (Either UninterpretedOption String, t)
pOptionWith P MethodDescriptorProto MethodOptions
forall s. ParsecT s MethodDescriptorProto Identity MethodOptions
getOld P MethodDescriptorProto
  (Either UninterpretedOption String, MethodOptions)
-> ((Either UninterpretedOption String, MethodOptions)
    -> P MethodDescriptorProto MethodOptions)
-> P MethodDescriptorProto MethodOptions
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either UninterpretedOption String, MethodOptions)
-> P MethodDescriptorProto MethodOptions
forall s (m :: * -> *) t u.
Stream s m t =>
(Either UninterpretedOption String, MethodOptions)
-> ParsecT s u m MethodOptions
setOption P MethodDescriptorProto MethodOptions
-> (MethodOptions -> GenParser Lexed MethodDescriptorProto ())
-> GenParser Lexed MethodDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MethodOptions -> GenParser Lexed MethodDescriptorProto ()
setNew GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
-> GenParser Lexed MethodDescriptorProto ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Lexed MethodDescriptorProto ()
forall s. P s ()
eol where
  getOld :: ParsecT s MethodDescriptorProto Identity MethodOptions
getOld = (MethodDescriptorProto -> MethodOptions)
-> ParsecT s MethodDescriptorProto Identity MethodDescriptorProto
-> ParsecT s MethodDescriptorProto Identity MethodOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (MethodOptions -> Maybe MethodOptions -> MethodOptions
forall a. a -> Maybe a -> a
fromMaybe MethodOptions
forall a. Default a => a
defaultValue (Maybe MethodOptions -> MethodOptions)
-> (MethodDescriptorProto -> Maybe MethodOptions)
-> MethodDescriptorProto
-> MethodOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MethodDescriptorProto -> Maybe MethodOptions
D.MethodDescriptorProto.options) ParsecT s MethodDescriptorProto Identity MethodDescriptorProto
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState
  setNew :: MethodOptions -> GenParser Lexed MethodDescriptorProto ()
setNew MethodOptions
p = (MethodDescriptorProto -> MethodDescriptorProto)
-> GenParser Lexed MethodDescriptorProto ()
forall s. (s -> s) -> P s ()
update' (\MethodDescriptorProto
s -> MethodDescriptorProto
s {options :: Maybe MethodOptions
D.MethodDescriptorProto.options=MethodOptions -> Maybe MethodOptions
forall a. a -> Maybe a
Just MethodOptions
p})
  setOption :: (Either UninterpretedOption String, MethodOptions)
-> ParsecT s u m MethodOptions
setOption (Left UninterpretedOption
uno,MethodOptions
old) =
    MethodOptions -> ParsecT s u m MethodOptions
forall (m :: * -> *) a. Monad m => a -> m a
return' (MethodOptions -> ParsecT s u m MethodOptions)
-> MethodOptions -> ParsecT s u m MethodOptions
forall a b. (a -> b) -> a -> b
$  (MethodOptions
old {uninterpreted_option :: Seq UninterpretedOption
D.MethodOptions.uninterpreted_option = MethodOptions -> Seq UninterpretedOption
D.MethodOptions.uninterpreted_option MethodOptions
old Seq UninterpretedOption
-> UninterpretedOption -> Seq UninterpretedOption
forall a. Seq a -> a -> Seq a
|> UninterpretedOption
uno })
  setOption (Right String
optName,MethodOptions
_old) =
    case String
optName of
      String
_ -> String -> ParsecT s u m MethodOptions
forall s (m :: * -> *) t u a.
Stream s m t =>
String -> ParsecT s u m a
unexpected (String -> ParsecT s u m MethodOptions)
-> String -> ParsecT s u m MethodOptions
forall a b. (a -> b) -> a -> b
$ String
"MethodOptions has no option named "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
optName

-- see google's stubs/strutil.cc lines 398-449/1121 and C99 specification
-- This mainly targets three digit octal codes
cEncode :: [Word8] -> [Char]
cEncode :: [Word8] -> String
cEncode = (Word8 -> String) -> [Word8] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Word8 -> String
one where
  one :: Word8 -> [Char]
  -- special non-octal escaped values
  one :: Word8 -> String
one Word8
9 = Char -> String
sl  Char
't'
  one Word8
10 = Char -> String
sl Char
'n'
  one Word8
13 = Char -> String
sl Char
'r'
  one Word8
34 = Char -> String
sl Char
'"'
  one Word8
39 = Char -> String
sl Char
'\''
  one Word8
92 = Char -> String
sl Char
'\\'
  -- main case of unescaped value
  one Word8
x | (Word8
32 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
x) Bool -> Bool -> Bool
&& (Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
127) = [Line -> Char
forall a. Enum a => Line -> a
toEnum (Line -> Char) -> (Word8 -> Line) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Word8 -> Line
forall a. Enum a => a -> Line
fromEnum (Word8 -> Char) -> Word8 -> Char
forall a b. (a -> b) -> a -> b
$  Word8
x]
  -- below are the octal escaped values.  This always emits 3 digits.
  one Word8
0 = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:String
"000"
  one Word8
x | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
8 = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:(Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showOct Word8
x String
"")
        | Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
64 = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
'0'Char -> String -> String
forall a. a -> [a] -> [a]
:(Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showOct Word8
x String
"")
        | Bool
otherwise = Char
'\\'Char -> String -> String
forall a. a -> [a] -> [a]
:(Word8 -> String -> String
forall a. (Integral a, Show a) => a -> String -> String
showOct Word8
x String
"")
  sl :: Char -> String
sl Char
c = [Char
'\\',Char
c]

showRF :: (Show a, RealFloat a) => a -> String
showRF :: a -> String
showRF a
x | a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x = String
"nan"
         | a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x = if a
0 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x then String
"inf" else String
"-inf"
         | Bool
otherwise = a -> String
forall a. Show a => a -> String
show a
x

-- Aggregate
{-
data Lexed = L_Integer !Int !Integer
           | L_Double !Int !Double
           | L_Name !Int !L.ByteString
           | L_String !Int !L.ByteString !L.ByteString
           | L !Int !Char
           | L_Error !Int !String
           -}

undoLexer :: Lexed -> String
undoLexer :: Lexed -> String
undoLexer (L_Integer Line
_ Integer
integer) = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:Integer -> String
forall a. Show a => a -> String
show Integer
integer
undoLexer (L_Double Line
_ Double
double) = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:Double -> String
forall a. (Show a, RealFloat a) => a -> String
showRF Double
double
undoLexer (L_Name Line
_ ByteString
bs) = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:ByteString -> String
U.toString ByteString
bs
undoLexer (L_String Line
_ ByteString
_ ByteString
bs) = let middle :: [Word8]
middle = ByteString -> [Word8]
L.unpack ByteString
bs
                                  encoded :: String
encoded = [Word8] -> String
cEncode [Word8]
middle  -- escapes both quote and double-quote
                                  s :: String
s = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String
encoded String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
                              in Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:String
s
undoLexer (L Line
_ Char
'{') = String
" {\n"
undoLexer (L Line
_ Char
'}') = String
" }\n"
undoLexer (L Line
_ Char
';') = String
";\n"
undoLexer (L Line
_ Char
char) = Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:[Char
char]
undoLexer (L_Error Line
_ String
errorMessage) = String -> String
forall a. HasCallStack => String -> a
error (String
"Lexer failure found when parsing aggregate default value\n:"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
errorMessage) -- XXX improve error reporting?