{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
-- |
-- Module      :  Language.Thrift.Parser
-- Copyright   :  (c) Abhinav Gupta 2016
-- License     :  BSD3
--
-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>
-- Stability   :  experimental
--
-- Provides a parser for Thrift IDLs.
--
-- In addition to parsing the IDLs, the parser also keeps track of
-- Javadoc-style docstrings on defined items and makes their values available.
-- For example,
--
-- > /**
-- >  * Fetches an item.
-- >  */
-- > Item getItem()
--
-- Note that the parser does not validate the Thrift file for correctness, so,
-- for example, you could define a string value for an int constant.
--
module Language.Thrift.Parser
    ( parseFromFile
    , parse
    , thriftIDL

    -- * Components

    , program

    , header
    , include
    , namespace

    , definition
    , constant
    , typeDefinition
    , service

    , typedef
    , enum
    , struct
    , union
    , exception
    , senum

    , typeReference
    , constantValue

    , docstring

    -- * Parser

    , Parser
    , runParser
    , whiteSpace
    ) where

import Control.Applicative
import Control.Monad
import Control.Monad.Trans.State (StateT)
import Data.Functor              (($>))
import Data.Proxy                (Proxy (Proxy))
import Data.Scientific           (floatingOrInteger)
import Data.Text                 (Text)
import Data.Void                 (Void)

import qualified Control.Monad.Trans.State  as State
import qualified Data.List.NonEmpty         as NonEmpty
import qualified Data.Text                  as Text
import qualified Data.Text.IO               as Text
import qualified Text.Megaparsec            as P
import qualified Text.Megaparsec.Char       as PC
import qualified Text.Megaparsec.Char.Lexer as PL

import Language.Thrift.Internal.Reserved (isReserved)

import qualified Language.Thrift.AST as T

-- | Keeps track of the last docstring seen by the system so that we can
-- attach it to entities.
newtype State = State
    { State -> Docstring
stateDocstring :: T.Docstring
    }
    deriving (Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show, State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq)

-- | Underlying Parser type.
type Parser s = StateT State (P.Parsec Void s)

-- | Evaluates the underlying parser with a default state and get the Megaparsec
-- parser.
runParser :: P.Stream s => Parser s a -> P.Parsec Void s a
runParser :: Parser s a -> Parsec Void s a
runParser Parser s a
p = Parser s a -> State -> Parsec Void s a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
State.evalStateT Parser s a
p (Docstring -> State
State Docstring
forall a. Maybe a
Nothing)

-- | Parses the Thrift file at the given path.
parseFromFile
    :: FilePath
    -> IO (Either (P.ParseErrorBundle Text Void) (T.Program P.SourcePos))
parseFromFile :: String
-> IO (Either (ParseErrorBundle Text Void) (Program SourcePos))
parseFromFile String
path = Parsec Void Text (Program SourcePos)
-> String
-> Text
-> Either (ParseErrorBundle Text Void) (Program SourcePos)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec Void Text (Program SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parsec Void s (Program SourcePos)
thriftIDL String
path (Text -> Either (ParseErrorBundle Text Void) (Program SourcePos))
-> IO Text
-> IO (Either (ParseErrorBundle Text Void) (Program SourcePos))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
Text.readFile String
path

-- | @parse name contents@ parses the contents of a Thrift document with name
-- @name@ held in @contents@.
parse
    :: (P.TraversableStream s, P.Token s ~ Char)
    => FilePath
    -> s -> Either (P.ParseErrorBundle s Void) (T.Program P.SourcePos)
parse :: String -> s -> Either (ParseErrorBundle s Void) (Program SourcePos)
parse = Parsec Void s (Program SourcePos)
-> String
-> s
-> Either (ParseErrorBundle s Void) (Program SourcePos)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
P.parse Parsec Void s (Program SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parsec Void s (Program SourcePos)
thriftIDL

-- | Megaparsec parser that is able to parse full Thrift documents.
thriftIDL
    :: (P.TraversableStream s, P.Token s ~ Char)
    => P.Parsec Void s (T.Program P.SourcePos)
thriftIDL :: Parsec Void s (Program SourcePos)
thriftIDL = Parser s (Program SourcePos) -> Parsec Void s (Program SourcePos)
forall s a. Stream s => Parser s a -> Parsec Void s a
runParser Parser s (Program SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Program SourcePos)
program


clearDocstring :: P.Stream s => Parser s ()
clearDocstring :: Parser s ()
clearDocstring = (State -> State) -> Parser s ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify' (\State
s -> State
s { stateDocstring :: Docstring
stateDocstring = Docstring
forall a. Maybe a
Nothing })


-- | Returns the last docstring recorded by the parser and forgets about it.
lastDocstring :: P.Stream s => Parser s T.Docstring
lastDocstring :: Parser s Docstring
lastDocstring = do
    Docstring
s <- (State -> Docstring) -> Parser s Docstring
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
State.gets State -> Docstring
stateDocstring
    Parser s ()
forall s. Stream s => Parser s ()
clearDocstring
    Docstring -> Parser s Docstring
forall (m :: * -> *) a. Monad m => a -> m a
return Docstring
s

-- | Optional whitespace.
whiteSpace :: (P.TraversableStream s, P.Token s ~ Char) => Parser s ()
whiteSpace :: Parser s ()
whiteSpace = Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
someSpace Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Required whitespace.
someSpace :: (P.TraversableStream s, P.Token s ~ Char) => Parser s ()
someSpace :: Parser s ()
someSpace = Parser s () -> Parser s ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipSome (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Parser s ()
readDocstring Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser s ()
skipComments Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser s ()
skipSpace
  where
    readDocstring :: Parser s ()
readDocstring = do
        Text
s <- Parser s Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
docstring
        Bool -> Parser s () -> Parser s ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
Text.null Text
s) (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall a b. (a -> b) -> a -> b
$
            (State -> State) -> Parser s ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
State.modify' (\State
st -> State
st { stateDocstring :: Docstring
stateDocstring = Text -> Docstring
forall a. a -> Maybe a
Just Text
s})

    skipSpace :: Parser s ()
skipSpace = [Parser s ()] -> Parser s ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
      [ StateT State (Parsec Void s) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
PC.newline StateT State (Parsec Void s) Char -> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
forall s. Stream s => Parser s ()
clearDocstring
      , StateT State (Parsec Void s) Char -> Parser s ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipSome StateT State (Parsec Void s) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
PC.spaceChar
      ]

    skipComments :: Parser s ()
skipComments = [Parser s ()] -> Parser s ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
        [ Token s -> StateT State (Parsec Void s) (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
PC.char Char
Token s
'#'            StateT State (Parsec Void s) Char -> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
skipLine
        , StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> StateT State (Parsec Void s) (Tokens s)
forall s.
(Stream s, Token s ~ Char) =>
String -> Parser s (Tokens s)
string String
"//") StateT State (Parsec Void s) (Tokens s)
-> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
skipLine
        , StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> StateT State (Parsec Void s) (Tokens s)
forall s.
(Stream s, Token s ~ Char) =>
String -> Parser s (Tokens s)
string String
"/*") StateT State (Parsec Void s) (Tokens s)
-> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
skipCStyleComment
        ] Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
forall s. Stream s => Parser s ()
clearDocstring

    skipLine :: Parser s ()
skipLine = StateT State (Parsec Void s) (Tokens s) -> Parser s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
PC.eol Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser s ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (StateT State (Parsec Void s) Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
P.anySingle StateT State (Parsec Void s) Char -> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
skipLine)

    skipCStyleComment :: Parser s ()
skipCStyleComment = [Parser s ()] -> Parser s ()
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
      [ StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> StateT State (Parsec Void s) (Tokens s)
forall s.
(Stream s, Token s ~ Char) =>
String -> Parser s (Tokens s)
string String
"*/")   StateT State (Parsec Void s) (Tokens s) -> () -> Parser s ()
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> ()
      , StateT State (Parsec Void s) Char -> Parser s ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipSome (String -> StateT State (Parsec Void s) Char
forall s. (Stream s, Token s ~ Char) => String -> Parser s Char
noneOf String
"/*") Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
skipCStyleComment
      , String -> StateT State (Parsec Void s) Char
forall s. (Stream s, Token s ~ Char) => String -> Parser s Char
oneOf String
"/*"               StateT State (Parsec Void s) Char -> Parser s () -> Parser s ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
skipCStyleComment
      ]

oneOf :: (P.Stream s, P.Token s ~ Char) => String -> Parser s Char
oneOf :: String -> Parser s Char
oneOf = String -> Parser s Char
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
P.oneOf
{-# INLINE oneOf #-}

noneOf :: (P.Stream s, P.Token s ~ Char) => String -> Parser s Char
noneOf :: String -> Parser s Char
noneOf = String -> Parser s Char
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
P.noneOf
{-# INLINE noneOf #-}

-- | @p `skipUpTo` n@ skips @p@ @n@ times or until @p@ stops matching --
-- whichever comes first.
skipUpTo :: P.Stream s => Parser s a -> Int -> Parser s ()
skipUpTo :: Parser s a -> Int -> Parser s ()
skipUpTo Parser s a
p = Int -> Parser s ()
loop
  where
    loop :: Int -> Parser s ()
loop Int
0 = () -> Parser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop Int
n =
        ( do
            Parser s a -> Parser s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser s a -> Parser s ()) -> Parser s a -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Parser s a -> Parser s a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try Parser s a
p
            Int -> Parser s ()
loop (Int -> Parser s ()) -> Int -> Parser s ()
forall a b. (a -> b) -> a -> b
$! Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        ) Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> Parser s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

hspace :: (P.Stream s, P.Token s ~ Char) => Parser s ()
hspace :: Parser s ()
hspace = StateT State (Parsec Void s) Char -> Parser s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT State (Parsec Void s) Char -> Parser s ())
-> StateT State (Parsec Void s) Char -> Parser s ()
forall a b. (a -> b) -> a -> b
$ String -> StateT State (Parsec Void s) Char
forall s. (Stream s, Token s ~ Char) => String -> Parser s Char
oneOf String
" \t"

