language-thrift 0.2.0.0 → 0.3.0.0

raw patch · 7 files changed

+691/−71 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGES.md +9/−0
• Language/Thrift/Parser.hs +232/−49
• Language/Thrift/Parser/Trifecta.hs +23/−0
• Language/Thrift/Types.hs +180/−13
• README.md +9/−7
• examples/generateHaskellTypes.hs +235/−0
• language-thrift.cabal +3/−2

@@ -1,3 +1,12 @@+0.3.0.0+=======++-   Allow changing the underlying parser to any parser that implements the+    `TokenParsing` class from `parsers`+-   Add `thriftIDLParser` for standard use cases+-   Add `Language.Thrift.Parser.Trifecta` with a standard Trifecta-based+    parser+ 0.2.0.0 ======= 

@@ -1,9 +1,40 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+-- |+-- Module      :  Language.Thrift.Parser+-- Copyright   :  (c) Abhinav Gupta 2015+-- 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-    ( ThriftParser+    (++      thriftIDL++    -- * Parser type++    , ThriftParser     , runThriftParser +    -- * Parser components+     , program     , header     , definition@@ -27,23 +58,51 @@  import Control.Applicative import Control.Monad+import Control.Monad.Reader    (ReaderT) import Control.Monad.State     (StateT)+import Control.Monad.Trans     (lift) import Data.Text               (Text)+import Text.Parser.Char+import Text.Parser.Combinators+import Text.Parser.Token import Text.Parser.Token.Style (emptyIdents)-import Text.Trifecta-import Text.Trifecta.Delta     (Delta) -import qualified Control.Monad.State as State-import qualified Data.Text           as Text+import qualified Control.Monad.Reader as Reader+import qualified Control.Monad.State  as State+import qualified Data.Text            as Text  import qualified Language.Thrift.Types as T  +-- | Get a top level parser that is able to parse full Thrift documents.+--+-- Entities defined in the IDL are annotated with @n@ values (determined by+-- executing @p n@ before the parser for the entity is executed).+--+-- Usage with Trifecta to get entities tagged with location information (see+-- also, 'Language.Thrift.Parser.Trifecta.thriftIDL'):+--+-- > Trifecta.parseFromFile (thriftIDL Trifecta.position) "service.thrift"+--+-- Usage with Attoparsec without any annotations:+--+-- > Attoparsec.parse (thriftIDL (return ())) document+--+thriftIDL :: (MonadPlus p, TokenParsing p) => p n -> p (T.Program n)+thriftIDL getAnnot = runThriftParser getAnnot program+++-- | Keeps track of the last docstring seen by the system so that we can+-- attach it to entities. newtype ParserState = ParserState   { parserLastDocstring :: T.Docstring   } deriving (Show, Ord, Eq) -newtype ThriftParser a = ThriftParser (StateT ParserState Parser a)+-- | The ThriftParser wraps another parser @p@ with some extra state. It also+-- allows injecting a configurable action @(p n)@ which produces annotations+-- that will be attached to entities in the Thrift file. See 'thriftIDLParser'+-- for an example.+newtype ThriftParser p n a = ThriftParser (StateT ParserState (ReaderT (p n) p) a)     deriving       ( Functor       , Applicative@@ -52,21 +111,37 @@       , MonadPlus       , Parsing       , CharParsing-      , DeltaParsing       ) -lastDocstring :: ThriftParser T.Docstring+-- | Returns the last docstring recorded by the system and clears it from the+-- parser state.+lastDocstring :: Monad p => ThriftParser p n 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)+-- | Get an exeecutable parser from the given ThriftParser.+runThriftParser+    :: (MonadPlus p, TokenParsing p)+    => p n+    -- ^ How to get annotations from the underlying parser. If this is not+    -- something you need to use, make it @return ()@ and generated types will+    -- be annotated with @()@.+    -> ThriftParser p n a+    -> p a+runThriftParser getAnnot (ThriftParser p) =+    Reader.runReaderT (State.evalStateT p (ParserState Nothing)) getAnnot -instance TokenParsing ThriftParser where-    someSpace = skipSome $-        readDocstring <|> skipComments <|> skipSpace++instance (TokenParsing p, MonadPlus p) => TokenParsing (ThriftParser p n) where+    -- Docstring parsing works by cheating. We define docstrings as+    -- whitespace, but we record it when we move over it. If we run into+    -- another newline or other comments after seeing the docstring's "*/\n",+    -- we clear the docstring out because it's most likely not attached to the+    -- entity that follows. So for docstrings to be attached, there must be a+    -- single newline between "*/" and the entity.+    someSpace = skipSome $ readDocstring <|> skipComments <|> skipSpace       where         skipSpace = choice [             newline *> clearDocstring@@ -105,25 +180,39 @@               where                 ignore c = c == '*' || c == ' ' -idStyle :: IdentifierStyle ThriftParser-idStyle = (emptyIdents :: IdentifierStyle ThriftParser)++-- | Type of identifiers allowed by Thrift.+idStyle+    :: forall p n. (TokenParsing p, MonadPlus p)+    => IdentifierStyle (ThriftParser p n)+idStyle = (emptyIdents :: IdentifierStyle (ThriftParser p n))     { _styleStart = letter <|> char '_'     , _styleLetter = alphaNum <|> oneOf "_."     } -reserved :: Text -> ThriftParser ()++-- | Constructor for reserved keywords.+reserved :: (TokenParsing p, MonadPlus p) => Text -> ThriftParser p n () reserved = reserveText idStyle -program :: ThriftParser (T.Program Delta)++-- | Top-level parser to parse complete Thrift documents.+program :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Program n) program = whiteSpace >> T.Program <$> many header <*> many definition -literal :: ThriftParser Text++-- | A string literal. @"hello"@+literal :: (TokenParsing p, MonadPlus p) => ThriftParser p n Text literal = stringLiteral <|> stringLiteral' -identifier :: ThriftParser Text++-- | An identifier in a Thrift file.+identifier :: (TokenParsing p, MonadPlus p) => ThriftParser p n Text identifier = ident idStyle -header :: ThriftParser T.Header++-- | Headers defined for the IDL.+header :: (TokenParsing p, MonadPlus p) => ThriftParser p n T.Header header = choice [     reserved "include" >> T.Include <$> literal   , reserved "namespace" >>@@ -138,47 +227,93 @@   , reserved "csharp_namespace" >> T.Namespace "csharp" <$> identifier   ] -docstring :: ThriftParser (T.Docstring -> Delta -> a) -> ThriftParser a++-- | Convenience wrapper for parsers that expect a docstring and a location+-- 'Delta'.+--+-- > data Foo = Foo { bar :: Bar, doc :: Docstring, pos :: Delta }+-- >+-- > parseFoo = docstring $ Foo <$> parseBar+docstring :: Monad p => ThriftParser p n (T.Docstring -> n -> a) -> ThriftParser p n a docstring p = lastDocstring >>= \s -> do-    startPosition <- position-    p <*> pure s <*> pure startPosition+    annot <- ThriftParser . lift $ Reader.ask >>= lift+    p <*> pure s <*> pure annot -definition :: ThriftParser (T.Definition Delta)++-- | A constant, type, or service definition.+definition :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Definition n) definition = choice [constant, typeDefinition, service] -typeDefinition :: ThriftParser (T.Definition Delta)++-- | A type definition.+typeDefinition :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Definition n) typeDefinition =   T.TypeDefinition     <$> choice [typedef, enum, senum, struct, union, exception]     <*> typeAnnotations -typedef :: ThriftParser (T.Type Delta)++-- | A typedef is just an alias for another type.+--+-- > typedef common.Foo Bar+typedef :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Type n) typedef = reserved "typedef" >>     docstring (T.Typedef <$> fieldType <*> identifier) -enum :: ThriftParser (T.Type Delta)++-- | Enums are sets of named integer values.+--+-- > enum Role {+-- >     User = 1, Admin+-- > }+enum :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Type n) enum = reserved "enum" >>     docstring (T.Enum <$> identifier <*> braces (many enumDef)) -struct :: ThriftParser (T.Type Delta)++-- | A @struct@.+--+-- > struct User {+-- >     1: string name+-- >     2: Role role = Role.User;+-- > }+struct :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Type n) struct = reserved "struct" >>     docstring (T.Struct <$> identifier <*> braces (many field)) -union :: ThriftParser (T.Type Delta)++-- | A @union@ of types.+--+-- > union Value {+-- >     1: string stringValue;+-- >     2: i32 intValue;+-- > }+union :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Type n) union = reserved "union" >>     docstring (T.Union <$> identifier <*> braces (many field)) -exception :: ThriftParser (T.Type Delta)++-- | An @exception@ that can be raised by service methods.+--+-- > exception UserDoesNotExist {+-- >     1: optional string message+-- >     2: required string username+-- > }+exception :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Type n) exception = reserved "exception" >>      docstring (T.Exception <$> identifier <*> braces (many field)) -fieldRequiredness :: ThriftParser T.FieldRequiredness++-- | Whether a field is @required@ or @optional@.+fieldRequiredness+    :: (TokenParsing p, MonadPlus p) => ThriftParser p n T.FieldRequiredness fieldRequiredness = choice [     reserved "required" *> pure T.Required   , reserved "optional" *> pure T.Optional   ] -field :: ThriftParser (T.Field Delta)+-- | A struct field.+field :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Field n) field = docstring $   T.Field     <$> optional (integer <* symbolic ':')@@ -189,10 +324,9 @@     <*> typeAnnotations     <*  optionalSep -equals :: ThriftParser ()-equals = void $ symbolic '=' -enumDef :: ThriftParser (T.EnumDef Delta)+-- | A value defined inside an @enum@.+enumDef :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.EnumDef n) enumDef = docstring $   T.EnumDef     <$> identifier@@ -200,11 +334,18 @@     <*> typeAnnotations     <*  optionalSep -senum :: ThriftParser (T.Type Delta)++-- | An string-only enum. These are a deprecated feature of Thrift and+-- shouldn't be used.+senum :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Type n) senum = reserved "senum" >> docstring     (T.Senum <$> identifier <*> braces (many (literal <* optionalSep))) -constant :: ThriftParser (T.Definition Delta)++-- | A 'const' definition.+--+-- > const i32 code = 1;+constant :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Definition n) constant = do   reserved "const"   docstring $@@ -214,7 +355,9 @@         <*> constantValue         <*  optionalSep -constantValue :: ThriftParser T.ConstValue++-- | A constant value literal.+constantValue :: (TokenParsing p, MonadPlus p) => ThriftParser p n T.ConstValue constantValue = choice [     either T.ConstInt T.ConstFloat <$> integerOrDouble   , T.ConstLiteral <$> literal@@ -223,25 +366,35 @@   , T.ConstMap <$> constMap   ] -constList :: ThriftParser [T.ConstValue]++constList :: (TokenParsing p, MonadPlus p) => ThriftParser p n [T.ConstValue] constList = brackets $ commaSep (constantValue <* optionalSep) -constMap :: ThriftParser [(T.ConstValue, T.ConstValue)]++constMap+    :: (TokenParsing p, MonadPlus p)+    => ThriftParser p n [(T.ConstValue, T.ConstValue)] constMap = braces $ commaSep constantValuePair -constantValuePair :: ThriftParser (T.ConstValue, T.ConstValue)++constantValuePair+    :: (TokenParsing p, MonadPlus p)+    => ThriftParser p n (T.ConstValue, T.ConstValue) constantValuePair =     (,) <$> (constantValue <* colon)         <*> (constantValue <* optionalSep) -fieldType :: ThriftParser T.FieldType++-- | A reference to a built-in or defined field.+fieldType :: (TokenParsing p, MonadPlus p) => ThriftParser p n T.FieldType fieldType = choice [     baseType   , containerType   , T.DefinedType <$> identifier   ] -baseType :: ThriftParser T.FieldType++baseType :: (TokenParsing p, MonadPlus p) => ThriftParser p n T.FieldType baseType =     choice [reserved s *> (v <$> typeAnnotations) | (s, v) <- bases]   where@@ -257,7 +410,8 @@       , ("double", T.DoubleType)       ] -containerType :: ThriftParser T.FieldType++containerType :: (TokenParsing p, MonadPlus p) => ThriftParser p n T.FieldType containerType =     choice [mapType, setType, listType] <*> typeAnnotations   where@@ -266,7 +420,13 @@     setType = reserved "set" >> angles (T.SetType <$> fieldType)     listType = reserved "list" >> angles (T.ListType <$> fieldType) -service :: ThriftParser (T.Definition Delta)++-- | A service.+--+-- > service MyService {+-- >     // ...+-- > }+service :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Definition n) service = do   reserved "service"   docstring $@@ -276,7 +436,12 @@         <*> braces (many function)         <*> typeAnnotations -function :: ThriftParser (T.Function Delta)++-- | A function defined inside a service.+--+-- > Foo getFoo() throws (1: FooDoesNotExist doesNotExist);+-- > oneway void putBar(1: Bar bar);+function :: (TokenParsing p, MonadPlus p) => ThriftParser p n (T.Function n) function = docstring $     T.Function         <$> ((reserved "oneway" *> pure True) <|> pure False)@@ -287,14 +452,32 @@         <*> typeAnnotations         <*  optionalSep -typeAnnotations :: ThriftParser [T.TypeAnnotation]++-- | 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+    :: (TokenParsing p, MonadPlus p)+    => ThriftParser p n [T.TypeAnnotation] typeAnnotations = parens (many typeAnnotation) <|> pure [] -typeAnnotation :: ThriftParser T.TypeAnnotation++typeAnnotation+    :: (TokenParsing p, MonadPlus p)+    => ThriftParser p n T.TypeAnnotation typeAnnotation =     T.TypeAnnotation         <$> identifier         <*> (equals *> literal <* optionalSep) -optionalSep :: ThriftParser ()++optionalSep :: (TokenParsing p, MonadPlus p) => ThriftParser p n () optionalSep = void $ optional (comma <|> semi)+++equals :: (TokenParsing p, MonadPlus p) => ThriftParser p n ()+equals = void $ symbolic '='+

@@ -0,0 +1,23 @@+-- |+-- Module      :  Language.Thrift.Parser.Trifecta+-- Copyright   :  (c) Abhinav Gupta 2015+-- License     :  BSD3+--+-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>+-- Stability   :  experimental+--+-- Provides a parser for Thrift IDLs based on Trifecta.+--+module Language.Thrift.Parser.Trifecta (thriftIDL) where++import Text.Trifecta+import Text.Trifecta.Delta (Delta)++import qualified Language.Thrift.Parser as P+import qualified Language.Thrift.Types  as T++-- | Parser for Thrift IDLs based on Trifecta.+--+-- Use with 'parseFromFile', 'parseByteString' or friends.+thriftIDL :: Parser (T.Program Delta)+thriftIDL = P.thriftIDL position

@@ -1,5 +1,15 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric      #-}+-- |+-- Module      :  Language.Thrift.Types+-- Copyright   :  (c) Abhinav Gupta 2015+-- License     :  BSD3+--+-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>+-- Stability   :  experimental+--+-- This module defines types that compose a Thrift IDL file.+-- module Language.Thrift.Types     ( Program(..)     , Header(..)@@ -19,147 +29,304 @@ import Data.Text    (Text) import GHC.Generics (Generic) +-- | A program represents a single Thrift document. data Program srcAnnot = Program     { programHeaders     :: [Header]+    -- ^ Headers in a document define includes and namespaces.     , programDefinitions :: [Definition srcAnnot]+    -- ^ Types and services defined in the document.     }     deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | Headers for a program. data Header-    = Include    { includePath :: Text }-    | Namespace  { namespaceLanguage, namespaceName :: Text }+    = -- | The IDL includes another Thrift file.+      --+      -- > include "common.thrift"+      -- >+      -- > typedef common.Foo Bar+      --+      Include+        { includePath :: Text+        -- ^ Path to the included file.+        }+    | -- | Namespace directives allows control of the namespace or package+      -- name used by the generated code for certain languages.+      --+      -- > namespace py my_service.generated+      Namespace+        { namespaceLanguage :: Text+        -- ^ The language for which the namespace is being specified. This may+        -- be @*@ to refer to all languages.+        , namespaceName     :: Text+        -- ^ Namespace or package path to use in the generated code for that+        -- language.+        }   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | A definition either consists of new constants, new types, or new+-- services. data Definition srcAnnot-    = ConstDefinition+    = -- | A declared constant.+      --+      -- > const i32 code = 1;+      ConstDefinition         { constType      :: FieldType+        -- ^ Type of the constant.         , constName      :: Text+        -- ^ Name of the constant.         , constValue     :: ConstValue+        -- ^ Value of the constant.         , constDocstring :: Docstring+        -- ^ Documentation.         , constSrcAnnot  :: srcAnnot         }-    | TypeDefinition+    | -- | A declared type.+      TypeDefinition         { typeDefinition  :: Type srcAnnot+        -- ^ Details of the type definition.         , typeAnnotations :: [TypeAnnotation]+        -- ^ Annotations added to the type.         }-    | ServiceDefinition+    | -- | A service definition.+      --+      -- > service MyService {+      -- >     // ...+      -- > }+      ServiceDefinition         { serviceName        :: Text+        -- ^ Name of the service.         , serviceExtends     :: Maybe Text+        -- ^ Name of the service this service extends.         , serviceFunctions   :: [Function srcAnnot]+        -- ^ All the functions defined for the service.         , serviceAnnotations :: [TypeAnnotation]+        -- ^ Annotations added to the service.         , serviceDocstring   :: Docstring+        -- ^ Documentation.         , serviceSrcAnnot    :: srcAnnot         }   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | Defines the various types that can be declared in Thrift. data Type srcAnnot-    = Typedef+    = -- | A typedef is just an alias for another type.+      --+      -- > typedef common.Foo Bar+      Typedef         { typedefType      :: FieldType+        -- ^ The aliased type.         , typedefName      :: Text+        -- ^ Name of the new type.         , typedefDocstring :: Docstring+        -- ^ Documentation.         , typedefSrcAnnot  :: srcAnnot         }-    | Enum+    | -- | Enums are sets of named integer values.+      --+      -- > enum Role {+      -- >     User = 1, Admin = 2+      -- > }+      Enum         { enumName      :: Text+        -- ^ Name of the enum type.         , enumValues    :: [EnumDef srcAnnot]+        -- ^ Values defined in the enum.         , enumDocstring :: Docstring+        -- ^ Documentation.         , enumSrcAnnot  :: srcAnnot         }-    | Struct+    | -- | A struct definition+      --+      -- > struct User {+      -- >     1: Role role = Role.User;+      -- > }+      Struct         { structName      :: Text+        -- ^ Name of the struct.         , structFields    :: [Field srcAnnot]+        -- ^ Fields defined in the struct.         , structDocstring :: Docstring+        -- ^ Documentation.         , structSrcAnnot  :: srcAnnot         }-    | Union+    | -- | A union of other types.+      --+      -- > union Value {+      -- >     1: string stringValue;+      -- >     2: i32 intValue;+      -- > }+      Union         { unionName      :: Text+        -- ^ Name of the union.         , unionFields    :: [Field srcAnnot]+        -- ^ Fields defined in the union.         , unionDocstring :: Docstring+        -- ^ Documentation.         , unionSrcAnnot  :: srcAnnot         }-    | Exception+    | -- | Exception types.+      --+      -- > exception UserDoesNotExist {+      -- >     1: optional string message+      -- >     2: required string username+      -- > }+      Exception         { exceptionName      :: Text         , exceptionFields    :: [Field srcAnnot]         , exceptionDocstring :: Docstring         , exceptionSrcAnnot  :: srcAnnot         }-    | Senum+    | -- | An string-only enum. These are a deprecated feature of Thrift and+      -- shouldn't be used.+      Senum         { senumName      :: Text         , senumValues    :: [Text]         , senumDocstring :: Docstring+        -- ^ Documentation.         , senumSrcAnnot  :: srcAnnot         }   deriving (Show, Ord, Eq, Data, Typeable, Generic) -data FieldRequiredness = Required | Optional+-- | Whether a field is required or optional.+data FieldRequiredness+    = Required -- ^ The field is @required@.+    | Optional -- ^ The field is @optional@.   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | A field inside a struct, exception, or function parameters list. data Field srcAnnot = Field     { fieldIdentifier   :: Maybe Integer+    -- ^ Position of the field.+    --+    -- While this is optional, it is recommended that Thrift files always+    -- contain specific field IDs.     , fieldRequiredNess :: Maybe FieldRequiredness+    -- ^ Whether this field is required or not.+    --+    -- Behavior may differ between languages if requiredness is not specified.+    -- Therefore it's recommended that requiredness for a field is always+    -- specified.     , fieldType         :: FieldType+    -- ^ Type of value the field holds.     , fieldName         :: Text+    -- ^ Name of the field.     , fieldDefault      :: Maybe ConstValue+    -- ^ Default value of the field, if any.     , fieldAnnotations  :: [TypeAnnotation]+    -- ^ Field annotations.     , fieldDocstring    :: Docstring+    -- ^ Documentation.     , fieldSrcAnnot     :: srcAnnot     }   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | A named value inside an enum. data EnumDef srcAnnot = EnumDef     { enumDefName        :: Text+    -- ^ Name of the value.     , enumDefValue       :: Maybe Integer+    -- ^ Value attached to the enum for that name.     , enumDefAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to this enum field.     , enumDefDocstring   :: Docstring+    -- ^ Documentation     , enumDefSrcAnnot    :: srcAnnot     }   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | A constant literal value in the IDL. Only a few basic types, lists, and+-- maps can be presented in Thrift files as literals.+--+-- Constants are used for IDL-level constants and default values for fields. data ConstValue     = ConstInt Integer+    -- ^ An integer. @42@     | ConstFloat Double+    -- ^ A float. @4.2@     | ConstLiteral Text+    -- ^ A literal string. @"hello"@     | ConstIdentifier Text+    -- ^ A literal identifier. @hello@     | ConstList [ConstValue]+    -- ^ A literal list containing other constant values. @[42]@     | ConstMap [(ConstValue, ConstValue)]+    -- ^ A literal list containing other constant values.+    -- @{"hellO": 1, "world": 2}@   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | A reference to a type. data FieldType     = DefinedType Text+    -- ^ A custom defined type referred to by name. -    -- Base types     | StringType [TypeAnnotation]+    -- ^ @string@ and annotations.     | BinaryType [TypeAnnotation]+    -- ^ @binary@ and annotations.     | SListType [TypeAnnotation]+    -- ^ @slist@ and annotations.     | BoolType [TypeAnnotation]+    -- ^ @bool@ and annotations.     | ByteType [TypeAnnotation]+    -- ^ @byte@ and annotations.     | I16Type [TypeAnnotation]+    -- ^ @i16@ and annotations.     | I32Type [TypeAnnotation]+    -- ^ @i32@ and annotations.     | I64Type [TypeAnnotation]+    -- ^ @i64@ and annotations.     | DoubleType [TypeAnnotation]+    -- ^ @double@ and annotations.      -- Container types     | MapType FieldType FieldType [TypeAnnotation]+    -- ^ @map\<foo, bar\>@ and annotations.     | SetType FieldType [TypeAnnotation]+    -- ^ @set\<baz\>@ and annotations.     | ListType FieldType [TypeAnnotation]+    -- ^ @list\<qux\>@ and annotations.   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | A function defined inside a service. data Function srcAnnot = Function     { functionOneWay      :: Bool+    -- ^ Whether the function is @oneway@. If it's one way, it cannot receive+    -- repsonses.     , functionReturnType  :: Maybe FieldType+    -- ^ Return type of the function, or @Nothing@ if it's @void@ or @oneway@.     , functionName        :: Text+    -- ^ Name of the function.     , functionParameters  :: [Field srcAnnot]+    -- ^ Parameters accepted by the function.     , functionExceptions  :: Maybe [Field srcAnnot]+    -- ^ Exceptions raised by the function, if any.     , functionAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to the function.     , functionDocstring   :: Docstring+    -- ^ Documentation.     , functionSrcAnnot    :: srcAnnot     }   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | Type annoations may be added in various places in the form,+--+-- > ("foo" = "bar", "baz" = "qux")+--+-- These do not usually affect code generation but allow for custom logic if+-- writing your own code generator. data TypeAnnotation = TypeAnnotation     { typeAnnotationName  :: Text+    -- ^ Name of the annotation.     , typeAnnotationValue :: Text+    -- ^ Value for the annotation.     }   deriving (Show, Ord, Eq, Data, Typeable, Generic) +-- | Docstrings are Javadoc-style comments attached various defined objects.+--+-- > /**+-- >  * Fetches an item.+-- >  */+-- > Item getItem() type Docstring = Maybe Text

@@ -1,13 +1,15 @@-`language-thrift` provides a parser for the [Thrift IDL format][]. The parser-is written using [`trifecta`][] to provide helpful error messages when parsing-fails. The parser keeps track of Javadoc-style comments (`/** ... */`) and-associates them with the type, service, function, or field above which they-were added.+`language-thrift` provides a parser for the [Thrift IDL format]. In addition to+parsing the IDL, it keeps track of Javadoc-style comments (`/** ... */`) and+attaches them to the type, service, function, or field, above which they were+added. -Documentation is sparse; most of the types are self-explanatory.-Haddock-generated docs are available on [Hackage][] and [here][].+The parser uses [`parsers`] to allow plugging in the underlying parser. A+default [`trifecta`] based parser is provided. +Haddock-generated docs are available on [Hackage] and [here].+   [Thrift IDL format]: http://thrift.apache.org/docs/idl+  [`parsers`]: http://hackage.haskell.org/package/parsers   [`trifecta`]: http://hackage.haskell.org/package/trifecta   [Hackage]: http://hackage.haskell.org/package/language-thrift   [here]: http://abhinavg.net/language-thrift/

@@ -0,0 +1,235 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++-- This is a fairly simple code generator that uses language-thrift to parse+-- IDL files and produces pretty printed Haskell code for all the types.+--+-- For services, it just generates a simple GADT that defines the inputs and+-- outputs for that service. Service inheritanec is not supported and+-- service method exceptions are ignored.++import Prelude hiding ((<$>))++import Data.Char   (toLower, toUpper)+import Data.Maybe  (isNothing)+import Data.Text   (Text, unpack)+import System.Exit (exitFailure)+import System.IO   (stderr, stdout)++import qualified Data.Text                    as Text+import qualified Text.PrettyPrint.ANSI.Leijen as AnsiPP+import           Text.PrettyPrint.Leijen      hiding (list, tupled)+import           Text.Trifecta                (Result (..), parseString)+import           Text.Trifecta.Delta          (Delta (Directed))++import Language.Thrift.Parser.Trifecta (thriftIDL)+import Language.Thrift.Types++die :: String -> IO a+die s = putStrLn s >> exitFailure++-- | '<$>' with the arguments flipped.+(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) = flip fmap+infixl 1 <&>++($$) :: Docstring -> Doc -> Doc+($$) Nothing y = y+($$) (Just t) y = case Text.lines t of+    [] -> y+    l:ls -> let docstring = align . vsep+                    $ (text "-- |" <+> text (unpack l))+                    : map ((text "--" <+>) . text . unpack) ls+          in align (docstring <$> y)+infixr 1 $$++list :: [Doc] -> Doc+list = encloseSep lbracket rbracket (text ", ")++tupled :: [Doc] -> Doc+tupled = encloseSep lparen rparen (text ", ")++renderConstValue :: ConstValue -> Doc+renderConstValue (ConstInt i) = integer i+renderConstValue (ConstFloat f) = double f+renderConstValue (ConstLiteral l) = dquotes $ text (unpack l) -- TODO escaping+renderConstValue (ConstIdentifier i) = text (unpack i)+renderConstValue (ConstList l) = list (map renderConstValue l)+renderConstValue (ConstMap m) = text "Map.fromList" <+> list (map renderConstTuple m)+  where+    renderConstTuple (a, b) = tupled [+        renderConstValue a+      , renderConstValue b+      ]++renderFieldType :: FieldType -> Doc+renderFieldType (DefinedType t) = text (unpack t)+renderFieldType (StringType _) = text "Text"+renderFieldType (BinaryType _) = text "ByteString"+renderFieldType (BoolType _) = text "Bool"+renderFieldType (ByteType _) = text "Word8"+renderFieldType (I16Type _) = text "Word16"+renderFieldType (I32Type _) = text "Word32"+renderFieldType (I64Type _) = text "Word64"+renderFieldType (DoubleType _) = text "Double"+renderFieldType (MapType k v _) =+    parens $ hsep [text "Map", renderFieldType k, renderFieldType v]+renderFieldType (SetType i _) = parens $ text "Set" <+> renderFieldType i+renderFieldType (ListType i _) = brackets $ renderFieldType i+renderFieldType t = error $ "Unsupported field type: " ++ show t++renderStructField :: Show a => Text -> Field a -> Doc+renderStructField structName (Field _ req ftype fname def _ docstring _) = hang 4 $+    docstring $$+    fieldName </>+    hsep [+        text "::"+      , (if isOptional+            then text "Maybe" <> space+            else empty) <> renderFieldType ftype+      ]+  where+    isOptional+      | isNothing req = False+      | otherwise     = r == Optional && isNothing def+      where (Just r)  = req+    fieldName = text . unpack $ Text.concat [+        structName+      , underscoresToCamelCase False fname+      ]++renderType :: Show a => Type a -> Doc+renderType = go+  where+    derivingClause =+        text "deriving" <+> tupled (map text ["Show", "Ord", "Eq"])++    go (Typedef fieldType name docstring _) = docstring $$+        hsep [text "type", typeName name, equals, renderFieldType fieldType]+    go (Enum name defs docstring _) = docstring $$+        text "data" <+> typeName name <>+        encloseSep (text " = ") empty (text " | ") (map renderDef defs)+        <$$> indent 4 derivingClause+      where+        renderDef (EnumDef e _ _ docstring _) = docstring $$ typeName e+    go (Exception name fields docstring a) = go (Struct name fields docstring a)+    go (Struct name fields docstring _) = docstring $$+        text "data" <+> typeName name </> equals <+> typeName name <$$>+        (if null fields+            then empty+            else indent 2 renderFields)+        </> derivingClause+      -- TODO prefix should be configurable using annotations+      where+        renderFields =+            encloseSep (text "{ ") (line <> text "}") (text ", ") $+            map (renderStructField structName) fields+        structName = underscoresToCamelCase True name+    go (Union name fields docstring _) =+        hang 4+          (docstring $$+              text "data" <+> typeName name <$>+              encloseSep (text "= ") empty (text " | ")+                         (map renderField fields))+        <$$> indent 4 derivingClause+      where+        structName = underscoresToCamelCase False name+        renderField (Field _ _ ftype fname _ _ docstring _) =+            docstring $$ fieldName </> renderFieldType ftype+          where+            fieldName = text . unpack $ Text.concat [+                structName+              , underscoresToCamelCase False fname+              ]+    go t = error $ "Unsupported type: " ++ show t++typeName :: Text -> Doc+typeName = mkName False++generateOutput :: Show a => Program a -> IO ()+generateOutput (Program _ definitions) = do+    let doc = headers <$> empty <$>+              vcat (map ((<$> empty) . genDef) definitions)+    displayIO stdout $ renderPretty 0.8 80 doc+  where+    import_ m items = sep [+        text "import"+      , text m+      , maybe empty (tupled . map string) items+      ]++    importQualified m s = sep [+        text "import qualified"+      , text m+      , text "as"+      , text s+      ]++    headers = vcat [+        import_ "Data.Map" (Just ["Map"])+      , import_ "Data.Set" (Just ["Set"])+      , import_ "Data.Text" (Just ["Text"])+      , import_ "Data.ByteString" (Just ["ByteString"])+      , import_ "Data.Word" (Just ["Word8", "Word16", "Word32", "Word64"])+      , text ""+      , importQualified "Data.Map" "Map"+      ]++    genDef :: Show a => Definition a -> Doc+    genDef (ConstDefinition fieldType name value docstring _) = docstring $$+        sep [fieldName name, text "::", renderFieldType fieldType] <$>+        sep [fieldName name, text "=", renderConstValue value]+    genDef (TypeDefinition typeDef _) = renderType typeDef+    genDef (ServiceDefinition sname Nothing funcs _ docstring _) = docstring $$+        text "data" <+> typeName sname <+> text "a where" <$$>+            indent 2 (vcat (map renderFunc funcs))+      where+        renderFunc (Function False rtype name params _ _ docstring _) =+          docstring $$+            typeName name <+> text "::" <>+            (if null params+              then space+              else linebreak <> renderParams name params) <>+            typeName sname <+> returnType+            <> linebreak+          where+            returnType = case rtype of+                Nothing -> text "()"+                Just t  -> renderFieldType t++        renderParams fname params = indent 2 $+            encloseSep (text "{ ") (line <> text "} -> ") (text ", ") $+                map (renderStructField structName) params+          where+            structName = underscoresToCamelCase True fname++    fieldName = mkName True++mkName :: Bool -> Text -> Doc+mkName lowerFirst = text . unpack . underscoresToCamelCase lowerFirst++underscoresToCamelCase :: Bool -> Text -> Text+underscoresToCamelCase lowerFirst =+    camelCase lowerFirst . Text.split (== '_')++camelCase :: Bool -> [Text] -> Text+camelCase lowerFirst =+    maybeLower . Text.concat . map (transformIndex toUpper 0)+  where+    maybeLower = if lowerFirst then transformIndex toLower 0 else id++transformIndex :: (Char -> Char) -> Int -> Text -> Text+transformIndex f i s = Text.concat [+    Text.take i s+  , Text.singleton $ f (s `Text.index` i)+  , Text.drop (i + 1) s+  ]++main :: IO ()+main = do+    result <- getContents <&> parseString thriftIDL (Directed "stdin" 0 0 0 0)+    case result of+        Success p -> generateOutput p+        Failure doc -> do+            AnsiPP.displayIO stderr $ AnsiPP.renderPretty 0.8 80 doc+            die "Parse Failed"

@@ -1,5 +1,5 @@ name          : language-thrift-version       : 0.2.0.0+version       : 0.3.0.0 synopsis      : Parser for the Thrift IDL format. homepage      : https://github.com/abhinav/language-thrift license       : BSD3@@ -15,10 +15,11 @@ extra-source-files:     README.md     CHANGES.md---  examples/*.hs   TODO: Add examples+    examples/*.hs  library   exposed-modules  : Language.Thrift.Parser+                   , Language.Thrift.Parser.Trifecta                    , Language.Thrift.Types   build-depends    : base     >= 4.7  && < 4.9                    , mtl