-- | This module contains a near-direct translation of the proto3 grammar
--   It uses String for easier compatibility with DotProto.Generator, which needs it for not very good reasons

{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}

module Proto3.Suite.DotProto.Parsing
  ( ProtoParser
  , runProtoParser
  , parseProto
  , parseProtoFile

    -- * Option Parsers
  , pOptionStmt
  , pFieldOptions
  , pFieldOptionStmt
  , pOptionId
  , pOptionKw

    -- * Extension Parsers
  , pExtendStmt
  , pExtendKw
  ) where

import Prelude hiding (fail)
import Control.Applicative hiding (empty)
import Control.Monad hiding (fail)
#if MIN_VERSION_base(4,13,0)
import Control.Monad (fail)
#endif
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail
#endif
import qualified Data.Char as Char
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NE
import Data.Functor
import qualified Data.Text as T
import Proto3.Suite.DotProto.AST
import Proto3.Wire.Types (FieldNumber(..))
import Text.Parsec (parse, ParseError)
import Text.Parsec.String (Parser)
import Text.Parser.Char hiding (digit, hexDigit)
import Text.Parser.Combinators
import Text.Parser.LookAhead
import Text.Parser.Token
import qualified Text.Parser.Token.Style as TokenStyle
import qualified Turtle hiding (encodeString, fromText)
import qualified Turtle.Compat as Turtle (encodeString, fromText)

----------------------------------------
-- interfaces

-- | @parseProto mp inp@ attempts to parse @inp@ as a 'DotProto'. @mp@ is the
-- module path to be injected into the AST as part of 'DotProtoMeta' metadata on
-- a successful parse.
parseProto :: Path -> String -> Either ParseError DotProto
parseProto :: Path -> String -> Either ParseError DotProto
parseProto Path
modulePath = Path -> String -> String -> Either ParseError DotProto
parseProtoWithFile Path
modulePath String
""

parseProtoWithFile :: Path -> String -> String -> Either ParseError DotProto
parseProtoWithFile :: Path -> String -> String -> Either ParseError DotProto
parseProtoWithFile Path
modulePath String
filePath = Parsec String () DotProto
-> String -> String -> Either ParseError DotProto
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (ProtoParser DotProto -> Parsec String () DotProto
forall a. ProtoParser a -> Parser a
runProtoParser (Path -> ProtoParser DotProto
topLevel Path
modulePath)) String
filePath

-- | @parseProtoFile mp fp@ reads and parses the .proto file found at @fp@. @mp@
-- is used downstream during code generation when we need to generate names
-- which are a function of the source .proto file's filename and its path
-- relative to some @--includeDir@.
parseProtoFile :: Turtle.MonadIO m
               => Path -> Turtle.FilePath -> m (Either ParseError DotProto)
parseProtoFile :: Path -> String -> m (Either ParseError DotProto)
parseProtoFile Path
modulePath (String -> String
Turtle.encodeString -> String
fp) =
  Path -> String -> String -> Either ParseError DotProto