-- | A javadoc-style docstring.
--
-- > /**
-- >  * foo
-- >  */
--
-- This parses attempts to preserve indentation inside the docstring while
-- getting rid of the aligned @*@s (if any) and any other preceding space.
--
docstring :: (P.TraversableStream s, P.Token s ~ Char) => Parser s Text
docstring :: Parser s Text
docstring = do
    StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> StateT State (Parsec Void s) (Tokens s)
forall s.
(Stream s, Token s ~ Char) =>
String -> Parser s (Tokens s)
string String
"/**") StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT State (Parsec Void s) () -> StateT State (Parsec Void s) ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipMany StateT State (Parsec Void s) ()
forall s. (Stream s, Token s ~ Char) => Parser s ()
hspace
    Int
indent <- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Pos -> Int) -> Pos -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pos -> Int
P.unPos (Pos -> Int)
-> StateT State (Parsec Void s) Pos
-> StateT State (Parsec Void s) Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Pos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m Pos
PL.indentLevel
    Bool
isNewLine <- StateT State (Parsec Void s) Bool
maybeEOL
    [Text]
chunks <- Bool -> Int -> [Text] -> StateT State (Parsec Void s) [Text]
loop Bool
isNewLine (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) []
    Text -> Parser s Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Parser s Text) -> Text -> Parser s Text
forall a b. (a -> b) -> a -> b
$! Text -> [Text] -> Text
Text.intercalate Text
"\n" [Text]
chunks
  where
    maybeEOL :: StateT State (Parsec Void s) Bool
maybeEOL = (StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
PC.eol StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) Bool
-> StateT State (Parsec Void s) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> StateT State (Parsec Void s) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) StateT State (Parsec Void s) Bool
-> StateT State (Parsec Void s) Bool
-> StateT State (Parsec Void s) Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> StateT State (Parsec Void s) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    commentChar :: StateT State (Parsec Void s) Char
commentChar =
        String -> StateT State (Parsec Void s) Char
forall s. (Stream s, Token s ~ Char) => String -> Parser s Char
noneOf String
"*\r\n" StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
        StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Token s -> StateT State (Parsec Void s) (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
PC.char Char
Token s
'*' StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
P.notFollowedBy (Token s -> StateT State (Parsec Void s) (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
PC.char Char
Token s
'/'))

    loop :: Bool -> Int -> [Text] -> StateT State (Parsec Void s) [Text]
loop Bool
shouldDedent Int
maxDedent [Text]
chunks = do
        Bool
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldDedent (StateT State (Parsec Void s) ()
 -> StateT State (Parsec Void s) ())
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) ()
forall a b. (a -> b) -> a -> b
$
            StateT State (Parsec Void s) ()
forall s. (Stream s, Token s ~ Char) => Parser s ()
hspace StateT State (Parsec Void s) ()
-> Int -> StateT State (Parsec Void s) ()
forall s a. Stream s => Parser s a -> Int -> Parser s ()
`skipUpTo` Int
maxDedent
        StateT State (Parsec Void s) [Text]
finishComment StateT State (Parsec Void s) [Text]
-> StateT State (Parsec Void s) [Text]
-> StateT State (Parsec Void s) [Text]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT State (Parsec Void s) [Text]
readDocLine
      where
        finishComment :: StateT State (Parsec Void s) [Text]
finishComment = do
            StateT State (Parsec Void s) () -> StateT State (Parsec Void s) ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (StateT State (Parsec Void s) () -> StateT State (Parsec Void s) ()
forall (m :: * -> *) a. MonadPlus m => m a -> m ()
P.skipMany StateT State (Parsec Void s) ()
forall s. (Stream s, Token s ~ Char) => Parser s ()
hspace StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* String -> StateT State (Parsec Void s) (Tokens s)
forall s.
(Stream s, Token s ~ Char) =>
String -> Parser s (Tokens s)
string String
"*/")
            StateT State (Parsec Void s) (Maybe Char)
-> StateT State (Parsec Void s) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT State (Parsec Void s) (Maybe Char)
 -> StateT State (Parsec Void s) ())
-> StateT State (Parsec Void s) (Maybe Char)
-> StateT State (Parsec Void s) ()
forall a b. (a -> b) -> a -> b
$ StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT State (Parsec Void s) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
PC.spaceChar
            [Text] -> StateT State (Parsec Void s) [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> StateT State (Parsec Void s) [Text])
-> [Text] -> StateT State (Parsec Void s) [Text]
forall a b. (a -> b) -> a -> b
$! [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
chunks
        readDocLine :: StateT State (Parsec Void s) [Text]
readDocLine = do
            -- Lines could have aligned *s at the start.
            --
            --      /**
            --       * foo
            --       * bar
            --       */
            --
            -- But only if we dedented. If we didn't, that's possibly because,
            --
            --      /** foo [..]
            --
            -- So if foo starts with "*", we don't want to drop that.
            Bool
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldDedent (StateT State (Parsec Void s) ()
 -> StateT State (Parsec Void s) ())
-> (StateT State (Parsec Void s) (Maybe (Maybe ()))
    -> StateT State (Parsec Void s) ())
-> StateT State (Parsec Void s) (Maybe (Maybe ()))
-> StateT State (Parsec Void s) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT State (Parsec Void s) (Maybe (Maybe ()))
-> StateT State (Parsec Void s) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT State (Parsec Void s) (Maybe (Maybe ()))
 -> StateT State (Parsec Void s) ())
-> StateT State (Parsec Void s) (Maybe (Maybe ()))
-> StateT State (Parsec Void s) ()
forall a b. (a -> b) -> a -> b
$
                StateT State (Parsec Void s) (Maybe ())
-> StateT State (Parsec Void s) (Maybe (Maybe ()))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT State (Parsec Void s) (Maybe ())
 -> StateT State (Parsec Void s) (Maybe (Maybe ())))
-> StateT State (Parsec Void s) (Maybe ())
-> StateT State (Parsec Void s) (Maybe (Maybe ()))
forall a b. (a -> b) -> a -> b
$ StateT State (Parsec Void s) (Maybe ())
-> StateT State (Parsec Void s) (Maybe ())
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Token s -> StateT State (Parsec Void s) (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
PC.char Char
Token s
'*' StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) (Maybe ())
-> StateT State (Parsec Void s) (Maybe ())
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT State (Parsec Void s) ()
forall s. (Stream s, Token s ~ Char) => Parser s ()
hspace)

            Text
line <- String -> Text
Text.pack (String -> Text)
-> StateT State (Parsec Void s) String -> Parser s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
P.many StateT State (Parsec Void s) Char
commentChar

            -- This line most likely ends with a newline but if it's the last
            -- one, it could also be "foo */"
            StateT State (Parsec Void s) Bool
-> StateT State (Parsec Void s) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT State (Parsec Void s) ()
forall s. (Stream s, Token s ~ Char) => Parser s ()
hspace StateT State (Parsec Void s) (Maybe ())
-> StateT State (Parsec Void s) Bool
-> StateT State (Parsec Void s) Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT State (Parsec Void s) Bool
maybeEOL)

            Bool -> Int -> [Text] -> StateT State (Parsec Void s) [Text]
loop Bool
True Int
maxDedent (Text
lineText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text]
chunks)


symbolic :: forall s. (P.TraversableStream s, P.Token s ~ Char) => Char -> Parser s ()
symbolic :: Char -> Parser s ()
symbolic Char
c = StateT State (Parsec Void s) (Tokens s) -> Parser s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT State (Parsec Void s) (Tokens s) -> Parser s ())
-> StateT State (Parsec Void s) (Tokens s) -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Parser s () -> Tokens s -> StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
m () -> Tokens s -> m (Tokens s)
PL.symbol Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
whiteSpace (Proxy s -> Token s -> Tokens s
forall s. Stream s => Proxy s -> Token s -> Tokens s
P.tokenToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s) Char
Token s
c)

token :: (P.TraversableStream s, P.Token s ~ Char) => Parser s a -> Parser s a
token :: Parser s a -> Parser s a
token = StateT State (Parsec Void s) () -> Parser s a -> Parser s a
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
PL.lexeme StateT State (Parsec Void s) ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
whiteSpace

braces, angles, parens
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s a -> Parser s a

braces :: Parser s a -> Parser s a
braces = StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) () -> Parser s a -> Parser s a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Char -> StateT State (Parsec Void s) ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'{') (Char -> StateT State (Parsec Void s) ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'}')
angles :: Parser s a -> Parser s a
angles = StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) () -> Parser s a -> Parser s a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Char -> StateT State (Parsec Void s) ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'<') (Char -> StateT State (Parsec Void s) ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'>')
parens :: Parser s a -> Parser s a
parens = StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) () -> Parser s a -> Parser s a
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
P.between (Char -> StateT State (Parsec Void s) ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'(') (Char -> StateT State (Parsec Void s) ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
')')

