-- | 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
  ( parseProto
  , parseProtoFile
  ) 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.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
import Text.Parser.Combinators
import Text.Parser.LookAhead
import Text.Parser.Token
import qualified Text.Parser.Token.Style as TokenStyle
import qualified Turtle

----------------------------------------
-- 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

-- Parses a nested identifier, consuming trailing space.
nestedIdentifier :: ProtoParser DotProtoIdentifier
nestedIdentifier :: ProtoParser DotProtoIdentifier
nestedIdentifier = 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
h <- ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. TokenParsing m => m a -> m a
parens ProtoParser DotProtoIdentifier
_identifier
  String -> ProtoParser String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"."
  DotProtoIdentifier
t <- ProtoParser DotProtoIdentifier
_identifier
  DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (m :: * -> *) a. Monad m => a -> m a
return (DotProtoIdentifier -> ProtoParser DotProtoIdentifier)
-> DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall a b. (a -> b) -> a -> b
$ DotProtoIdentifier -> DotProtoIdentifier -> DotProtoIdentifier
Qualified DotProtoIdentifier
h DotProtoIdentifier
t

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

-- [issue] these string parsers are weak to \" and \000 octal codes
stringLit :: ProtoParser String
stringLit :: ProtoParser String
stringLit = ProtoParser String
forall (m :: * -> *) s. (TokenParsing m, IsString s) => m s
stringLiteral ProtoParser String -> ProtoParser String -> ProtoParser String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser String
forall (m :: * -> *) s. (TokenParsing m, IsString s) => m s
stringLiteral'

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
stringLit)
    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
                         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

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

topStatement :: ProtoParser DotProtoStatement
topStatement :: ProtoParser DotProtoStatement
topStatement = DotProtoImport -> DotProtoStatement
DPSImport     (DotProtoImport -> DotProtoStatement)
-> ProtoParser DotProtoImport -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoImport
import_
           ProtoParser DotProtoStatement
-> ProtoParser DotProtoStatement -> ProtoParser DotProtoStatement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DotProtoPackageSpec -> DotProtoStatement
DPSPackage    (DotProtoPackageSpec -> DotProtoStatement)
-> ProtoParser DotProtoPackageSpec -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoPackageSpec
package
           ProtoParser DotProtoStatement
-> ProtoParser DotProtoStatement -> ProtoParser DotProtoStatement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DotProtoOption -> DotProtoStatement
DPSOption     (DotProtoOption -> DotProtoStatement)
-> ProtoParser DotProtoOption -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoOption
topOption
           ProtoParser DotProtoStatement
-> ProtoParser DotProtoStatement -> ProtoParser DotProtoStatement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DotProtoDefinition -> DotProtoStatement
DPSDefinition (DotProtoDefinition -> DotProtoStatement)
-> ProtoParser DotProtoDefinition -> ProtoParser DotProtoStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProtoParser DotProtoDefinition
definition
           ProtoParser DotProtoStatement
-> ProtoParser DotProtoStatement -> ProtoParser DotProtoStatement
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
stringLit
             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
message
         ProtoParser DotProtoDefinition
-> ProtoParser DotProtoDefinition -> ProtoParser DotProtoDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoDefinition
enum
         ProtoParser DotProtoDefinition
-> ProtoParser DotProtoDefinition -> ProtoParser DotProtoDefinition
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoDefinition
service

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

inlineOption :: ProtoParser DotProtoOption
inlineOption :: ProtoParser DotProtoOption
inlineOption = DotProtoIdentifier -> DotProtoValue -> DotProtoOption
DotProtoOption (DotProtoIdentifier -> DotProtoValue -> DotProtoOption)
-> ProtoParser DotProtoIdentifier
-> ProtoParser (DotProtoValue -> DotProtoOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ProtoParser DotProtoIdentifier
optionName ProtoParser DotProtoIdentifier
-> ProtoParser String -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"=") ProtoParser (DotProtoValue -> DotProtoOption)
-> ProtoParser DotProtoValue -> ProtoParser DotProtoOption
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtoParser DotProtoValue
value
  where
    optionName :: ProtoParser DotProtoIdentifier
optionName = ProtoParser DotProtoIdentifier
nestedIdentifier ProtoParser DotProtoIdentifier
-> ProtoParser DotProtoIdentifier -> ProtoParser DotProtoIdentifier
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ProtoParser DotProtoIdentifier
identifier

optionAnnotation :: ProtoParser [DotProtoOption]
optionAnnotation :: ProtoParser [DotProtoOption]
optionAnnotation = ProtoParser [DotProtoOption] -> ProtoParser [DotProtoOption]
forall (m :: * -> *) a. TokenParsing m => m a -> m a
brackets (ProtoParser DotProtoOption -> ProtoParser [DotProtoOption]
forall (m :: * -> *) a. TokenParsing m => m a -> m [a]
commaSep1 ProtoParser DotProtoOption
inlineOption) 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 []

topOption :: ProtoParser DotProtoOption
topOption :: ProtoParser DotProtoOption
topOption = String -> ProtoParser String
forall (m :: * -> *). TokenParsing m => String -> m String
symbol String
"option" ProtoParser String
-> ProtoParser DotProtoOption -> ProtoParser DotProtoOption
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ProtoParser DotProtoOption
inlineOption ProtoParser DotProtoOption
-> ProtoParser Char -> ProtoParser DotProtoOption
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi

--------------------------------------------------------------------------------
-- 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
topOption
          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
topOption

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
topOption)

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]
optionAnnotation
                  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]
optionAnnotation
               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
topOption)
            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
stringLit)
                   ProtoParser Char
forall (m :: * -> *). TokenParsing m => m Char
semi
                   [DotProtoReservedField] -> ProtoParser [DotProtoReservedField]
forall (m :: * -> *) a. Monad m => a -> m a
return [DotProtoReservedField]
v