parseProtoWithFile Path
modulePath String
fp (String -> Either ParseError DotProto)
-> m String -> m (Either ParseError DotProto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (String -> IO String
readFile String
fp)

----------------------------------------
-- convenience

-- | Wrapper around @Text.Parsec.String.Parser@, overriding whitespace lexing.
newtype ProtoParser a = ProtoParser { ProtoParser a -> Parser a
runProtoParser :: Parser a }
  deriving ( a -> ProtoParser b -> ProtoParser a
(a -> b) -> ProtoParser a -> ProtoParser b
(forall a b. (a -> b) -> ProtoParser a -> ProtoParser b)
-> (forall a b. a -> ProtoParser b -> ProtoParser a)
-> Functor ProtoParser
forall a b. a -> ProtoParser b -> ProtoParser a
forall a b. (a -> b) -> ProtoParser a -> ProtoParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ProtoParser b -> ProtoParser a
$c<$ :: forall a b. a -> ProtoParser b -> ProtoParser a
fmap :: (a -> b) -> ProtoParser a -> ProtoParser b
$cfmap :: forall a b. (a -> b) -> ProtoParser a -> ProtoParser b
Functor, Functor ProtoParser
a -> ProtoParser a
Functor ProtoParser
-> (forall a. a -> ProtoParser a)
-> (forall a b.
    ProtoParser (a -> b) -> ProtoParser a -> ProtoParser b)
-> (forall a b c.
    (a -> b -> c) -> ProtoParser a -> ProtoParser b -> ProtoParser c)
-> (forall a b. ProtoParser a -> ProtoParser b -> ProtoParser b)
-> (forall a b. ProtoParser a -> ProtoParser b -> ProtoParser a)
-> Applicative ProtoParser
ProtoParser a -> ProtoParser b -> ProtoParser b
ProtoParser a -> ProtoParser b -> ProtoParser a
ProtoParser (a -> b) -> ProtoParser a -> ProtoParser b
(a -> b -> c) -> ProtoParser a -> ProtoParser b -> ProtoParser c
forall a. a -> ProtoParser a
forall a b. ProtoParser a -> ProtoParser b -> ProtoParser a
forall a b. ProtoParser a -> ProtoParser b -> ProtoParser b
forall a b. ProtoParser (a -> b) -> ProtoParser a -> ProtoParser b
forall a b c.
(a -> b -> c) -> ProtoParser a -> ProtoParser b -> ProtoParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ProtoParser a -> ProtoParser b -> ProtoParser a
$c<* :: forall a b. ProtoParser a -> ProtoParser b -> ProtoParser a
*> :: ProtoParser a -> ProtoParser b -> ProtoParser b
$c*> :: forall a b. ProtoParser a -> ProtoParser b -> ProtoParser b
liftA2 :: (a -> b -> c) -> ProtoParser a -> ProtoParser b -> ProtoParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ProtoParser a -> ProtoParser b -> ProtoParser c
<*> :: ProtoParser (a -> b) -> ProtoParser a -> ProtoParser b
$c<*> :: forall a b. ProtoParser (a -> b) -> ProtoParser a -> ProtoParser b
pure :: a -> ProtoParser a
$cpure :: forall a. a -> ProtoParser a
$cp1Applicative :: Functor ProtoParser
Applicative, Applicative ProtoParser
ProtoParser a
Applicative ProtoParser
-> (forall a. ProtoParser a)
-> (forall a. ProtoParser a -> ProtoParser a -> ProtoParser a)
-> (forall a. ProtoParser a -> ProtoParser [a])
-> (forall a. ProtoParser a -> ProtoParser [a])
-> Alternative ProtoParser
ProtoParser a -> ProtoParser a -> ProtoParser a
ProtoParser a -> ProtoParser [a]
ProtoParser a -> ProtoParser [a]
forall a. ProtoParser a
forall a. ProtoParser a -> ProtoParser [a]
forall a. ProtoParser a -> ProtoParser a -> ProtoParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: ProtoParser a -> ProtoParser [a]
$cmany :: forall a. ProtoParser a -> ProtoParser [a]
some :: ProtoParser a -> ProtoParser [a]
$csome :: forall a. ProtoParser a -> ProtoParser [a]
<|> :: ProtoParser a -> ProtoParser a -> ProtoParser a
$c<|> :: forall a. ProtoParser a -> ProtoParser a -> ProtoParser a
empty :: ProtoParser a
$cempty :: forall a. ProtoParser a
$cp1Alternative :: Applicative ProtoParser
Alternative, Applicative ProtoParser
a -> ProtoParser a
Applicative ProtoParser
-> (forall a b.
    ProtoParser a -> (a -> ProtoParser b) -> ProtoParser b)
-> (forall a b. ProtoParser a -> ProtoParser b -> ProtoParser b)
-> (forall a. a -> ProtoParser a)
-> Monad ProtoParser
ProtoParser a -> (a -> ProtoParser b) -> ProtoParser b
ProtoParser a -> ProtoParser b -> ProtoParser b
forall a. a -> ProtoParser a
forall a b. ProtoParser a -> ProtoParser b -> ProtoParser b
forall a b. ProtoParser a -> (a -> ProtoParser b) -> ProtoParser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ProtoParser a
$creturn :: forall a. a -> ProtoParser a
>> :: ProtoParser a -> ProtoParser b -> ProtoParser b
$c>> :: forall a b. ProtoParser a -> ProtoParser b -> ProtoParser b
>>= :: ProtoParser a -> (a -> ProtoParser b) -> ProtoParser b
$c>>= :: forall a b. ProtoParser a -> (a -> ProtoParser b) -> ProtoParser b
$cp1Monad :: Applicative ProtoParser
Monad, Monad ProtoParser
Monad ProtoParser
-> (forall a. String -> ProtoParser a) -> MonadFail ProtoParser
String -> ProtoParser a
forall a. String -> ProtoParser a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: String -> ProtoParser a
$cfail :: forall a. String -> ProtoParser a
$cp1MonadFail :: Monad ProtoParser
MonadFail, Monad ProtoParser
Alternative ProtoParser
ProtoParser a
Alternative ProtoParser
-> Monad ProtoParser
-> (forall a. ProtoParser a)
-> (forall a. ProtoParser a -> ProtoParser a -> ProtoParser a)
-> MonadPlus ProtoParser
ProtoParser a -> ProtoParser a -> ProtoParser a
forall a. ProtoParser a
forall a. ProtoParser a -> ProtoParser a -> ProtoParser a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
mplus :: ProtoParser a -> ProtoParser a -> ProtoParser a
$cmplus :: forall a. ProtoParser a -> ProtoParser a -> ProtoParser a
mzero :: ProtoParser a
$cmzero :: forall a. ProtoParser a
$cp2MonadPlus :: Monad ProtoParser
$cp1MonadPlus :: Alternative ProtoParser
MonadPlus
           , Alternative ProtoParser
ProtoParser ()
String -> ProtoParser a
Alternative ProtoParser
-> (forall a. ProtoParser a -> ProtoParser a)
-> (forall a. ProtoParser a -> String -> ProtoParser a)
-> (forall a. ProtoParser a -> ProtoParser ())
-> (forall a. ProtoParser a -> ProtoParser ())
-> (forall a. String -> ProtoParser a)
-> ProtoParser ()
-> (forall a. Show a => ProtoParser a -> ProtoParser ())
-> Parsing ProtoParser
ProtoParser a -> ProtoParser a
ProtoParser a -> String -> ProtoParser a
ProtoParser a -> ProtoParser ()
ProtoParser a -> ProtoParser ()
ProtoParser a -> ProtoParser ()
forall a. Show a => ProtoParser a -> ProtoParser ()
forall a. String -> ProtoParser a
forall a. ProtoParser a -> ProtoParser a
forall a. ProtoParser a -> ProtoParser ()
forall a. ProtoParser a -> String -> ProtoParser a
forall (m :: * -> *).
Alternative m
-> (forall a. m a -> m a)
-> (forall a. m a -> String -> m a)
-> (forall a. m a -> m ())
-> (forall a. m a -> m ())
-> (forall a. String -> m a)
-> m ()
-> (forall a. Show a => m a -> m ())
-> Parsing m
notFollowedBy :: ProtoParser a -> ProtoParser ()
$cnotFollowedBy :: forall a. Show a => ProtoParser a -> ProtoParser ()
eof :: ProtoParser ()
$ceof :: ProtoParser ()
unexpected :: String -> ProtoParser a
$cunexpected :: forall a. String -> ProtoParser a
skipSome :: ProtoParser a -> ProtoParser ()
$cskipSome :: forall a. ProtoParser a -> ProtoParser ()
skipMany :: ProtoParser a -> ProtoParser ()
$cskipMany :: forall a. ProtoParser a -> ProtoParser ()
<?> :: ProtoParser a -> String -> ProtoParser a
$c<?> :: forall a. ProtoParser a -> String -> ProtoParser a
try :: ProtoParser a -> ProtoParser a
$ctry :: forall a. ProtoParser a -> ProtoParser a
$cp1Parsing :: Alternative ProtoParser
Parsing, Parsing ProtoParser
ProtoParser Char
Char -> ProtoParser Char
String -> ProtoParser String
Text -> ProtoParser Text
Parsing ProtoParser
-> ((Char -> Bool) -> ProtoParser Char)
-> (Char -> ProtoParser Char)
-> (Char -> ProtoParser Char)
-> ProtoParser Char
-> (String -> ProtoParser String)
-> (Text -> ProtoParser Text)
-> CharParsing ProtoParser
(Char -> Bool) -> ProtoParser Char
forall (m :: * -> *).
Parsing m
-> ((Char -> Bool) -> m Char)
-> (Char -> m Char)
-> (Char -> m Char)
-> m Char
-> (String -> m String)
-> (Text -> m Text)
-> CharParsing m
text :: Text -> ProtoParser Text
$ctext :: Text -> ProtoParser Text
string :: String -> ProtoParser String
$cstring :: String -> ProtoParser String
anyChar :: ProtoParser Char
$canyChar :: ProtoParser Char
notChar :: Char -> ProtoParser Char
$cnotChar :: Char -> ProtoParser Char
char :: Char -> ProtoParser Char
$cchar :: Char -> ProtoParser Char
satisfy :: (Char -> Bool) -> ProtoParser Char
$csatisfy :: (Char -> Bool) -> ProtoParser Char
$cp1CharParsing :: Parsing ProtoParser
CharParsing, Parsing ProtoParser
Parsing ProtoParser
-> (forall a. ProtoParser a -> ProtoParser a)
-> LookAheadParsing ProtoParser
ProtoParser a -> ProtoParser a
forall a. ProtoParser a -> ProtoParser a
forall (m :: * -> *).
Parsing m -> (forall a. m a -> m a) -> LookAheadParsing m
lookAhead :: ProtoParser a -> ProtoParser a
$clookAhead :: forall a. ProtoParser a -> ProtoParser a
$cp1LookAheadParsing :: Parsing ProtoParser
LookAheadParsing)

instance TokenParsing ProtoParser where
  someSpace :: ProtoParser ()
someSpace = ProtoParser () -> CommentStyle -> ProtoParser ()
forall (m :: * -> *). CharParsing m => m () -> CommentStyle -> m ()
TokenStyle.buildSomeSpaceParser
                (Parser () -> ProtoParser ()
forall a. Parser a -> ProtoParser a
ProtoParser Parser ()
forall (m :: * -> *). TokenParsing m => m ()
someSpace)
                CommentStyle
TokenStyle.javaCommentStyle
  -- use the default implementation for other methods:
  -- nesting, semi, highlight, token

empty :: ProtoParser ()
empty :: ProtoParser ()
empty = Text -> ProtoParser Text
forall (m :: * -> *). TokenParsing m => Text -> m Text
textSymbol Text
";" ProtoParser Text -> ProtoParser () -> ProtoParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ProtoParser ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

fieldNumber :: ProtoParser FieldNumber
fieldNumber :: ProtoParser FieldNumber
fieldNumber = Word64 -> FieldNumber
FieldNumber (Word64 -> FieldNumber)
-> (Integer -> Word64) -> Integer -> FieldNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> FieldNumber)
-> ProtoParser Integer -> ProtoParser FieldNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Integer
forall (m :: * -> *). TokenParsing m => m Integer
integer