comma, semi, colon, equals :: (P.TraversableStream s, P.Token s ~ Char) => Parser s ()

comma :: Parser s ()
comma  = Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
','
semi :: Parser s ()
semi   = Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
';'
colon :: Parser s ()
colon  = Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
':'
equals :: Parser s ()
equals = Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'='

-- | errorUnlessReserved ensures that the given identifier is in the
-- reservedKeywords list. If it's not, we have a bug and we should crash.
errorUnlessReserved :: Monad m => String -> m ()
errorUnlessReserved :: String -> m ()
errorUnlessReserved String
name =
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
isReserved String
name) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall a. HasCallStack => String -> a
error (String
"reserved called with unreserved identifier " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
name)

-- | Parses a reserved identifier and adds it to the collection of known
-- reserved keywords.
reserved :: (P.TraversableStream s, P.Token s ~ Char) => String -> Parser s ()
reserved :: String -> Parser s ()
reserved String
name =
    String -> Parser s () -> ()
forall (m :: * -> *). Monad m => String -> m ()
errorUnlessReserved String
name (Parser s () -> ())
-> (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    String -> Parser s () -> Parser s ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
name (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Parser s () -> Parser s ()
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
token (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Parser s () -> Parser s ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (Parser s () -> Parser s ()) -> Parser s () -> Parser s ()
forall a b. (a -> b) -> a -> b
$ do
        StateT State (Parsec Void s) (Tokens s) -> Parser s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> StateT State (Parsec Void s) (Tokens s)
forall s.
(Stream s, Token s ~ Char) =>
String -> Parser s (Tokens s)
string String
name)
        StateT State (Parsec Void s) Char -> Parser s ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
P.notFollowedBy (StateT State (Parsec Void s) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
PC.alphaNumChar StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> StateT State (Parsec Void s) Char
forall s. (Stream s, Token s ~ Char) => String -> Parser s Char
oneOf String
"_.")


-- | A string literal. @"hello"@
literal :: (P.TraversableStream s, P.Token s ~ Char) => Parser s Text
literal :: Parser s Text
literal = String -> Parser s Text -> Parser s Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"string literal" (Parser s Text -> Parser s Text) -> Parser s Text -> Parser s Text
forall a b. (a -> b) -> a -> b
$ Parser s Text -> Parser s Text
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
token (Parser s Text -> Parser s Text) -> Parser s Text -> Parser s Text
forall a b. (a -> b) -> a -> b
$
    Char -> Parser s Text
forall s. (Stream s, Token s ~ Char) => Char -> Parser s Text
stringLiteral Char
'"' Parser s Text -> Parser s Text -> Parser s Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser s Text
forall s. (Stream s, Token s ~ Char) => Char -> Parser s Text
stringLiteral Char
'\''

stringLiteral :: (P.Stream s, P.Token s ~ Char) => Char -> Parser s Text
stringLiteral :: Char -> Parser s Text
stringLiteral Char
q = (String -> Text)
-> StateT State (Parsec Void s) String -> Parser s Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
Text.pack (StateT State (Parsec Void s) String -> Parser s Text)
-> StateT State (Parsec Void s) String -> Parser s Text
forall a b. (a -> b) -> a -> b
$
    Token s -> StateT State (Parsec Void s) (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
PC.char Char
Token s
q StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) String
-> StateT State (Parsec Void s) String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
P.manyTill StateT State (Parsec Void s) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Char
PL.charLiteral (Token s -> StateT State (Parsec Void s) (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
PC.char Char
Token s
q)


integer :: (P.TraversableStream s, P.Token s ~ Char) => Parser s Integer
integer :: Parser s Integer
integer = Parser s Integer -> Parser s Integer
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
token Parser s Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
PL.decimal


-- | An identifier in a Thrift file.
identifier :: (P.TraversableStream s, P.Token s ~ Char) => Parser s Text
identifier :: Parser s Text
identifier = String -> Parser s Text -> Parser s Text
forall e s (m :: * -> *) a.
MonadParsec e s m =>
String -> m a -> m a
P.label String
"identifier" (Parser s Text -> Parser s Text) -> Parser s Text -> Parser s Text
forall a b. (a -> b) -> a -> b
$ Parser s Text -> Parser s Text
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
token (Parser s Text -> Parser s Text) -> Parser s Text -> Parser s Text
forall a b. (a -> b) -> a -> b
$ do
    String
name <- (:)
        (Char -> ShowS)
-> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT State (Parsec Void s) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
PC.letterChar StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Token s -> StateT State (Parsec Void s) (Token s)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
PC.char Char
Token s
'_')
        StateT State (Parsec Void s) ShowS
-> StateT State (Parsec Void s) String
-> StateT State (Parsec Void s) String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT State (Parsec Void s) Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
PC.alphaNumChar StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
-> StateT State (Parsec Void s) Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> StateT State (Parsec Void s) Char
forall s. (Stream s, Token s ~ Char) => String -> Parser s Char
oneOf String
"_.")
    Bool
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
isReserved String
name) (StateT State (Parsec Void s) ()
 -> StateT State (Parsec Void s) ())
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) ()
forall a b. (a -> b) -> a -> b
$
        ErrorItem (Token s) -> StateT State (Parsec Void s) ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ErrorItem (Token s) -> m a
P.unexpected (NonEmpty Char -> ErrorItem Char
forall t. NonEmpty Char -> ErrorItem t
P.Label (String -> NonEmpty Char
forall a. [a] -> NonEmpty a
NonEmpty.fromList String
name))
    Text -> Parser s Text
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
Text.pack String
name)


