module Language.Thrift.Parser
( ThriftParser
, runThriftParser
, program
, header
, definition
, typeDefinition
, typedef
, enum
, enumDef
, senum
, struct
, union
, exception
, fieldRequiredness
, fieldType
, field
, constant
, constantValue
, service
, function
, typeAnnotations
) where
import Control.Applicative
import Control.Monad
import Control.Monad.State (StateT)
import Data.Text (Text)
import Text.Trifecta
import Text.Parser.Token.Style (emptyIdents)
import qualified Control.Monad.State as State
import qualified Data.Text as Text
import qualified Language.Thrift.Types as T
newtype ParserState = ParserState
{ parserLastDocstring :: T.Docstring
} deriving (Show, Ord, Eq)
newtype ThriftParser a = ThriftParser (StateT ParserState Parser a)
deriving
( Functor
, Applicative
, Alternative
, Monad
, MonadPlus
, Parsing
, CharParsing
)
lastDocstring :: ThriftParser T.Docstring
lastDocstring = ThriftParser $ do
s <- State.gets parserLastDocstring
State.put (ParserState Nothing)
return s
runThriftParser :: ThriftParser a -> Parser a
runThriftParser (ThriftParser p) = State.evalStateT p (ParserState Nothing)
instance TokenParsing ThriftParser where
someSpace = skipSome $
readDocstring <|> skipComments <|> skipSpace
where
skipSpace = choice [
newline *> clearDocstring
, ThriftParser someSpace
]
skipComments = choice [
char '#' *> skipLine
, text "//" *> skipLine
, text "/*" *> skipCStyleComment
] *> clearDocstring
skipLine = skipMany (satisfy (/= '\n')) <* newline
skipCStyleComment = choice [
text "*/" *> pure ()
, skipSome (noneOf "/*") *> skipCStyleComment
, oneOf "/*" *> skipCStyleComment
]
clearDocstring = ThriftParser $ State.put (ParserState Nothing)
readDocstring = text "/**" *> loop []
where
saveDocstring s = unless (Text.null s') $
ThriftParser . State.put . ParserState . Just $ s'
where
s' = sanitizeDocstring s
loop chunks = choice [
text "*/" *> optional (newline <|> space) *>
saveDocstring (Text.strip . Text.concat $ reverse chunks)
, Text.pack <$> some (noneOf "/*") >>= loop . (:chunks)
, Text.singleton <$> oneOf "/*" >>= loop . (:chunks)
]
sanitizeDocstring =
Text.unlines . map (Text.dropWhile (`elem` "* ")) . Text.lines
idStyle :: IdentifierStyle ThriftParser
idStyle = (emptyIdents :: IdentifierStyle ThriftParser)
{ _styleStart = letter <|> char '_'
, _styleLetter = alphaNum <|> oneOf "_."
}
reserved :: Text -> ThriftParser ()
reserved = reserveText idStyle
program :: ThriftParser (T.Program T.Docstring)
program = whiteSpace >> T.Program <$> many header <*> many definition
literal :: ThriftParser Text
literal = stringLiteral <|> stringLiteral'
identifier :: ThriftParser Text
identifier = ident idStyle
header :: ThriftParser T.Header
header = choice [
reserved "include" >> T.Include <$> literal
, reserved "namespace" >>
T.Namespace <$> (text "*" <|> identifier) <*> identifier
, reserved "cpp_namespace" >> T.Namespace "cpp" <$> identifier
, reserved "php_namespace" >> T.Namespace "php" <$> identifier
, reserved "py_module" >> T.Namespace "py" <$> identifier
, reserved "perl_package" >> T.Namespace "perl" <$> identifier
, reserved "ruby_namespace" >> T.Namespace "rb" <$> identifier
, reserved "java_package" >> T.Namespace "java" <$> identifier
, reserved "cocoa_package" >> T.Namespace "cocoa" <$> identifier
, reserved "csharp_namespace" >> T.Namespace "csharp" <$> identifier
]
docstring :: ThriftParser (T.Docstring -> a) -> ThriftParser a
docstring p = lastDocstring >>= \s -> p <*> pure s
definition :: ThriftParser (T.Definition T.Docstring)
definition = choice [constant, typeDefinition, service]
typeDefinition :: ThriftParser (T.Definition T.Docstring)
typeDefinition =
T.TypeDefinition
<$> choice [typedef, enum, senum, struct, union, exception]
<*> typeAnnotations
typedef :: ThriftParser (T.Type T.Docstring)
typedef = reserved "typedef" >>
docstring (T.Typedef <$> fieldType <*> identifier)
enum :: ThriftParser (T.Type T.Docstring)
enum = reserved "enum" >>
docstring (T.Enum <$> identifier <*> braces (many enumDef))
struct :: ThriftParser (T.Type T.Docstring)
struct = reserved "struct" >>
docstring (T.Struct <$> identifier <*> braces (many field))
union :: ThriftParser (T.Type T.Docstring)
union = reserved "union" >>
docstring (T.Union <$> identifier <*> braces (many field))
exception :: ThriftParser (T.Type T.Docstring)
exception = reserved "exception" >>
docstring (T.Exception <$> identifier <*> braces (many field))
fieldRequiredness :: ThriftParser T.FieldRequiredness
fieldRequiredness = choice [
reserved "required" *> pure T.Required
, reserved "optional" *> pure T.Optional
]
field :: ThriftParser (T.Field T.Docstring)
field = docstring $
T.Field
<$> optional (integer <* symbolic ':')
<*> optional fieldRequiredness
<*> fieldType
<*> identifier
<*> optional (equals *> constantValue)
<*> typeAnnotations
<* optionalSep
equals :: ThriftParser ()
equals = void $ symbolic '='
enumDef :: ThriftParser (T.EnumDef T.Docstring)
enumDef = docstring $
T.EnumDef
<$> identifier
<*> optional (equals *> integer)
<*> typeAnnotations
<* optionalSep
senum :: ThriftParser (T.Type T.Docstring)
senum = reserved "senum" >> docstring
(T.Senum <$> identifier <*> braces (many (literal <* optionalSep)))
constant :: ThriftParser (T.Definition T.Docstring)
constant = do
reserved "const"
docstring $
T.ConstDefinition
<$> fieldType
<*> (identifier <* equals)
<*> constantValue
<* optionalSep
constantValue :: ThriftParser T.ConstValue
constantValue = choice [
either T.ConstInt T.ConstFloat <$> integerOrDouble
, T.ConstLiteral <$> literal
, T.ConstIdentifier <$> identifier
, T.ConstList <$> constList
, T.ConstMap <$> constMap
]
constList :: ThriftParser [T.ConstValue]
constList = brackets $ commaSep (constantValue <* optionalSep)
constMap :: ThriftParser [(T.ConstValue, T.ConstValue)]
constMap = braces $ commaSep constantValuePair
constantValuePair :: ThriftParser (T.ConstValue, T.ConstValue)
constantValuePair =
(,) <$> (constantValue <* colon)
<*> (constantValue <* optionalSep)
fieldType :: ThriftParser T.FieldType
fieldType = choice [
baseType
, containerType
, T.DefinedType <$> identifier
]
baseType :: ThriftParser T.FieldType
baseType =
choice [reserved s *> (v <$> typeAnnotations) | (s, v) <- bases]
where
bases = [
("string", T.StringType)
, ("binary", T.BinaryType)
, ("slist", T.SListType)
, ("bool", T.BoolType)
, ("byte", T.ByteType)
, ("i16", T.I16Type)
, ("i32", T.I32Type)
, ("i64", T.I64Type)
, ("double", T.DoubleType)
]
containerType :: ThriftParser T.FieldType
containerType =
choice [mapType, setType, listType] <*> typeAnnotations
where
mapType = reserved "map" >>
angles (T.MapType <$> (fieldType <* comma) <*> fieldType)
setType = reserved "set" >> angles (T.SetType <$> fieldType)
listType = reserved "list" >> angles (T.ListType <$> fieldType)
service :: ThriftParser (T.Definition T.Docstring)
service = do
reserved "service"
docstring $
T.ServiceDefinition
<$> identifier
<*> optional (reserved "extends" *> identifier)
<*> braces (many function)
<*> typeAnnotations
function :: ThriftParser (T.Function T.Docstring)
function = docstring $
T.Function
<$> ((reserved "oneway" *> pure True) <|> pure False)
<*> ((reserved "void" *> pure Nothing) <|> Just <$> fieldType)
<*> identifier
<*> parens (many field)
<*> optional (reserved "throws" *> parens (many field))
<*> typeAnnotations
<* optionalSep
typeAnnotations :: ThriftParser [T.TypeAnnotation]
typeAnnotations = parens (many typeAnnotation) <|> pure []
typeAnnotation :: ThriftParser T.TypeAnnotation
typeAnnotation =
T.TypeAnnotation
<$> identifier
<*> (equals *> literal <* optionalSep)
optionalSep :: ThriftParser ()
optionalSep = void $ optional (comma <|> semi)