----------------------------------------
-- identifiers

identifierName :: ProtoParser String
identifierName :: ProtoParser String
identifierName = do Char
h <- ProtoParser Char
forall (m :: * -> *). CharParsing m => m Char
letter
                    String
t <- ProtoParser Char -> ProtoParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ProtoParser Char
forall (m :: * -> *). CharParsing m => m Char
alphaNum ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'_')
                    String -> ProtoParser String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> ProtoParser String) -> String -> ProtoParser String
forall a b. (a -> b) -> a -> b
$ Char
hChar -> String -> String
forall a. a -> [a] -> [a]
:String
t

-- Parses a full identifier, without consuming trailing space.
_identifier :: ProtoParser DotProtoIdentifier
_identifier :: ProtoParser DotProtoIdentifier
_identifier = ProtoParser String
identifierName ProtoParser String -> ProtoParser String -> ProtoParser [String]
forall (m :: * -> *) a sep. Alternative m => m a -> m sep -> m [a]
`sepBy1` String -> ProtoParser String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"." ProtoParser [String]
-> ([String] -> ProtoParser DotProtoIdentifier)
-> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                []  -> String -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"impossible"
                [String
i] -> DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> DotProtoIdentifier
Single String
i)
                (String
i:[String]
is) -> DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> DotProtoIdentifier
Dots (NonEmpty String -> Path
Path (String
i String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
NE.:| [String]
is)))

singleIdentifier :: ProtoParser DotProtoIdentifier
singleIdentifier :: ProtoParser DotProtoIdentifier
singleIdentifier = String -> DotProtoIdentifier
Single (String -> DotProtoIdentifier)
-> ProtoParser String -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser String -> ProtoParser String
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token ProtoParser String
identifierName

-- Parses a full identifier, consuming trailing space.
identifier :: ProtoParser DotProtoIdentifier
identifier :: ProtoParser DotProtoIdentifier
identifier = ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token ProtoParser DotProtoIdentifier
_identifier

-- Parses a full identifier, consuming trailing space.
-- The leading dot denotes that the identifier path starts in global scope.
globalIdentifier :: ProtoParser DotProtoIdentifier
globalIdentifier :: ProtoParser DotProtoIdentifier
globalIdentifier = ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier)
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ String -> ProtoParser String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"." ProtoParser String
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProtoParser DotProtoIdentifier
_identifier

----------------------------------------
-- values

strLit :: ProtoParser String
strLit :: ProtoParser String
strLit = ProtoParser String
doubleQuotedLiteral ProtoParser String -> ProtoParser String -> ProtoParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser String
singleQuotedLiteral
  where
    doubleQuotedLiteral :: ProtoParser String
doubleQuotedLiteral =
        ProtoParser Char
-> ProtoParser Char -> ProtoParser String -> ProtoParser String
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"') (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"') (ProtoParser Char -> ProtoParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser Char
character)
      where
        character :: ProtoParser Char
character =
            ProtoParser Char
escape ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> ProtoParser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ Char
'\0', Char
'\n', Char
'\\', Char
'"' ])

    singleQuotedLiteral :: ProtoParser String
singleQuotedLiteral =
        ProtoParser Char
-> ProtoParser Char -> ProtoParser String -> ProtoParser String
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\'') (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\'') (ProtoParser Char -> ProtoParser String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser Char
character)
      where
        character :: ProtoParser Char
character =
            ProtoParser Char
escape ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> ProtoParser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ Char
'\0', Char
'\n', Char
'\\', Char
'\'' ])

    escape :: ProtoParser Char
escape = do
        Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\\'
        ProtoParser Char
hexEscape ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser Char
octEscape ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser Char
charEscape

    hexEscape :: ProtoParser Char
hexEscape = do
        (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'x' ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'X')
        Int
digit0 <- ProtoParser Int
hexDigit
        Int
digit1 <- ProtoParser Int
hexDigit
        let number :: Int
number = Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
digit0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
digit1
        Char -> ProtoParser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
Char.chr Int
number)

    octEscape :: ProtoParser Char
octEscape = do
        Int
digit0 <- ProtoParser Int
octalDigit
        Int
digit1 <- ProtoParser Int
octalDigit
        Int
digit2 <- ProtoParser Int
octalDigit
        let number :: Int
number = Int
64 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
digit0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
digit1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
digit2
        Char -> ProtoParser Char
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Char
Char.chr Int
number)

    charEscape :: ProtoParser Char
charEscape =
            Char
'\a' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'a'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\b' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'b'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\f' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'f'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\n' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'n'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\r' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'r'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\t' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
't'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\v' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'v'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\\' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\\'
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'\'' Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\''
        ProtoParser Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char
'"'  Char -> ProtoParser Char -> ProtoParser Char
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"'

digit :: ProtoParser Int
digit :: ProtoParser Int
digit = do
    Char
c <- (Char -> Bool) -> ProtoParser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')
    Int -> ProtoParser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'0')

hexDigit :: ProtoParser Int
hexDigit :: ProtoParser Int
hexDigit = ProtoParser Int
digit ProtoParser Int -> ProtoParser Int -> ProtoParser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser Int
lowercase ProtoParser Int -> ProtoParser Int -> ProtoParser Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser Int
uppercase
  where
    lowercase :: ProtoParser Int
lowercase = do
        Char
c <- (Char -> Bool) -> ProtoParser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char
'a' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'f')
        Int -> ProtoParser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'a')

    uppercase :: ProtoParser Int
uppercase = do
        Char
c <- (Char -> Bool) -> ProtoParser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char
'A' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'F')
        Int -> ProtoParser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'A')

octalDigit :: ProtoParser Int
octalDigit :: ProtoParser Int
octalDigit = do
    Char
c <- (Char -> Bool) -> ProtoParser Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
satisfy (\Char
c -> Char
'0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'7')
    Int -> ProtoParser Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Int
Char.ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
Char.ord Char
'0')

bool :: ProtoParser Bool
bool :: ProtoParser Bool
bool = ProtoParser Bool -> ProtoParser Bool
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (ProtoParser Bool -> ProtoParser Bool)
-> ProtoParser Bool -> ProtoParser Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool -> ProtoParser Bool
forall (m :: * -> *) b.
(Monad m, CharParsing m) =>
String -> b -> m b
lit String
"true" Bool
True ProtoParser Bool -> ProtoParser Bool -> ProtoParser Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Bool -> ProtoParser Bool
forall (m :: * -> *) b.
(Monad m, CharParsing m) =>
String -> b -> m b
lit String
"false" Bool
False
  where
    -- used to distinguish "true_" (Identifier) from "true" (BoolLit)
    lit :: String -> b -> m b
lit String
s b
c = String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
s m String -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m Char -> m ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy (m Char
forall (m :: * -> *). CharParsing m => m Char
alphaNum m Char -> m Char -> m Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'_') m () -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
c

-- the `parsers` package actually does not expose a parser for signed fractional values
floatLit :: ProtoParser Double
floatLit :: ProtoParser Double
floatLit = do Double -> Double
sign <- Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'-' ProtoParser Char
-> (Double -> Double) -> ProtoParser (Double -> Double)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Double -> Double
forall a. Num a => a -> a
negate ProtoParser (Double -> Double)
-> ProtoParser (Double -> Double) -> ProtoParser (Double -> Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'+' ProtoParser Char
-> (Double -> Double) -> ProtoParser (Double -> Double)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Double -> Double
forall a. a -> a
id ProtoParser (Double -> Double)
-> ProtoParser (Double -> Double) -> ProtoParser (Double -> Double)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Double -> Double) -> ProtoParser (Double -> Double)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double -> Double
forall a. a -> a
id
              Double -> Double