-- | Top-level parser to parse complete Thrift documents.
program :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Program P.SourcePos)
program :: Parser s (Program SourcePos)
program = Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
whiteSpace Parser s ()
-> Parser s (Program SourcePos) -> Parser s (Program SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    [Header SourcePos] -> [Definition SourcePos] -> Program SourcePos
forall srcAnnot.
[Header srcAnnot] -> [Definition srcAnnot] -> Program srcAnnot
T.Program
        ([Header SourcePos] -> [Definition SourcePos] -> Program SourcePos)
-> StateT State (Parsec Void s) [Header SourcePos]
-> StateT
     State (Parsec Void s) ([Definition SourcePos] -> Program SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Header SourcePos)
-> StateT State (Parsec Void s) [Header SourcePos]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT State (Parsec Void s) (Header SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Header SourcePos)
header     StateT State (Parsec Void s) (Header SourcePos)
-> Parser s () -> StateT State (Parsec Void s) (Header SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep)
        StateT
  State (Parsec Void s) ([Definition SourcePos] -> Program SourcePos)
-> StateT State (Parsec Void s) [Definition SourcePos]
-> Parser s (Program SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) (Definition SourcePos)
-> StateT State (Parsec Void s) [Definition SourcePos]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT State (Parsec Void s) (Definition SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Definition SourcePos)
definition StateT State (Parsec Void s) (Definition SourcePos)
-> Parser s ()
-> StateT State (Parsec Void s) (Definition SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep)
        Parser s (Program SourcePos)
-> Parser s () -> Parser s (Program SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser s ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof

-- | Headers defined for the IDL.
header :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Header P.SourcePos)
header :: Parser s (Header SourcePos)
header = [Parser s (Header SourcePos)] -> Parser s (Header SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
  [ Include SourcePos -> Header SourcePos
forall srcAnnot. Include srcAnnot -> Header srcAnnot
T.HeaderInclude   (Include SourcePos -> Header SourcePos)
-> StateT State (Parsec Void s) (Include SourcePos)
-> Parser s (Header SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Include SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Include SourcePos)
include
  , Namespace SourcePos -> Header SourcePos
forall srcAnnot. Namespace srcAnnot -> Header srcAnnot
T.HeaderNamespace (Namespace SourcePos -> Header SourcePos)
-> StateT State (Parsec Void s) (Namespace SourcePos)
-> Parser s (Header SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Namespace SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Namespace SourcePos)
namespace
  ]


-- | The IDL includes another Thrift file.
--
-- > include "common.thrift"
-- >
-- > typedef common.Foo Bar
--
include :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Include P.SourcePos)
include :: Parser s (Include SourcePos)
include = String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"include" Parser s ()
-> Parser s (Include SourcePos) -> Parser s (Include SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s (SourcePos -> Include SourcePos)
-> Parser s (Include SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> SourcePos -> Include SourcePos
forall srcAnnot. Text -> srcAnnot -> Include srcAnnot
T.Include (Text -> SourcePos -> Include SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Include SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
literal)


-- | Namespace directives allows control of the namespace or package
-- name used by the generated code for certain languages.
--
-- > namespace py my_service.generated
namespace
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Namespace P.SourcePos)
namespace :: Parser s (Namespace SourcePos)
namespace = [Parser s (Namespace SourcePos)] -> Parser s (Namespace SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
  [ String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"namespace" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace (Text -> Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State (Parsec Void s) (Text -> SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT State (Parsec Void s) Text
star StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier) StateT
  State (Parsec Void s) (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"cpp_namespace" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"cpp" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"php_namespace" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"php" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"py_module" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"py" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"perl_package" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"perl" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"ruby_namespace" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"rb" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"java_package" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"java" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"cocoa_package" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"cocoa" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"csharp_namespace" Parser s ()
-> Parser s (Namespace SourcePos) -> Parser s (Namespace SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
    Parser s (SourcePos -> Namespace SourcePos)
-> Parser s (Namespace SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> Text -> SourcePos -> Namespace SourcePos
forall srcAnnot. Text -> Text -> srcAnnot -> Namespace srcAnnot
T.Namespace Text
"csharp" (Text -> SourcePos -> Namespace SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> Namespace SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  ]
  where
    star :: StateT State (Parsec Void s) Text
star = Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'*' Parser s ()
-> StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> StateT State (Parsec Void s) Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"*"


-- | Convenience wrapper for parsers expecting a position.
--
-- The position will be retrieved BEFORE the parser itself is executed.
withPosition :: P.TraversableStream s => Parser s (P.SourcePos -> a) -> Parser s a
withPosition :: Parser s (SourcePos -> a) -> Parser s a
withPosition Parser s (SourcePos -> a)
p = StateT State (Parsec Void s) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
P.getSourcePos StateT State (Parsec Void s) SourcePos
-> (SourcePos -> Parser s a) -> Parser s a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \SourcePos
pos -> Parser s (SourcePos -> a)
p Parser s (SourcePos -> a)
-> StateT State (Parsec Void s) SourcePos -> Parser s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SourcePos -> StateT State (Parsec Void s) SourcePos
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourcePos
pos


-- | Convenience wrapper for parsers that expect a docstring and a position.
--
-- > data Foo = Foo { bar :: Bar, doc :: Docstring, pos :: Delta }
-- >
-- > parseFoo = withDocstring $ Foo <$> parseBar
withDocstring :: P.TraversableStream s => Parser s (T.Docstring -> P.SourcePos -> a) -> Parser s a
withDocstring :: Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring Parser s (Docstring -> SourcePos -> a)
p = Parser s Docstring
forall s. Stream s => Parser s Docstring
lastDocstring Parser s Docstring -> (Docstring -> Parser s a) -> Parser s a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Docstring
s -> do
    SourcePos
pos <- StateT State (Parsec Void s) SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
P.getSourcePos
    Parser s (Docstring -> SourcePos -> a)
p Parser s (Docstring -> SourcePos -> a)
-> Parser s Docstring
-> StateT State (Parsec Void s) (SourcePos -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Docstring -> Parser s Docstring
forall (f :: * -> *) a. Applicative f => a -> f a
pure Docstring
s StateT State (Parsec Void s) (SourcePos -> a)
-> StateT State (Parsec Void s) SourcePos -> Parser s a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> SourcePos -> StateT State (Parsec Void s) SourcePos
forall (f :: * -> *) a. Applicative f => a -> f a
pure SourcePos
pos


-- | A constant, type, or service definition.
definition
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Definition P.SourcePos)
definition :: Parser s (Definition SourcePos)
definition = Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
whiteSpace Parser s ()
-> Parser s (Definition SourcePos)
-> Parser s (Definition SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Parser s (Definition SourcePos)]
-> Parser s (Definition SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
    [ Const SourcePos -> Definition SourcePos
forall srcAnnot. Const srcAnnot -> Definition srcAnnot
T.ConstDefinition   (Const SourcePos -> Definition SourcePos)
-> StateT State (Parsec Void s) (Const SourcePos)
-> Parser s (Definition SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Const SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Const SourcePos)
constant
    , Type SourcePos -> Definition SourcePos
forall srcAnnot. Type srcAnnot -> Definition srcAnnot
T.TypeDefinition    (Type SourcePos -> Definition SourcePos)
-> StateT State (Parsec Void s) (Type SourcePos)
-> Parser s (Definition SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Type SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Type SourcePos)
typeDefinition
    , Service SourcePos -> Definition SourcePos
forall srcAnnot. Service srcAnnot -> Definition srcAnnot
T.ServiceDefinition (Service SourcePos -> Definition SourcePos)
-> StateT State (Parsec Void s) (Service SourcePos)
-> Parser s (Definition SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Service SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Service SourcePos)
service
    ]


-- | A type definition.
typeDefinition
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Type P.SourcePos)
typeDefinition :: Parser s (Type SourcePos)
typeDefinition = [Parser s (Type SourcePos)] -> Parser s (Type SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
    [ Typedef SourcePos -> Type SourcePos
forall srcAnnot. Typedef srcAnnot -> Type srcAnnot
T.TypedefType (Typedef SourcePos -> Type SourcePos)
-> StateT State (Parsec Void s) (Typedef SourcePos)
-> Parser s (Type SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Typedef SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Typedef SourcePos)
typedef
    , Enum SourcePos -> Type SourcePos
forall srcAnnot. Enum srcAnnot -> Type srcAnnot
T.EnumType    (Enum SourcePos -> Type SourcePos)
-> StateT State (Parsec Void s) (Enum SourcePos)
-> Parser s (Type SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Enum SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Enum SourcePos)
enum
    , Senum SourcePos -> Type SourcePos
forall srcAnnot. Senum srcAnnot -> Type srcAnnot
T.SenumType   (Senum SourcePos -> Type SourcePos)
-> StateT State (Parsec Void s) (Senum SourcePos)
-> Parser s (Type SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Senum SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Senum SourcePos)
senum
    , Struct SourcePos -> Type SourcePos
forall srcAnnot. Struct srcAnnot -> Type srcAnnot
T.StructType  (Struct SourcePos -> Type SourcePos)
-> StateT State (Parsec Void s) (Struct SourcePos)
-> Parser s (Type SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Struct SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Struct SourcePos)
struct
    ]


-- | A typedef is just an alias for another type.
--
-- > typedef common.Foo Bar
typedef :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Typedef P.SourcePos)
typedef :: Parser s (Typedef SourcePos)
typedef = String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"typedef" Parser s ()
-> Parser s (Typedef SourcePos) -> Parser s (Typedef SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s (Docstring -> SourcePos -> Typedef SourcePos)
-> Parser s (Typedef SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring
    (TypeReference SourcePos
-> Text
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> Typedef SourcePos
forall srcAnnot.
TypeReference srcAnnot
-> Text
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> Typedef srcAnnot
T.Typedef (TypeReference SourcePos
 -> Text
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> Typedef SourcePos)
-> StateT State (Parsec Void s) (TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     (Text
      -> [TypeAnnotation] -> Docstring -> SourcePos -> Typedef SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference StateT
  State
  (Parsec Void s)
  (Text
   -> [TypeAnnotation] -> Docstring -> SourcePos -> Typedef SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> Typedef SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> Typedef SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> Typedef SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations)


-- | Enums are sets of named integer values.
--
-- > enum Role {
-- >     User = 1, Admin
-- >
enum :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Enum P.SourcePos)
enum :: Parser s (Enum SourcePos)
enum = String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"enum" Parser s ()
-> Parser s (Enum SourcePos) -> Parser s (Enum SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s (Docstring -> SourcePos -> Enum SourcePos)
-> Parser s (Enum SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring
    ( Text
-> [EnumDef SourcePos]
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> Enum SourcePos
forall srcAnnot.
Text
-> [EnumDef srcAnnot]
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> Enum srcAnnot
T.Enum
        (Text
 -> [EnumDef SourcePos]
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> Enum SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     ([EnumDef SourcePos]
      -> [TypeAnnotation] -> Docstring -> SourcePos -> Enum SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
        StateT
  State
  (Parsec Void s)
  ([EnumDef SourcePos]
   -> [TypeAnnotation] -> Docstring -> SourcePos -> Enum SourcePos)
-> StateT State (Parsec Void s) [EnumDef SourcePos]
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> Enum SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [EnumDef SourcePos]
-> StateT State (Parsec Void s) [EnumDef SourcePos]
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
braces (StateT State (Parsec Void s) (EnumDef SourcePos)
-> StateT State (Parsec Void s) [EnumDef SourcePos]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT State (Parsec Void s) (EnumDef SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (EnumDef SourcePos)
enumDef)
        StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> Enum SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> Enum SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations
    )


-- | A @struct@, @union@, or @exception@.
--
-- > struct User {
-- >     1: string name
-- >     2: Role role = Role.User;
-- > }
--
-- > union Value {
-- >     1: string stringValue;
-- >     2: i32 intValue;
-- > }
--
-- > exception UserDoesNotExist {
-- >     1: optional string message
-- >     2: required string username
-- > }
struct :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos)
struct :: Parser s (Struct SourcePos)
struct = StateT State (Parsec Void s) StructKind
kind StateT State (Parsec Void s) StructKind
-> (StructKind -> Parser s (Struct SourcePos))
-> Parser s (Struct SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \StructKind
k -> Parser s (Docstring -> SourcePos -> Struct SourcePos)
-> Parser s (Struct SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring
    ( StructKind
-> Text
-> [Field SourcePos]
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> Struct SourcePos
forall srcAnnot.
StructKind
-> Text
-> [Field srcAnnot]
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> Struct srcAnnot
T.Struct StructKind
k
        (Text
 -> [Field SourcePos]
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> Struct SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     ([Field SourcePos]
      -> [TypeAnnotation] -> Docstring -> SourcePos -> Struct SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
        StateT
  State
  (Parsec Void s)
  ([Field SourcePos]
   -> [TypeAnnotation] -> Docstring -> SourcePos -> Struct SourcePos)
-> StateT State (Parsec Void s) [Field SourcePos]
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> Struct SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [Field SourcePos]
-> StateT State (Parsec Void s) [Field SourcePos]
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
braces (StateT State (Parsec Void s) (Field SourcePos)
-> StateT State (Parsec Void s) [Field SourcePos]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT State (Parsec Void s) (Field SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Field SourcePos)
field)
        StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> Struct SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> Struct SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations
    )
  where
    kind :: StateT State (Parsec Void s) StructKind
kind = [StateT State (Parsec Void s) StructKind]
-> StateT State (Parsec Void s) StructKind
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
        [ String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"struct"    Parser s ()
-> StateT State (Parsec Void s) StructKind
-> StateT State (Parsec Void s) StructKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StructKind -> StateT State (Parsec Void s) StructKind
forall (m :: * -> *) a. Monad m => a -> m a
return StructKind
T.StructKind
        , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"union"     Parser s ()
-> StateT State (Parsec Void s) StructKind
-> StateT State (Parsec Void s) StructKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StructKind -> StateT State (Parsec Void s) StructKind
forall (m :: * -> *) a. Monad m => a -> m a
return StructKind
T.UnionKind
        , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"exception" Parser s ()
-> StateT State (Parsec Void s) StructKind
-> StateT State (Parsec Void s) StructKind
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StructKind -> StateT State (Parsec Void s) StructKind
forall (m :: * -> *) a. Monad m => a -> m a
return StructKind
T.ExceptionKind
        ]


-- | A @union@ of types.
union :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos)
union :: Parser s (Struct SourcePos)
union = Parser s (Struct SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Struct SourcePos)
struct
{-# DEPRECATED union "Use struct." #-}

-- | An @exception@ that can be raised by service methods.
exception :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos)
exception :: Parser s (Struct SourcePos)
exception = Parser s (Struct SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Struct SourcePos)
struct
{-# DEPRECATED exception"Use struct." #-}


-- | Whether a field is @required@ or @optional@.
fieldRequiredness
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s T.FieldRequiredness
fieldRequiredness :: Parser s FieldRequiredness
fieldRequiredness = [Parser s FieldRequiredness] -> Parser s FieldRequiredness
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
  [ String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"required" Parser s () -> FieldRequiredness -> Parser s FieldRequiredness
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FieldRequiredness
T.Required
  , String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"optional" Parser s () -> FieldRequiredness -> Parser s FieldRequiredness
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> FieldRequiredness
T.Optional
  ]


-- | A struct field.
field :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Field P.SourcePos)
field :: Parser s (Field SourcePos)
field = Parser s (Docstring -> SourcePos -> Field SourcePos)
-> Parser s (Field SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring (Parser s (Docstring -> SourcePos -> Field SourcePos)
 -> Parser s (Field SourcePos))
-> Parser s (Docstring -> SourcePos -> Field SourcePos)
-> Parser s (Field SourcePos)
forall a b. (a -> b) -> a -> b
$
  Maybe Integer
-> Maybe FieldRequiredness
-> TypeReference SourcePos
-> Text
-> Maybe (ConstValue SourcePos)
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> Field SourcePos
forall srcAnnot.
Maybe Integer
-> Maybe FieldRequiredness
-> TypeReference srcAnnot
-> Text
-> Maybe (ConstValue srcAnnot)
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> Field srcAnnot
T.Field
    (Maybe Integer
 -> Maybe FieldRequiredness
 -> TypeReference SourcePos
 -> Text
 -> Maybe (ConstValue SourcePos)
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> Field SourcePos)
-> StateT State (Parsec Void s) (Maybe Integer)
-> StateT
     State
     (Parsec Void s)
     (Maybe FieldRequiredness
      -> TypeReference SourcePos
      -> Text
      -> Maybe (ConstValue SourcePos)
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Field SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Integer
-> StateT State (Parsec Void s) (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT State (Parsec Void s) Integer
forall s. (TraversableStream s, Token s ~ Char) => Parser s Integer
integer StateT State (Parsec Void s) Integer
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT State (Parsec Void s) ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
colon)
    StateT
  State
  (Parsec Void s)
  (Maybe FieldRequiredness
   -> TypeReference SourcePos
   -> Text
   -> Maybe (ConstValue SourcePos)
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Field SourcePos)
-> StateT State (Parsec Void s) (Maybe FieldRequiredness)
-> StateT
     State
     (Parsec Void s)
     (TypeReference SourcePos
      -> Text
      -> Maybe (ConstValue SourcePos)
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Field SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) FieldRequiredness
-> StateT State (Parsec Void s) (Maybe FieldRequiredness)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional StateT State (Parsec Void s) FieldRequiredness
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s FieldRequiredness
fieldRequiredness
    StateT
  State
  (Parsec Void s)
  (TypeReference SourcePos
   -> Text
   -> Maybe (ConstValue SourcePos)
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Field SourcePos)
-> StateT State (Parsec Void s) (TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     (Text
      -> Maybe (ConstValue SourcePos)
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Field SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference
    StateT
  State
  (Parsec Void s)
  (Text
   -> Maybe (ConstValue SourcePos)
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Field SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     (Maybe (ConstValue SourcePos)
      -> [TypeAnnotation] -> Docstring -> SourcePos -> Field SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
    StateT
  State
  (Parsec Void s)
  (Maybe (ConstValue SourcePos)
   -> [TypeAnnotation] -> Docstring -> SourcePos -> Field SourcePos)
-> StateT State (Parsec Void s) (Maybe (ConstValue SourcePos))
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> Field SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) (ConstValue SourcePos)
-> StateT State (Parsec Void s) (Maybe (ConstValue SourcePos))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (StateT State (Parsec Void s) ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
equals StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) (ConstValue SourcePos)
-> StateT State (Parsec Void s) (ConstValue SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT State (Parsec Void s) (ConstValue SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (ConstValue SourcePos)
constantValue)
    StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> Field SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> Field SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations
    Parser s (Docstring -> SourcePos -> Field SourcePos)
-> StateT State (Parsec Void s) ()
-> Parser s (Docstring -> SourcePos -> Field SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  StateT State (Parsec Void s) ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep


-- | A value defined inside an @enum@.
enumDef :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.EnumDef P.SourcePos)
enumDef :: Parser s (EnumDef SourcePos)
enumDef = Parser s (Docstring -> SourcePos -> EnumDef SourcePos)
-> Parser s (EnumDef SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring (Parser s (Docstring -> SourcePos -> EnumDef SourcePos)
 -> Parser s (EnumDef SourcePos))
-> Parser s (Docstring -> SourcePos -> EnumDef SourcePos)
-> Parser s (EnumDef SourcePos)
forall a b. (a -> b) -> a -> b
$
  Text
-> Maybe Integer
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> EnumDef SourcePos
forall srcAnnot.
Text
-> Maybe Integer
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> EnumDef srcAnnot
T.EnumDef
    (Text
 -> Maybe Integer
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> EnumDef SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     (Maybe Integer
      -> [TypeAnnotation] -> Docstring -> SourcePos -> EnumDef SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
    StateT
  State
  (Parsec Void s)
  (Maybe Integer
   -> [TypeAnnotation] -> Docstring -> SourcePos -> EnumDef SourcePos)
-> StateT State (Parsec Void s) (Maybe Integer)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> EnumDef SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) Integer
-> StateT State (Parsec Void s) (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
equals Parser s ()
-> StateT State (Parsec Void s) Integer
-> StateT State (Parsec Void s) Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser s ()
-> StateT State (Parsec Void s) Integer
-> StateT State (Parsec Void s) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
PL.signed Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
whiteSpace StateT State (Parsec Void s) Integer
forall s. (TraversableStream s, Token s ~ Char) => Parser s Integer
integer)
    StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> EnumDef SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> EnumDef SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations
    Parser s (Docstring -> SourcePos -> EnumDef SourcePos)
-> Parser s ()
-> Parser s (Docstring -> SourcePos -> EnumDef SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep


-- | An string-only enum. These are a deprecated feature of Thrift and shouldn't
-- be used.
senum :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Senum P.SourcePos)
senum :: Parser s (Senum SourcePos)
senum = String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"senum" Parser s ()
-> Parser s (Senum SourcePos) -> Parser s (Senum SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser s (Docstring -> SourcePos -> Senum SourcePos)
-> Parser s (Senum SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring
    ( Text
-> [Text]
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> Senum SourcePos
forall srcAnnot.
Text
-> [Text]
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> Senum srcAnnot
T.Senum
        (Text
 -> [Text]
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> Senum SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     ([Text]
      -> [TypeAnnotation] -> Docstring -> SourcePos -> Senum SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
        StateT
  State
  (Parsec Void s)
  ([Text]
   -> [TypeAnnotation] -> Docstring -> SourcePos -> Senum SourcePos)
-> StateT State (Parsec Void s) [Text]
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> Senum SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [Text]
-> StateT State (Parsec Void s) [Text]
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
braces (StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
literal StateT State (Parsec Void s) Text
-> Parser s () -> StateT State (Parsec Void s) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep))
        StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> Senum SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> Senum SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations
    )


-- | A 'const' definition.
--
-- > const i32 code = 1;
constant :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Const P.SourcePos)
constant :: Parser s (Const SourcePos)
constant = do
  String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"const"
  Parser s (Docstring -> SourcePos -> Const SourcePos)
-> Parser s (Const SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring (Parser s (Docstring -> SourcePos -> Const SourcePos)
 -> Parser s (Const SourcePos))
-> Parser s (Docstring -> SourcePos -> Const SourcePos)
-> Parser s (Const SourcePos)
forall a b. (a -> b) -> a -> b
$
    TypeReference SourcePos
-> Text
-> ConstValue SourcePos
-> Docstring
-> SourcePos
-> Const SourcePos
forall srcAnnot.
TypeReference srcAnnot
-> Text
-> ConstValue srcAnnot
-> Docstring
-> srcAnnot
-> Const srcAnnot
T.Const
        (TypeReference SourcePos
 -> Text
 -> ConstValue SourcePos
 -> Docstring
 -> SourcePos
 -> Const SourcePos)
-> StateT State (Parsec Void s) (TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     (Text
      -> ConstValue SourcePos
      -> Docstring
      -> SourcePos
      -> Const SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference
        StateT
  State
  (Parsec Void s)
  (Text
   -> ConstValue SourcePos
   -> Docstring
   -> SourcePos
   -> Const SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     (ConstValue SourcePos -> Docstring -> SourcePos -> Const SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier StateT State (Parsec Void s) Text
-> Parser s () -> StateT State (Parsec Void s) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
equals)
        StateT
  State
  (Parsec Void s)
  (ConstValue SourcePos -> Docstring -> SourcePos -> Const SourcePos)
-> StateT State (Parsec Void s) (ConstValue SourcePos)
-> Parser s (Docstring -> SourcePos -> Const SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) (ConstValue SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (ConstValue SourcePos)
constantValue
        Parser s (Docstring -> SourcePos -> Const SourcePos)
-> Parser s ()
-> Parser s (Docstring -> SourcePos -> Const SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep


-- | A constant value literal.
constantValue
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.ConstValue P.SourcePos)
constantValue :: Parser s (ConstValue SourcePos)
constantValue = Parser s (SourcePos -> ConstValue SourcePos)
-> Parser s (ConstValue SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Parser s (SourcePos -> ConstValue SourcePos)
 -> Parser s (ConstValue SourcePos))
-> Parser s (SourcePos -> ConstValue SourcePos)
-> Parser s (ConstValue SourcePos)
forall a b. (a -> b) -> a -> b
$ [Parser s (SourcePos -> ConstValue SourcePos)]
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
  [ StateT State (Parsec Void s) (Tokens s)
-> StateT State (Parsec Void s) (Tokens s)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (String -> StateT State (Parsec Void s) (Tokens s)
forall s.
(Stream s, Token s ~ Char) =>
String -> Parser s (Tokens s)
string String
"0x") StateT State (Parsec Void s) (Tokens s)
-> Parser s (SourcePos -> ConstValue SourcePos)
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> SourcePos -> ConstValue SourcePos
forall srcAnnot. Integer -> srcAnnot -> ConstValue srcAnnot
T.ConstInt (Integer -> SourcePos -> ConstValue SourcePos)
-> StateT State (Parsec Void s) Integer
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Integer
-> StateT State (Parsec Void s) Integer
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
token StateT State (Parsec Void s) Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
PL.hexadecimal
  , (Double -> SourcePos -> ConstValue SourcePos)
-> (Integer -> SourcePos -> ConstValue SourcePos)
-> Either Double Integer
-> SourcePos
-> ConstValue SourcePos
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Double -> SourcePos -> ConstValue SourcePos
forall srcAnnot. Double -> srcAnnot -> ConstValue srcAnnot
T.ConstFloat Integer -> SourcePos -> ConstValue SourcePos
forall srcAnnot. Integer -> srcAnnot -> ConstValue srcAnnot
T.ConstInt
                      (Either Double Integer -> SourcePos -> ConstValue SourcePos)
-> StateT State (Parsec Void s) (Either Double Integer)
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (Either Double Integer)
-> StateT State (Parsec Void s) (Either Double Integer)
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
token StateT State (Parsec Void s) (Either Double Integer)
signedNumber
  , Text -> SourcePos -> ConstValue SourcePos
forall srcAnnot. Text -> srcAnnot -> ConstValue srcAnnot
T.ConstLiteral    (Text -> SourcePos -> ConstValue SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
literal
  , Text -> SourcePos -> ConstValue SourcePos
forall srcAnnot. Text -> srcAnnot -> ConstValue srcAnnot
T.ConstIdentifier (Text -> SourcePos -> ConstValue SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
  , [ConstValue SourcePos] -> SourcePos -> ConstValue SourcePos
forall srcAnnot.
[ConstValue srcAnnot] -> srcAnnot -> ConstValue srcAnnot
T.ConstList       ([ConstValue SourcePos] -> SourcePos -> ConstValue SourcePos)
-> StateT State (Parsec Void s) [ConstValue SourcePos]
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) [ConstValue SourcePos]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [ConstValue SourcePos]
constList
  , [(ConstValue SourcePos, ConstValue SourcePos)]
-> SourcePos -> ConstValue SourcePos
forall srcAnnot.
[(ConstValue srcAnnot, ConstValue srcAnnot)]
-> srcAnnot -> ConstValue srcAnnot
T.ConstMap        ([(ConstValue SourcePos, ConstValue SourcePos)]
 -> SourcePos -> ConstValue SourcePos)
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
-> Parser s (SourcePos -> ConstValue SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT
  State
  (Parsec Void s)
  [(ConstValue SourcePos, ConstValue SourcePos)]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [(ConstValue SourcePos, ConstValue SourcePos)]
constMap
  ]
  where
    signedNumber :: StateT State (Parsec Void s) (Either Double Integer)
signedNumber = Scientific -> Either Double Integer
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger (Scientific -> Either Double Integer)
-> StateT State (Parsec Void s) Scientific
-> StateT State (Parsec Void s) (Either Double Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) Scientific
-> StateT State (Parsec Void s) Scientific
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m () -> m a -> m a
PL.signed StateT State (Parsec Void s) ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
whiteSpace StateT State (Parsec Void s) Scientific
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m Scientific
PL.scientific


constList
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s [T.ConstValue P.SourcePos]
constList :: Parser s [ConstValue SourcePos]
constList = Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'[' Parser s ()
-> Parser s [ConstValue SourcePos]
-> Parser s [ConstValue SourcePos]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [ConstValue SourcePos] -> Parser s [ConstValue SourcePos]
forall s.
(TraversableStream s, Token s ~ Char) =>
[ConstValue SourcePos]
-> StateT State (Parsec Void s) [ConstValue SourcePos]
loop []
  where
    loop :: [ConstValue SourcePos]
-> StateT State (Parsec Void s) [ConstValue SourcePos]
loop [ConstValue SourcePos]
xs = [StateT State (Parsec Void s) [ConstValue SourcePos]]
-> StateT State (Parsec Void s) [ConstValue SourcePos]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
      [ Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
']' Parser s ()
-> [ConstValue SourcePos]
-> StateT State (Parsec Void s) [ConstValue SourcePos]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [ConstValue SourcePos] -> [ConstValue SourcePos]
forall a. [a] -> [a]
reverse [ConstValue SourcePos]
xs
      , (:) (ConstValue SourcePos
 -> [ConstValue SourcePos] -> [ConstValue SourcePos])
-> StateT State (Parsec Void s) (ConstValue SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([ConstValue SourcePos] -> [ConstValue SourcePos])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT State (Parsec Void s) (ConstValue SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (ConstValue SourcePos)
constantValue StateT State (Parsec Void s) (ConstValue SourcePos)
-> Parser s ()
-> StateT State (Parsec Void s) (ConstValue SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep)
            StateT
  State
  (Parsec Void s)
  ([ConstValue SourcePos] -> [ConstValue SourcePos])
-> StateT State (Parsec Void s) [ConstValue SourcePos]
-> StateT State (Parsec Void s) [ConstValue SourcePos]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ConstValue SourcePos]
-> StateT State (Parsec Void s) [ConstValue SourcePos]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ConstValue SourcePos]
xs
            StateT State (Parsec Void s) [ConstValue SourcePos]
-> ([ConstValue SourcePos]
    -> StateT State (Parsec Void s) [ConstValue SourcePos])
-> StateT State (Parsec Void s) [ConstValue SourcePos]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [ConstValue SourcePos]
-> StateT State (Parsec Void s) [ConstValue SourcePos]
loop
      ]


constMap
    :: (P.TraversableStream s, P.Token s ~ Char)
    => Parser s [(T.ConstValue P.SourcePos, T.ConstValue P.SourcePos)]
constMap :: Parser s [(ConstValue SourcePos, ConstValue SourcePos)]
constMap = Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'{' Parser s ()
-> Parser s [(ConstValue SourcePos, ConstValue SourcePos)]
-> Parser s [(ConstValue SourcePos, ConstValue SourcePos)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [(ConstValue SourcePos, ConstValue SourcePos)]
-> Parser s [(ConstValue SourcePos, ConstValue SourcePos)]
forall s.
(TraversableStream s, Token s ~ Char) =>
[(ConstValue SourcePos, ConstValue SourcePos)]
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
loop []
  where
    loop :: [(ConstValue SourcePos, ConstValue SourcePos)]
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
loop [(ConstValue SourcePos, ConstValue SourcePos)]
xs = [StateT
   State
   (Parsec Void s)
   [(ConstValue SourcePos, ConstValue SourcePos)]]
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice [
        Char -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
Char -> Parser s ()
symbolic Char
'}' Parser s ()
-> [(ConstValue SourcePos, ConstValue SourcePos)]
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [(ConstValue SourcePos, ConstValue SourcePos)]
-> [(ConstValue SourcePos, ConstValue SourcePos)]
forall a. [a] -> [a]
reverse [(ConstValue SourcePos, ConstValue SourcePos)]
xs
      , (:) ((ConstValue SourcePos, ConstValue SourcePos)
 -> [(ConstValue SourcePos, ConstValue SourcePos)]
 -> [(ConstValue SourcePos, ConstValue SourcePos)])
-> StateT
     State (Parsec Void s) (ConstValue SourcePos, ConstValue SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([(ConstValue SourcePos, ConstValue SourcePos)]
      -> [(ConstValue SourcePos, ConstValue SourcePos)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT
  State (Parsec Void s) (ConstValue SourcePos, ConstValue SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (ConstValue SourcePos, ConstValue SourcePos)
constantValuePair StateT
  State (Parsec Void s) (ConstValue SourcePos, ConstValue SourcePos)
-> Parser s ()
-> StateT
     State (Parsec Void s) (ConstValue SourcePos, ConstValue SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep)
            StateT
  State
  (Parsec Void s)
  ([(ConstValue SourcePos, ConstValue SourcePos)]
   -> [(ConstValue SourcePos, ConstValue SourcePos)])
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [(ConstValue SourcePos, ConstValue SourcePos)]
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(ConstValue SourcePos, ConstValue SourcePos)]
xs
            StateT
  State
  (Parsec Void s)
  [(ConstValue SourcePos, ConstValue SourcePos)]
-> ([(ConstValue SourcePos, ConstValue SourcePos)]
    -> StateT
         State
         (Parsec Void s)
         [(ConstValue SourcePos, ConstValue SourcePos)])
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(ConstValue SourcePos, ConstValue SourcePos)]
-> StateT
     State
     (Parsec Void s)
     [(ConstValue SourcePos, ConstValue SourcePos)]
loop
      ]


constantValuePair
    :: (P.TraversableStream s, P.Token s ~ Char)
    => Parser s (T.ConstValue P.SourcePos, T.ConstValue P.SourcePos)
constantValuePair :: Parser s (ConstValue SourcePos, ConstValue SourcePos)
constantValuePair =
    (,) (ConstValue SourcePos
 -> ConstValue SourcePos
 -> (ConstValue SourcePos, ConstValue SourcePos))
-> StateT State (Parsec Void s) (ConstValue SourcePos)
-> StateT
     State
     (Parsec Void s)
     (ConstValue SourcePos
      -> (ConstValue SourcePos, ConstValue SourcePos))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (StateT State (Parsec Void s) (ConstValue SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (ConstValue SourcePos)
constantValue StateT State (Parsec Void s) (ConstValue SourcePos)
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) (ConstValue SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT State (Parsec Void s) ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
colon)
        StateT
  State
  (Parsec Void s)
  (ConstValue SourcePos
   -> (ConstValue SourcePos, ConstValue SourcePos))
-> StateT State (Parsec Void s) (ConstValue SourcePos)
-> Parser s (ConstValue SourcePos, ConstValue SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StateT State (Parsec Void s) (ConstValue SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (ConstValue SourcePos)
constantValue StateT State (Parsec Void s) (ConstValue SourcePos)
-> StateT State (Parsec Void s) ()
-> StateT State (Parsec Void s) (ConstValue SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT State (Parsec Void s) ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep)


-- | A reference to a built-in or defined field.
typeReference
    :: (P.TraversableStream s, P.Token s ~ Char)
    => Parser s (T.TypeReference P.SourcePos)
typeReference :: Parser s (TypeReference SourcePos)
typeReference = [Parser s (TypeReference SourcePos)]
-> Parser s (TypeReference SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice
  [ Parser s (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
baseType
  , Parser s (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
containerType
  , Parser s (SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Text -> SourcePos -> TypeReference SourcePos
forall srcAnnot. Text -> srcAnnot -> TypeReference srcAnnot
T.DefinedType (Text -> SourcePos -> TypeReference SourcePos)
-> StateT State (Parsec Void s) Text
-> Parser s (SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
  ]


baseType
    :: (P.TraversableStream s, P.Token s ~ Char)
    => Parser s (T.TypeReference P.SourcePos)
baseType :: Parser s (TypeReference SourcePos)
baseType = Parser s (SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Parser s (SourcePos -> TypeReference SourcePos)
 -> Parser s (TypeReference SourcePos))
-> Parser s (SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
forall a b. (a -> b) -> a -> b
$
    [Parser s (SourcePos -> TypeReference SourcePos)]
-> Parser s (SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice [String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
s Parser s ()
-> Parser s (SourcePos -> TypeReference SourcePos)
-> Parser s (SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos
v ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations) | (String
s, [TypeAnnotation] -> SourcePos -> TypeReference SourcePos
v) <- [(String,
  [TypeAnnotation] -> SourcePos -> TypeReference SourcePos)]
forall srcAnnot.
[(String, [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot)]
bases]
  where
    bases :: [(String, [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot)]
bases =
      [ (String
"string", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.StringType)
      , (String
"binary", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.BinaryType)
      , (String
"slist", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.SListType)
      , (String
"bool", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.BoolType)
      , (String
"byte", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.ByteType)
      , (String
"i8", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.ByteType)
      , (String
"i16", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.I16Type)
      , (String
"i32", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.I32Type)
      , (String
"i64", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.I64Type)
      , (String
"double", [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
forall srcAnnot.
[TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.DoubleType)
      ]


containerType
    :: (P.TraversableStream s, P.Token s ~ Char)
    => Parser s (T.TypeReference P.SourcePos)
containerType :: Parser s (TypeReference SourcePos)
containerType = Parser s (SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
forall s a.
TraversableStream s =>
Parser s (SourcePos -> a) -> Parser s a
withPosition (Parser s (SourcePos -> TypeReference SourcePos)
 -> Parser s (TypeReference SourcePos))
-> Parser s (SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
forall a b. (a -> b) -> a -> b
$
    [StateT
   State
   (Parsec Void s)
   ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)]
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
P.choice [StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
mapType, StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
setType, StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
listType] StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations
  where
    mapType :: StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
mapType = String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"map" Parser s ()
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
        StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
angles (TypeReference SourcePos
-> TypeReference SourcePos
-> [TypeAnnotation]
-> SourcePos
-> TypeReference SourcePos
forall srcAnnot.
TypeReference srcAnnot
-> TypeReference srcAnnot
-> [TypeAnnotation]
-> srcAnnot
-> TypeReference srcAnnot
T.MapType (TypeReference SourcePos
 -> TypeReference SourcePos
 -> [TypeAnnotation]
 -> SourcePos
 -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     (TypeReference SourcePos
      -> [TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser s (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference Parser s (TypeReference SourcePos)
-> Parser s () -> Parser s (TypeReference SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
comma) StateT
  State
  (Parsec Void s)
  (TypeReference SourcePos
   -> [TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser s (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference)
    setType :: StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
setType = String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"set" Parser s ()
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
angles (TypeReference SourcePos
-> [TypeAnnotation] -> SourcePos -> TypeReference SourcePos
forall srcAnnot.
TypeReference srcAnnot
-> [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.SetType (TypeReference SourcePos
 -> [TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference)
    listType :: StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
listType = String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"list" Parser s ()
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
angles (TypeReference SourcePos
-> [TypeAnnotation] -> SourcePos -> TypeReference SourcePos
forall srcAnnot.
TypeReference srcAnnot
-> [TypeAnnotation] -> srcAnnot -> TypeReference srcAnnot
T.ListType (TypeReference SourcePos
 -> [TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
-> Parser s (TypeReference SourcePos)
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> SourcePos -> TypeReference SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference)


-- | A service.
--
-- > service MyService {
-- >     // ...
-- > }
service :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Service P.SourcePos)
service :: Parser s (Service SourcePos)
service = do
  String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"service"
  Parser s (Docstring -> SourcePos -> Service SourcePos)
-> Parser s (Service SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring (Parser s (Docstring -> SourcePos -> Service SourcePos)
 -> Parser s (Service SourcePos))
-> Parser s (Docstring -> SourcePos -> Service SourcePos)
-> Parser s (Service SourcePos)
forall a b. (a -> b) -> a -> b
$
    Text
-> Docstring
-> [Function SourcePos]
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> Service SourcePos
forall srcAnnot.
Text
-> Docstring
-> [Function srcAnnot]
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> Service srcAnnot
T.Service
        (Text
 -> Docstring
 -> [Function SourcePos]
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> Service SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     (Docstring
      -> [Function SourcePos]
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Service SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
        StateT
  State
  (Parsec Void s)
  (Docstring
   -> [Function SourcePos]
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Service SourcePos)
-> StateT State (Parsec Void s) Docstring
-> StateT
     State
     (Parsec Void s)
     ([Function SourcePos]
      -> [TypeAnnotation] -> Docstring -> SourcePos -> Service SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) Docstring
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"extends" Parser s ()
-> StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier)
        StateT
  State
  (Parsec Void s)
  ([Function SourcePos]
   -> [TypeAnnotation] -> Docstring -> SourcePos -> Service SourcePos)
-> StateT State (Parsec Void s) [Function SourcePos]
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> Service SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [Function SourcePos]
-> StateT State (Parsec Void s) [Function SourcePos]
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
braces (StateT State (Parsec Void s) (Function SourcePos)
-> StateT State (Parsec Void s) [Function SourcePos]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT State (Parsec Void s) (Function SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Function SourcePos)
function)
        StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> Service SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> Service SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations


-- | A function defined inside a service.
--
-- > Foo getFoo() throws (1: FooDoesNotExist doesNotExist);
-- > oneway void putBar(1: Bar bar);
function
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s (T.Function P.SourcePos)
function :: Parser s (Function SourcePos)
function = Parser s (Docstring -> SourcePos -> Function SourcePos)
-> Parser s (Function SourcePos)
forall s a.
TraversableStream s =>
Parser s (Docstring -> SourcePos -> a) -> Parser s a
withDocstring (Parser s (Docstring -> SourcePos -> Function SourcePos)
 -> Parser s (Function SourcePos))
-> Parser s (Docstring -> SourcePos -> Function SourcePos)
-> Parser s (Function SourcePos)
forall a b. (a -> b) -> a -> b
$
    Bool
-> Maybe (TypeReference SourcePos)
-> Text
-> [Field SourcePos]
-> Maybe [Field SourcePos]
-> [TypeAnnotation]
-> Docstring
-> SourcePos
-> Function SourcePos
forall srcAnnot.
Bool
-> Maybe (TypeReference srcAnnot)
-> Text
-> [Field srcAnnot]
-> Maybe [Field srcAnnot]
-> [TypeAnnotation]
-> Docstring
-> srcAnnot
-> Function srcAnnot
T.Function
        (Bool
 -> Maybe (TypeReference SourcePos)
 -> Text
 -> [Field SourcePos]
 -> Maybe [Field SourcePos]
 -> [TypeAnnotation]
 -> Docstring
 -> SourcePos
 -> Function SourcePos)
-> StateT State (Parsec Void s) Bool
-> StateT
     State
     (Parsec Void s)
     (Maybe (TypeReference SourcePos)
      -> Text
      -> [Field SourcePos]
      -> Maybe [Field SourcePos]
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Function SourcePos)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"oneway" Parser s () -> Bool -> StateT State (Parsec Void s) Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True) StateT State (Parsec Void s) Bool
-> StateT State (Parsec Void s) Bool
-> StateT State (Parsec Void s) Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> StateT State (Parsec Void s) Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
        StateT
  State
  (Parsec Void s)
  (Maybe (TypeReference SourcePos)
   -> Text
   -> [Field SourcePos]
   -> Maybe [Field SourcePos]
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Function SourcePos)
-> StateT State (Parsec Void s) (Maybe (TypeReference SourcePos))
-> StateT
     State
     (Parsec Void s)
     (Text
      -> [Field SourcePos]
      -> Maybe [Field SourcePos]
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Function SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"void" Parser s ()
-> Maybe (TypeReference SourcePos)
-> StateT State (Parsec Void s) (Maybe (TypeReference SourcePos))
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Maybe (TypeReference SourcePos)
forall a. Maybe a
Nothing) StateT State (Parsec Void s) (Maybe (TypeReference SourcePos))
-> StateT State (Parsec Void s) (Maybe (TypeReference SourcePos))
-> StateT State (Parsec Void s) (Maybe (TypeReference SourcePos))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TypeReference SourcePos -> Maybe (TypeReference SourcePos)
forall a. a -> Maybe a
Just (TypeReference SourcePos -> Maybe (TypeReference SourcePos))
-> StateT State (Parsec Void s) (TypeReference SourcePos)
-> StateT State (Parsec Void s) (Maybe (TypeReference SourcePos))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) (TypeReference SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (TypeReference SourcePos)
typeReference)
        StateT
  State
  (Parsec Void s)
  (Text
   -> [Field SourcePos]
   -> Maybe [Field SourcePos]
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Function SourcePos)
-> StateT State (Parsec Void s) Text
-> StateT
     State
     (Parsec Void s)
     ([Field SourcePos]
      -> Maybe [Field SourcePos]
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Function SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
        StateT
  State
  (Parsec Void s)
  ([Field SourcePos]
   -> Maybe [Field SourcePos]
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Function SourcePos)
-> StateT State (Parsec Void s) [Field SourcePos]
-> StateT
     State
     (Parsec Void s)
     (Maybe [Field SourcePos]
      -> [TypeAnnotation]
      -> Docstring
      -> SourcePos
      -> Function SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [Field SourcePos]
-> StateT State (Parsec Void s) [Field SourcePos]
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
parens (StateT State (Parsec Void s) (Field SourcePos)
-> StateT State (Parsec Void s) [Field SourcePos]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT State (Parsec Void s) (Field SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Field SourcePos)
field)
        StateT
  State
  (Parsec Void s)
  (Maybe [Field SourcePos]
   -> [TypeAnnotation]
   -> Docstring
   -> SourcePos
   -> Function SourcePos)
-> StateT State (Parsec Void s) (Maybe [Field SourcePos])
-> StateT
     State
     (Parsec Void s)
     ([TypeAnnotation] -> Docstring -> SourcePos -> Function SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [Field SourcePos]
-> StateT State (Parsec Void s) (Maybe [Field SourcePos])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (String -> Parser s ()
forall s.
(TraversableStream s, Token s ~ Char) =>
String -> Parser s ()
reserved String
"throws" Parser s ()
-> StateT State (Parsec Void s) [Field SourcePos]
-> StateT State (Parsec Void s) [Field SourcePos]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT State (Parsec Void s) [Field SourcePos]
-> StateT State (Parsec Void s) [Field SourcePos]
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
parens (StateT State (Parsec Void s) (Field SourcePos)
-> StateT State (Parsec Void s) [Field SourcePos]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT State (Parsec Void s) (Field SourcePos)
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s (Field SourcePos)
field))
        StateT
  State
  (Parsec Void s)
  ([TypeAnnotation] -> Docstring -> SourcePos -> Function SourcePos)
-> StateT State (Parsec Void s) [TypeAnnotation]
-> Parser s (Docstring -> SourcePos -> Function SourcePos)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateT State (Parsec Void s) [TypeAnnotation]
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s [TypeAnnotation]
typeAnnotations
        Parser s (Docstring -> SourcePos -> Function SourcePos)
-> Parser s ()
-> Parser s (Docstring -> SourcePos -> Function SourcePos)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep


-- | Type annotations on entitites.
--
-- > (foo = "bar", baz = "qux")
--
-- These do not usually affect code generation but allow for custom logic if
-- writing your own code generator.
typeAnnotations
    :: (P.TraversableStream s, P.Token s ~ Char) => Parser s [T.TypeAnnotation]
typeAnnotations :: Parser s [TypeAnnotation]
typeAnnotations = Parser s [TypeAnnotation] -> Parser s [TypeAnnotation]
forall s a.
(TraversableStream s, Token s ~ Char) =>
Parser s a -> Parser s a
parens (StateT State (Parsec Void s) TypeAnnotation
-> Parser s [TypeAnnotation]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many StateT State (Parsec Void s) TypeAnnotation
forall s.
(TraversableStream s, Token s ~ Char) =>
Parser s TypeAnnotation
typeAnnotation) Parser s [TypeAnnotation]
-> Parser s [TypeAnnotation] -> Parser s [TypeAnnotation]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [TypeAnnotation] -> Parser s [TypeAnnotation]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []


typeAnnotation :: (P.TraversableStream s, P.Token s ~ Char) => Parser s T.TypeAnnotation
typeAnnotation :: Parser s TypeAnnotation
typeAnnotation =
    Text -> Docstring -> TypeAnnotation
T.TypeAnnotation
        (Text -> Docstring -> TypeAnnotation)
-> StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) (Docstring -> TypeAnnotation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
identifier
        StateT State (Parsec Void s) (Docstring -> TypeAnnotation)
-> StateT State (Parsec Void s) Docstring
-> Parser s TypeAnnotation
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) Docstring
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
equals Parser s ()
-> StateT State (Parsec Void s) Text
-> StateT State (Parsec Void s) Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> StateT State (Parsec Void s) Text
forall s. (TraversableStream s, Token s ~ Char) => Parser s Text
literal) StateT State (Parsec Void s) Docstring
-> Parser s () -> StateT State (Parsec Void s) Docstring
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
optionalSep)


optionalSep :: (P.TraversableStream s, P.Token s ~ Char) => Parser s ()
optionalSep :: Parser s ()
optionalSep = StateT State (Parsec Void s) (Maybe ()) -> Parser s ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (StateT State (Parsec Void s) (Maybe ()) -> Parser s ())
-> StateT State (Parsec Void s) (Maybe ()) -> Parser s ()
forall a b. (a -> b) -> a -> b
$ Parser s () -> StateT State (Parsec Void s) (Maybe ())
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
comma Parser s () -> Parser s () -> Parser s ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser s ()
forall s. (TraversableStream s, Token s ~ Char) => Parser s ()
semi)

string :: forall s. (P.Stream s, P.Token s ~ Char) => String -> Parser s (P.Tokens s)
string :: String -> Parser s (Tokens s)
string = Tokens s -> Parser s (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
PC.string (Tokens s -> Parser s (Tokens s))
-> (String -> Tokens s) -> String -> Parser s (Tokens s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy s -> [Token s] -> Tokens s
forall s. Stream s => Proxy s -> [Token s] -> Tokens s
P.tokensToChunk (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s)