sign (Double -> Double) -> ProtoParser Double -> ProtoParser Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Double
forall (m :: * -> *). TokenParsing m => m Double
double

value :: ProtoParser DotProtoValue
value :: ProtoParser DotProtoValue
value = ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Bool -> DotProtoValue
BoolLit              (Bool -> DotProtoValue)
-> ProtoParser Bool -> ProtoParser DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Bool
bool)
    ProtoParser DotProtoValue
-> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> DotProtoValue
StringLit            (String -> DotProtoValue)
-> ProtoParser String -> ProtoParser DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser String
strLit)
    ProtoParser DotProtoValue
-> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Double -> DotProtoValue
FloatLit             (Double -> DotProtoValue)
-> ProtoParser Double -> ProtoParser DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Double
floatLit)
    ProtoParser DotProtoValue
-> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (m :: * -> *) a. Parsing m => m a -> m a
try (Int -> DotProtoValue
IntLit (Int -> DotProtoValue)
-> (Integer -> Int) -> Integer -> DotProtoValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> DotProtoValue)
-> ProtoParser Integer -> ProtoParser DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Integer
forall (m :: * -> *). TokenParsing m => m Integer
integer)
    ProtoParser DotProtoValue
-> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoValue -> ProtoParser DotProtoValue
forall (m :: * -> *) a. Parsing m => m a -> m a
try (DotProtoIdentifier -> DotProtoValue
Identifier           (DotProtoIdentifier -> DotProtoValue)
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoIdentifier
identifier)

----------------------------------------
-- types

primType :: ProtoParser DotProtoPrimType
primType :: ProtoParser DotProtoPrimType
primType = ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"double"   ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Double)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"float"    ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Float)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"int32"    ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Int32)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"int64"    ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Int64)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"sint32"   ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
SInt32)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"sint64"   ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
SInt64)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"uint32"   ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
UInt32)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"uint64"   ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
UInt64)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"fixed32"  ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Fixed32)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"fixed64"  ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Fixed64)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"sfixed32" ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
SFixed32)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"sfixed64" ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
SFixed64)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"string"   ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
String)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"bytes"    ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Bytes)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"bool"     ProtoParser String
-> DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoPrimType
Bool)
       ProtoParser DotProtoPrimType
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DotProtoIdentifier -> DotProtoPrimType
Named (DotProtoIdentifier -> DotProtoPrimType)
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProtoParser DotProtoIdentifier
identifier ProtoParser DotProtoIdentifier
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoIdentifier
globalIdentifier)

--------------------------------------------------------------------------------
-- top-level parser and version annotation

syntaxSpec :: ProtoParser ()
syntaxSpec :: ProtoParser ()
syntaxSpec = ProtoParser Char -> ProtoParser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ProtoParser Char -> ProtoParser ())
-> ProtoParser Char -> ProtoParser ()
forall a b. (a -> b) -> a -> b
$ do
  String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"syntax"
  String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"="
  String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"'proto3'" ProtoParser String -> ProtoParser String -> ProtoParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"\"proto3\""
  ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi

data DotProtoStatement
  = DPSOption     DotProtoOption
  | DPSPackage    DotProtoPackageSpec
  | DPSImport     DotProtoImport
  | DPSDefinition DotProtoDefinition
  | DPSEmpty
  deriving Int -> DotProtoStatement -> String -> String
[DotProtoStatement] -> String -> String
DotProtoStatement -> String
(Int -> DotProtoStatement -> String -> String)
-> (DotProtoStatement -> String)
-> ([DotProtoStatement] -> String -> String)
-> Show DotProtoStatement
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [DotProtoStatement] -> String -> String
$cshowList :: [DotProtoStatement] -> String -> String
show :: DotProtoStatement -> String
$cshow :: DotProtoStatement -> String
showsPrec :: Int -> DotProtoStatement -> String -> String
$cshowsPrec :: Int -> DotProtoStatement -> String -> String
Show

sortStatements :: Path -> [DotProtoStatement] -> DotProto
sortStatements :: Path -> [DotProtoStatement] -> DotProto
sortStatements Path
modulePath [DotProtoStatement]
statements
  = DotProto :: [DotProtoImport]
-> [DotProtoOption]
-> DotProtoPackageSpec
-> [DotProtoDefinition]
-> DotProtoMeta
-> DotProto
DotProto { protoOptions :: [DotProtoOption]
protoOptions     =       [ DotProtoOption
x | DPSOption     DotProtoOption
x <- [DotProtoStatement]
statements]
             , protoImports :: [DotProtoImport]
protoImports     =       [ DotProtoImport
x | DPSImport     DotProtoImport
x <- [DotProtoStatement]
statements]
             , protoPackage :: DotProtoPackageSpec
protoPackage     = [DotProtoPackageSpec] -> DotProtoPackageSpec
adapt [ DotProtoPackageSpec
x | DPSPackage    DotProtoPackageSpec
x <- [DotProtoStatement]
statements]
             , protoDefinitions :: [DotProtoDefinition]
protoDefinitions =       [ DotProtoDefinition
x | DPSDefinition DotProtoDefinition
x <- [DotProtoStatement]
statements]
             , protoMeta :: DotProtoMeta
protoMeta        = Path -> DotProtoMeta
DotProtoMeta Path
modulePath
             }
  where
    adapt :: [DotProtoPackageSpec] -> DotProtoPackageSpec
adapt (DotProtoPackageSpec
x:[DotProtoPackageSpec]
_) = DotProtoPackageSpec
x
    adapt [DotProtoPackageSpec]
_     = DotProtoPackageSpec
DotProtoNoPackage

topLevel :: Path -> ProtoParser DotProto
topLevel :: Path -> ProtoParser DotProto
topLevel Path
modulePath = do
  ProtoParser ()
forall (m :: * -> *). TokenParsing m => m ()
whiteSpace
  ProtoParser ()
syntaxSpec
  DotProto
dotProto <- Path -> [DotProtoStatement] -> DotProto
sortStatements Path
modulePath ([DotProtoStatement] -> DotProto)
-> ProtoParser [DotProtoStatement] -> ProtoParser DotProto
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoStatement -> ProtoParser [DotProtoStatement]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser DotProtoStatement
topStatement
  ProtoParser ()
forall (m :: * -> *). Parsing m => m ()
eof
  DotProto -> ProtoParser DotProto
forall (m :: * -> *) a. Monad m => a -> m a
return DotProto
dotProto

--------------------------------------------------------------------------------
-- top-level statements

topStatement :: ProtoParser DotProtoStatement
topStatement :: ProtoParser DotProtoStatement
topStatement = 
  [ProtoParser DotProtoStatement] -> ProtoParser DotProtoStatement
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice 
    [ DotProtoImport -> DotProtoStatement
DPSImport (DotProtoImport -> DotProtoStatement)
-> ProtoParser DotProtoImport -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoImport
import_
    , DotProtoPackageSpec -> DotProtoStatement
DPSPackage (DotProtoPackageSpec -> DotProtoStatement)
-> ProtoParser DotProtoPackageSpec -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoPackageSpec
package
    , DotProtoOption -> DotProtoStatement
DPSOption (DotProtoOption -> DotProtoStatement)
-> ProtoParser DotProtoOption -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoOption
pOptionStmt
    , DotProtoStatement
DPSEmpty DotProtoStatement
-> ProtoParser (DotProtoIdentifier, [DotProtoMessagePart])
-> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ProtoParser (DotProtoIdentifier, [DotProtoMessagePart])
-> ProtoParser (DotProtoIdentifier, [DotProtoMessagePart])
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser (DotProtoIdentifier, [DotProtoMessagePart])
pExtendStmt
    , DotProtoDefinition -> DotProtoStatement
DPSDefinition (DotProtoDefinition -> DotProtoStatement)
-> ProtoParser DotProtoDefinition -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoDefinition
definition
    , DotProtoStatement
DPSEmpty DotProtoStatement
-> ProtoParser () -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ProtoParser ()
empty
    ]

import_ :: ProtoParser DotProtoImport
import_ :: ProtoParser DotProtoImport
import_ = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"import"
             DotProtoImportQualifier
qualifier <- DotProtoImportQualifier
-> ProtoParser DotProtoImportQualifier
-> ProtoParser DotProtoImportQualifier
forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option DotProtoImportQualifier
DotProtoImportDefault (ProtoParser DotProtoImportQualifier
 -> ProtoParser DotProtoImportQualifier)
-> ProtoParser DotProtoImportQualifier
-> ProtoParser DotProtoImportQualifier
forall a b. (a -> b) -> a -> b
$
                                 String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"weak" ProtoParser String
-> DotProtoImportQualifier -> ProtoParser DotProtoImportQualifier
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoImportQualifier
DotProtoImportWeak
                             ProtoParser DotProtoImportQualifier
-> ProtoParser DotProtoImportQualifier
-> ProtoParser DotProtoImportQualifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"public" ProtoParser String
-> DotProtoImportQualifier -> ProtoParser DotProtoImportQualifier
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoImportQualifier
DotProtoImportPublic
             String
target <- Text -> String
Turtle.fromText (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> String) -> ProtoParser String -> ProtoParser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser String
strLit
             ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi
             DotProtoImport -> ProtoParser DotProtoImport
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoImport -> ProtoParser DotProtoImport)
-> DotProtoImport -> ProtoParser DotProtoImport
forall a b. (a -> b) -> a -> b
$ DotProtoImportQualifier -> String -> DotProtoImport
DotProtoImport DotProtoImportQualifier
qualifier String
target

package :: ProtoParser DotProtoPackageSpec
package :: ProtoParser DotProtoPackageSpec
package = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"package"
             DotProtoIdentifier
p <- ProtoParser DotProtoIdentifier
identifier
             ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi
             DotProtoPackageSpec -> ProtoParser DotProtoPackageSpec
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoPackageSpec -> ProtoParser DotProtoPackageSpec)
-> DotProtoPackageSpec -> ProtoParser DotProtoPackageSpec
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier -> DotProtoPackageSpec
DotProtoPackageSpec DotProtoIdentifier
p

definition :: ProtoParser DotProtoDefinition
definition :: ProtoParser DotProtoDefinition
definition = 
  [ProtoParser DotProtoDefinition] -> ProtoParser DotProtoDefinition
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice 
    [ ProtoParser DotProtoDefinition -> ProtoParser DotProtoDefinition
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser DotProtoDefinition
message
    , ProtoParser DotProtoDefinition -> ProtoParser DotProtoDefinition
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser DotProtoDefinition
enum
    , ProtoParser DotProtoDefinition
service
    ]

--------------------------------------------------------------------------------
-- options

-- | Parses a protobuf option that could appear in a service, RPC, message, 
-- enumeration, or at the top-level.
--
-- @since 0.5.2
pOptionStmt :: ProtoParser DotProtoOption
pOptionStmt :: ProtoParser DotProtoOption
pOptionStmt = ProtoParser DotProtoOption -> ProtoParser DotProtoOption
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (ProtoParser ()
-> ProtoParser Char
-> ProtoParser DotProtoOption
-> ProtoParser DotProtoOption
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between ProtoParser ()
pOptionKw (ProtoParser Char -> ProtoParser Char
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi) ProtoParser DotProtoOption
pFieldOptionStmt)

-- | Parses zero or more message field options enclosed in square braces.
--
-- @since 0.5.2
pFieldOptions :: ProtoParser [DotProtoOption]
pFieldOptions :: ProtoParser [DotProtoOption]
pFieldOptions = ProtoParser [DotProtoOption]
pOptions ProtoParser [DotProtoOption]
-> ProtoParser [DotProtoOption] -> ProtoParser [DotProtoOption]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [DotProtoOption] -> ProtoParser [DotProtoOption]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  where 
    pOptions :: ProtoParser [DotProtoOption]
    pOptions :: ProtoParser [DotProtoOption]
pOptions = ProtoParser ()
-> ProtoParser ()
-> ProtoParser [DotProtoOption]
-> ProtoParser [DotProtoOption]
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between ProtoParser ()
lbracket ProtoParser ()
rbracket (ProtoParser DotProtoOption -> ProtoParser [DotProtoOption]
forall (m :: * -> *) a. TokenParsing m => m a -> m [a]
commaSep1 (ProtoParser DotProtoOption -> ProtoParser DotProtoOption
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token ProtoParser DotProtoOption
pFieldOptionStmt))

    lbracket :: ProtoParser ()
    lbracket :: ProtoParser ()
lbracket = ProtoParser () -> ProtoParser ()
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'[' ProtoParser Char -> () -> ProtoParser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) ProtoParser () -> String -> ProtoParser ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"left bracket"

    rbracket :: ProtoParser ()
    rbracket :: ProtoParser ()
rbracket = ProtoParser () -> ProtoParser ()
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
']' ProtoParser Char -> () -> ProtoParser ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()) ProtoParser () -> String -> ProtoParser ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"right bracket"

-- | Parses a protobuf option in the context of a message field's options.
--
-- @since 0.5.2
pFieldOptionStmt :: ProtoParser DotProtoOption
pFieldOptionStmt :: ProtoParser DotProtoOption
pFieldOptionStmt = ProtoParser DotProtoOption -> ProtoParser DotProtoOption
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (ProtoParser DotProtoOption -> ProtoParser DotProtoOption)
-> ProtoParser DotProtoOption -> ProtoParser DotProtoOption
forall a b. (a -> b) -> a -> b
$ do 
  DotProtoIdentifier
idt <- ProtoParser DotProtoIdentifier
pOptionId 
  ProtoParser Char -> ProtoParser Char
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'=')
  DotProtoValue
val <- ProtoParser DotProtoValue
value
  DotProtoOption -> ProtoParser DotProtoOption
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DotProtoIdentifier -> DotProtoValue -> DotProtoOption
DotProtoOption DotProtoIdentifier
idt DotProtoValue
val)

-- | Parses a (qualified) identifier for a protobuf option.
--
-- @since 0.5.2
pOptionId :: ProtoParser DotProtoIdentifier
pOptionId :: ProtoParser DotProtoIdentifier
pOptionId = 
  [ProtoParser DotProtoIdentifier] -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice 
    [ ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser DotProtoIdentifier
pOptionQName
    , ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. Parsing m => m a -> m a
try (ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens ProtoParser DotProtoIdentifier
pOptionName)
    , ProtoParser DotProtoIdentifier
pOptionName
    ]
  where 
    pOptionName :: ProtoParser DotProtoIdentifier
    pOptionName :: ProtoParser DotProtoIdentifier
pOptionName = ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier)
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ do
      String
nm <- ProtoParser String
identifierName
      [String]
nms <- ProtoParser String -> ProtoParser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'.' ProtoParser Char -> ProtoParser String -> ProtoParser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ProtoParser String
identifierName)
      if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
nms 
        then DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> DotProtoIdentifier
Single String
nm)
        else DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path -> DotProtoIdentifier
Dots (NonEmpty String -> Path
Path (String
nm String -> [String] -> NonEmpty String
forall a. a -> [a] -> NonEmpty a
:| [String]
nms)))

    pOptionQName :: ProtoParser DotProtoIdentifier
    pOptionQName :: ProtoParser DotProtoIdentifier
pOptionQName = ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier)
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ do 
      DotProtoIdentifier
idt <- ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens ProtoParser DotProtoIdentifier
pOptionName
      DotProtoIdentifier
nms <- Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'.' ProtoParser Char
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ProtoParser DotProtoIdentifier
pOptionName
      DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
Qualified DotProtoIdentifier
idt DotProtoIdentifier
nms)

-- | Parses a single keyword token "option".
--
-- @since 0.5.2
pOptionKw :: ProtoParser ()
pOptionKw :: ProtoParser ()
pOptionKw = do
  ProtoParser ()
forall (m :: * -> *). CharParsing m => m ()
spaces
  ProtoParser () -> ProtoParser ()
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (String -> ProtoParser String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"option" ProtoParser String -> ProtoParser () -> ProtoParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProtoParser Char -> ProtoParser ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ProtoParser Char
forall (m :: * -> *). CharParsing m => m Char
alphaNum)
    ProtoParser () -> String -> ProtoParser ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"keyword 'option'"

--------------------------------------------------------------------------------
-- service statements

servicePart :: ProtoParser DotProtoServicePart
servicePart :: ProtoParser DotProtoServicePart
servicePart = RPCMethod -> DotProtoServicePart
DotProtoServiceRPCMethod (RPCMethod -> DotProtoServicePart)
-> ProtoParser RPCMethod -> ProtoParser DotProtoServicePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser RPCMethod
rpc
          ProtoParser DotProtoServicePart
-> ProtoParser DotProtoServicePart
-> ProtoParser DotProtoServicePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DotProtoOption -> DotProtoServicePart
DotProtoServiceOption (DotProtoOption -> DotProtoServicePart)
-> ProtoParser DotProtoOption -> ProtoParser DotProtoServicePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoOption
pOptionStmt
          ProtoParser DotProtoServicePart
-> ProtoParser DotProtoServicePart
-> ProtoParser DotProtoServicePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DotProtoServicePart
DotProtoServiceEmpty DotProtoServicePart
-> ProtoParser () -> ProtoParser DotProtoServicePart
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ProtoParser ()
empty

rpcOptions :: ProtoParser [DotProtoOption]
rpcOptions :: ProtoParser [DotProtoOption]
rpcOptions = ProtoParser [DotProtoOption] -> ProtoParser [DotProtoOption]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
braces (ProtoParser [DotProtoOption] -> ProtoParser [DotProtoOption])
-> ProtoParser [DotProtoOption] -> ProtoParser [DotProtoOption]
forall a b. (a -> b) -> a -> b
$ ProtoParser DotProtoOption -> ProtoParser [DotProtoOption]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser DotProtoOption
pOptionStmt

rpcClause :: ProtoParser (DotProtoIdentifier, Streaming)
rpcClause :: ProtoParser (DotProtoIdentifier, Streaming)
rpcClause = do
  let sid :: t -> ProtoParser (DotProtoIdentifier, t)
sid t
ctx = (,t
ctx) (DotProtoIdentifier -> (DotProtoIdentifier, t))
-> ProtoParser DotProtoIdentifier
-> ProtoParser (DotProtoIdentifier, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProtoParser DotProtoIdentifier
identifier ProtoParser DotProtoIdentifier
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoIdentifier
globalIdentifier)
  -- NB: Distinguish "stream stream.foo" from "stream.foo"
  ProtoParser (DotProtoIdentifier, Streaming)
-> ProtoParser (DotProtoIdentifier, Streaming)
forall (m :: * -> *) a. Parsing m => m a -> m a
try (String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"stream" ProtoParser String
-> ProtoParser (DotProtoIdentifier, Streaming)
-> ProtoParser (DotProtoIdentifier, Streaming)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Streaming -> ProtoParser (DotProtoIdentifier, Streaming)
forall t. t -> ProtoParser (DotProtoIdentifier, t)
sid Streaming
Streaming) ProtoParser (DotProtoIdentifier, Streaming)
-> ProtoParser (DotProtoIdentifier, Streaming)
-> ProtoParser (DotProtoIdentifier, Streaming)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Streaming -> ProtoParser (DotProtoIdentifier, Streaming)
forall t. t -> ProtoParser (DotProtoIdentifier, t)
sid Streaming
NonStreaming

rpc :: ProtoParser RPCMethod
rpc :: ProtoParser RPCMethod
rpc = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"rpc"
         DotProtoIdentifier
rpcMethodName <- ProtoParser DotProtoIdentifier
singleIdentifier
         (DotProtoIdentifier
rpcMethodRequestType, Streaming
rpcMethodRequestStreaming) <- ProtoParser (DotProtoIdentifier, Streaming)
-> ProtoParser (DotProtoIdentifier, Streaming)
forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens ProtoParser (DotProtoIdentifier, Streaming)
rpcClause
         String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"returns"
         (DotProtoIdentifier
rpcMethodResponseType, Streaming
rpcMethodResponseStreaming) <- ProtoParser (DotProtoIdentifier, Streaming)
-> ProtoParser (DotProtoIdentifier, Streaming)
forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens ProtoParser (DotProtoIdentifier, Streaming)
rpcClause
         [DotProtoOption]
rpcMethodOptions <- ProtoParser [DotProtoOption]
rpcOptions ProtoParser [DotProtoOption]
-> ProtoParser [DotProtoOption] -> ProtoParser [DotProtoOption]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi ProtoParser Char
-> [DotProtoOption] -> ProtoParser [DotProtoOption]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [])
         RPCMethod -> ProtoParser RPCMethod
forall (m :: * -> *) a. Monad m => a -> m a
return RPCMethod :: DotProtoIdentifier
-> DotProtoIdentifier
-> Streaming
-> DotProtoIdentifier
-> Streaming
-> [DotProtoOption]
-> RPCMethod
RPCMethod{[DotProtoOption]
Streaming
DotProtoIdentifier
rpcMethodOptions :: [DotProtoOption]
rpcMethodResponseStreaming :: Streaming
rpcMethodResponseType :: DotProtoIdentifier
rpcMethodRequestStreaming :: Streaming
rpcMethodRequestType :: DotProtoIdentifier
rpcMethodName :: DotProtoIdentifier
rpcMethodOptions :: [DotProtoOption]
rpcMethodResponseStreaming :: Streaming
rpcMethodResponseType :: DotProtoIdentifier
rpcMethodRequestStreaming :: Streaming
rpcMethodRequestType :: DotProtoIdentifier
rpcMethodName :: DotProtoIdentifier
..}

service :: ProtoParser DotProtoDefinition
service :: ProtoParser DotProtoDefinition
service = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"service"
             DotProtoIdentifier
name <- ProtoParser DotProtoIdentifier
singleIdentifier
             [DotProtoServicePart]
statements <- ProtoParser [DotProtoServicePart]
-> ProtoParser [DotProtoServicePart]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
braces (ProtoParser DotProtoServicePart
-> ProtoParser [DotProtoServicePart]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser DotProtoServicePart
servicePart)
             DotProtoDefinition -> ProtoParser DotProtoDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoDefinition -> ProtoParser DotProtoDefinition)
-> DotProtoDefinition -> ProtoParser DotProtoDefinition
forall a b. (a -> b) -> a -> b
$ String
-> DotProtoIdentifier
-> [DotProtoServicePart]
-> DotProtoDefinition
DotProtoService String
forall a. Monoid a => a
mempty DotProtoIdentifier
name [DotProtoServicePart]
statements

--------------------------------------------------------------------------------
-- message definitions

message :: ProtoParser DotProtoDefinition
message :: ProtoParser DotProtoDefinition
message = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"message"
             DotProtoIdentifier
name <- ProtoParser DotProtoIdentifier
singleIdentifier
             [DotProtoMessagePart]
body <- ProtoParser [DotProtoMessagePart]
-> ProtoParser [DotProtoMessagePart]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
braces (ProtoParser DotProtoMessagePart
-> ProtoParser [DotProtoMessagePart]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser DotProtoMessagePart
messagePart)
             DotProtoDefinition -> ProtoParser DotProtoDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoDefinition -> ProtoParser DotProtoDefinition)
-> DotProtoDefinition -> ProtoParser DotProtoDefinition
forall a b. (a -> b) -> a -> b
$ String
-> DotProtoIdentifier
-> [DotProtoMessagePart]
-> DotProtoDefinition
DotProtoMessage String
forall a. Monoid a => a
mempty DotProtoIdentifier
name [DotProtoMessagePart]
body

messageOneOf :: ProtoParser DotProtoMessagePart
messageOneOf :: ProtoParser DotProtoMessagePart
messageOneOf = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"oneof"
                  DotProtoIdentifier
name <- ProtoParser DotProtoIdentifier
singleIdentifier
                  [DotProtoField]
body <- ProtoParser [DotProtoField] -> ProtoParser [DotProtoField]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
braces (ProtoParser [DotProtoField] -> ProtoParser [DotProtoField])
-> ProtoParser [DotProtoField] -> ProtoParser [DotProtoField]
forall a b. (a -> b) -> a -> b
$ ProtoParser DotProtoField -> ProtoParser [DotProtoField]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ProtoParser DotProtoField
messageField ProtoParser DotProtoField
-> ProtoParser DotProtoField -> ProtoParser DotProtoField
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser ()
empty ProtoParser () -> DotProtoField -> ProtoParser DotProtoField
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoField
DotProtoEmptyField)
                  DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoMessagePart -> ProtoParser DotProtoMessagePart)
-> DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier -> [DotProtoField] -> DotProtoMessagePart
DotProtoMessageOneOf DotProtoIdentifier
name [DotProtoField]
body

messagePart :: ProtoParser DotProtoMessagePart
messagePart :: ProtoParser DotProtoMessagePart
messagePart = ProtoParser DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall (m :: * -> *) a. Parsing m => m a -> m a
try (DotProtoDefinition -> DotProtoMessagePart
DotProtoMessageDefinition (DotProtoDefinition -> DotProtoMessagePart)
-> ProtoParser DotProtoDefinition
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoDefinition
enum)
          ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall (m :: * -> *) a. Parsing m => m a -> m a
try ([DotProtoReservedField] -> DotProtoMessagePart
DotProtoMessageReserved   ([DotProtoReservedField] -> DotProtoMessagePart)
-> ProtoParser [DotProtoReservedField]
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser [DotProtoReservedField]
reservedField)
          ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall (m :: * -> *) a. Parsing m => m a -> m a
try (DotProtoDefinition -> DotProtoMessagePart
DotProtoMessageDefinition (DotProtoDefinition -> DotProtoMessagePart)
-> ProtoParser DotProtoDefinition
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoDefinition
message)
          ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser DotProtoMessagePart
messageOneOf
          ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall (m :: * -> *) a. Parsing m => m a -> m a
try (DotProtoField -> DotProtoMessagePart
DotProtoMessageField      (DotProtoField -> DotProtoMessagePart)
-> ProtoParser DotProtoField -> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoField
messageField)
          ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
-> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoMessagePart -> ProtoParser DotProtoMessagePart
forall (m :: * -> *) a. Parsing m => m a -> m a
try (DotProtoOption -> DotProtoMessagePart
DotProtoMessageOption     (DotProtoOption -> DotProtoMessagePart)
-> ProtoParser DotProtoOption -> ProtoParser DotProtoMessagePart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoOption
pOptionStmt)

messageType :: ProtoParser DotProtoType
messageType :: ProtoParser DotProtoType
messageType = ProtoParser DotProtoType -> ProtoParser DotProtoType
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser DotProtoType
mapType ProtoParser DotProtoType
-> ProtoParser DotProtoType -> ProtoParser DotProtoType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoType -> ProtoParser DotProtoType
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser DotProtoType
repType ProtoParser DotProtoType
-> ProtoParser DotProtoType -> ProtoParser DotProtoType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (DotProtoPrimType -> DotProtoType
Prim (DotProtoPrimType -> DotProtoType)
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoPrimType
primType)
  where
    mapType :: ProtoParser DotProtoType
mapType = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"map"
                 ProtoParser DotProtoType -> ProtoParser DotProtoType
forall (m :: * -> *) a. TokenParsing m => m a -> m a
angles (ProtoParser DotProtoType -> ProtoParser DotProtoType)
-> ProtoParser DotProtoType -> ProtoParser DotProtoType
forall a b. (a -> b) -> a -> b
$ DotProtoPrimType -> DotProtoPrimType -> DotProtoType
Map (DotProtoPrimType -> DotProtoPrimType -> DotProtoType)
-> ProtoParser DotProtoPrimType
-> ProtoParser (DotProtoPrimType -> DotProtoType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProtoParser DotProtoPrimType
primType ProtoParser DotProtoPrimType
-> ProtoParser Char -> ProtoParser DotProtoPrimType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
comma)
                              ProtoParser (DotProtoPrimType -> DotProtoType)
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtoParser DotProtoPrimType
primType

    repType :: ProtoParser DotProtoType
repType = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"repeated"
                 DotProtoPrimType -> DotProtoType
Repeated (DotProtoPrimType -> DotProtoType)
-> ProtoParser DotProtoPrimType -> ProtoParser DotProtoType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoPrimType
primType

messageField :: ProtoParser DotProtoField
messageField :: ProtoParser DotProtoField
messageField = do DotProtoType
mtype <- ProtoParser DotProtoType
messageType
                  DotProtoIdentifier
mname <- ProtoParser DotProtoIdentifier
identifier
                  String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"="
                  FieldNumber
mnumber <- ProtoParser FieldNumber
fieldNumber
                  [DotProtoOption]
moptions <- ProtoParser [DotProtoOption]
pFieldOptions
                  ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi
                  DotProtoField -> ProtoParser DotProtoField
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoField -> ProtoParser DotProtoField)
-> DotProtoField -> ProtoParser DotProtoField
forall a b. (a -> b) -> a -> b
$ FieldNumber
-> DotProtoType
-> DotProtoIdentifier
-> [DotProtoOption]
-> String
-> DotProtoField
DotProtoField FieldNumber
mnumber DotProtoType
mtype DotProtoIdentifier
mname [DotProtoOption]
moptions String
forall a. Monoid a => a
mempty

--------------------------------------------------------------------------------
-- enumerations

enumField :: ProtoParser DotProtoEnumPart
enumField :: ProtoParser DotProtoEnumPart
enumField = do DotProtoIdentifier
fname <- ProtoParser DotProtoIdentifier
identifier
               String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"="
               DotProtoEnumValue
fpos <- Integer -> DotProtoEnumValue
forall a. Num a => Integer -> a
fromInteger (Integer -> DotProtoEnumValue)
-> ProtoParser Integer -> ProtoParser DotProtoEnumValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Integer
forall (m :: * -> *). TokenParsing m => m Integer
integer
               [DotProtoOption]
opts <- ProtoParser [DotProtoOption]
pFieldOptions
               ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi
               DotProtoEnumPart -> ProtoParser DotProtoEnumPart
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoEnumPart -> ProtoParser DotProtoEnumPart)
-> DotProtoEnumPart -> ProtoParser DotProtoEnumPart
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier
-> DotProtoEnumValue -> [DotProtoOption] -> DotProtoEnumPart
DotProtoEnumField DotProtoIdentifier
fname DotProtoEnumValue
fpos [DotProtoOption]
opts


enumStatement :: ProtoParser DotProtoEnumPart
enumStatement :: ProtoParser DotProtoEnumPart
enumStatement = ProtoParser DotProtoEnumPart -> ProtoParser DotProtoEnumPart
forall (m :: * -> *) a. Parsing m => m a -> m a
try (DotProtoOption -> DotProtoEnumPart
DotProtoEnumOption (DotProtoOption -> DotProtoEnumPart)
-> ProtoParser DotProtoOption -> ProtoParser DotProtoEnumPart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoOption
pOptionStmt)
            ProtoParser DotProtoEnumPart
-> ProtoParser DotProtoEnumPart -> ProtoParser DotProtoEnumPart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoEnumPart
enumField
            ProtoParser DotProtoEnumPart
-> ProtoParser DotProtoEnumPart -> ProtoParser DotProtoEnumPart
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser ()
empty ProtoParser () -> DotProtoEnumPart -> ProtoParser DotProtoEnumPart
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DotProtoEnumPart
DotProtoEnumEmpty

enum :: ProtoParser DotProtoDefinition
enum :: ProtoParser DotProtoDefinition
enum = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"enum"
          DotProtoIdentifier
ename <- ProtoParser DotProtoIdentifier
singleIdentifier
          [DotProtoEnumPart]
ebody <- ProtoParser [DotProtoEnumPart] -> ProtoParser [DotProtoEnumPart]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
braces (ProtoParser DotProtoEnumPart -> ProtoParser [DotProtoEnumPart]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser DotProtoEnumPart
enumStatement)
          DotProtoDefinition -> ProtoParser DotProtoDefinition
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoDefinition -> ProtoParser DotProtoDefinition)
-> DotProtoDefinition -> ProtoParser DotProtoDefinition
forall a b. (a -> b) -> a -> b
$ String
-> DotProtoIdentifier -> [DotProtoEnumPart] -> DotProtoDefinition
DotProtoEnum String
forall a. Monoid a => a
mempty DotProtoIdentifier
ename [DotProtoEnumPart]
ebody

--------------------------------------------------------------------------------
-- field reservations

range :: ProtoParser DotProtoReservedField
range :: ProtoParser DotProtoReservedField
range = do ProtoParser String -> ProtoParser String
forall (m :: * -> *) a. LookAheadParsing m => m a -> m a
lookAhead (ProtoParser Integer
forall (m :: * -> *). TokenParsing m => m Integer
integer ProtoParser Integer -> ProtoParser String -> ProtoParser String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"to") -- [note] parsec commits to this parser too early without this lookahead
           Int
s <- Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> ProtoParser Integer -> ProtoParser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Integer
forall (m :: * -> *). TokenParsing m => m Integer
integer
           String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"to"
           Int
e <- Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> ProtoParser Integer -> ProtoParser Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Integer
forall (m :: * -> *). TokenParsing m => m Integer
integer
           DotProtoReservedField -> ProtoParser DotProtoReservedField
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoReservedField -> ProtoParser DotProtoReservedField)
-> DotProtoReservedField -> ProtoParser DotProtoReservedField
forall a b. (a -> b) -> a -> b
$ Int -> Int -> DotProtoReservedField
FieldRange Int
s Int
e

ranges :: ProtoParser [DotProtoReservedField]
ranges :: ProtoParser [DotProtoReservedField]
ranges = ProtoParser DotProtoReservedField
-> ProtoParser [DotProtoReservedField]
forall (m :: * -> *) a. TokenParsing m => m a -> m [a]
commaSep1 (ProtoParser DotProtoReservedField
-> ProtoParser DotProtoReservedField
forall (m :: * -> *) a. Parsing m => m a -> m a
try ProtoParser DotProtoReservedField
range ProtoParser DotProtoReservedField
-> ProtoParser DotProtoReservedField
-> ProtoParser DotProtoReservedField
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Int -> DotProtoReservedField
SingleField (Int -> DotProtoReservedField)
-> (Integer -> Int) -> Integer -> DotProtoReservedField
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> DotProtoReservedField)
-> ProtoParser Integer -> ProtoParser DotProtoReservedField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser Integer
forall (m :: * -> *). TokenParsing m => m Integer
integer))

reservedField :: ProtoParser [DotProtoReservedField]
reservedField :: ProtoParser [DotProtoReservedField]
reservedField = do String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"reserved"
                   [DotProtoReservedField]
v <- ProtoParser [DotProtoReservedField]
ranges ProtoParser [DotProtoReservedField]
-> ProtoParser [DotProtoReservedField]
-> ProtoParser [DotProtoReservedField]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoReservedField
-> ProtoParser [DotProtoReservedField]
forall (m :: * -> *) a. TokenParsing m => m a -> m [a]
commaSep1 (String -> DotProtoReservedField
ReservedIdentifier (String -> DotProtoReservedField)
-> ProtoParser String -> ProtoParser DotProtoReservedField
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser String
strFieldName)
                   ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi
                   [DotProtoReservedField] -> ProtoParser [DotProtoReservedField]
forall (m :: * -> *) a. Monad m => a -> m a
return [DotProtoReservedField]
v

strFieldName :: ProtoParser String
strFieldName :: ProtoParser String
strFieldName =
        ProtoParser Char
-> ProtoParser Char -> ProtoParser String -> ProtoParser String
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"') (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'"') ProtoParser String
identifierName
    ProtoParser String -> ProtoParser String -> ProtoParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser Char
-> ProtoParser Char -> ProtoParser String -> ProtoParser String
forall (m :: * -> *) bra ket a.
Applicative m =>
m bra -> m ket -> m a -> m a
between (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\'') (Char -> ProtoParser Char
forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'\'') ProtoParser String
identifierName

-- Message Extensions ----------------------------------------------------------

pExtendStmt :: ProtoParser (DotProtoIdentifier, [DotProtoMessagePart])
pExtendStmt :: ProtoParser (DotProtoIdentifier, [DotProtoMessagePart])
pExtendStmt = do 
  ProtoParser ()
pExtendKw
  DotProtoIdentifier
idt <- ProtoParser DotProtoIdentifier
identifier
  [DotProtoMessagePart]
fxs <- ProtoParser [DotProtoMessagePart]
-> ProtoParser [DotProtoMessagePart]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
braces (ProtoParser DotProtoMessagePart
-> ProtoParser [DotProtoMessagePart]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ProtoParser DotProtoMessagePart
messagePart)
  (DotProtoIdentifier, [DotProtoMessagePart])
-> ProtoParser (DotProtoIdentifier, [DotProtoMessagePart])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DotProtoIdentifier
idt, [DotProtoMessagePart]
fxs)

-- | Parses a single keyword token "extend".
--
-- @since 0.5.2
pExtendKw :: ProtoParser ()
pExtendKw :: ProtoParser ()
pExtendKw = do
  ProtoParser ()
forall (m :: * -> *). CharParsing m => m ()
spaces 
  ProtoParser () -> ProtoParser ()
forall (m :: * -> *) a. TokenParsing m => m a -> m a
token (String -> ProtoParser String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"extend" ProtoParser String -> ProtoParser () -> ProtoParser ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProtoParser Char -> ProtoParser ()
forall (m :: * -> *) a. (Parsing m, Show a) => m a -> m ()
notFollowedBy ProtoParser Char
forall (m :: * -> *). CharParsing m => m Char
alphaNum) 
    ProtoParser () -> String -> ProtoParser ()
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"keyword 'extend'"