language-thrift 0.8.0.2 → 0.9.0.0

raw patch · 16 files changed

+1053/−1100 lines, 16 filesdep +scientificdep −containersdep ~basedep ~megaparsecPVP ok

version bump matches the API change (PVP)

Dependencies added: scientific

Dependencies removed: containers

Dependency ranges changed: base, megaparsec

API changes (from Hackage documentation)

Files

• CHANGES.md +3/−7
• examples/generateHaskellTypes.hs +1/−1
• language-thrift.cabal +19/−26
• src/Language/Thrift/AST.hs +27/−0
• src/Language/Thrift/Internal/AST.hs +781/−0
• src/Language/Thrift/Internal/Lens.hs +23/−0
• src/Language/Thrift/Internal/Reserved.hs +0/−59
• src/Language/Thrift/Internal/Types.hs +0/−793
• src/Language/Thrift/Parser.hs +105/−81
• src/Language/Thrift/Pretty.hs +2/−2
• src/Language/Thrift/Types.hs +4/−16
• test/Language/Thrift/ASTSpec.hs +69/−0
• test/Language/Thrift/Arbitrary.hs +17/−37
• test/Language/Thrift/ParserSpec.hs +1/−8
• test/Language/Thrift/TypesSpec.hs +0/−69
• test/TestUtils.hs +1/−1

@@ -1,12 +1,8 @@-0.8.0.2 (2016-08-31)-====================---   Disallow reserved keywords from being used as identifier names.--0.8.0.1 (2016-05-24)+0.9.0.0 (2016-05-15) ==================== --   Build with GHC 8.+- Deprecate the `Language.Thrift.Types` in favor of `Language.Thrift.AST`.+- Upgrade to `megaparsec` 5.0.  0.8.0.0 (2016-02-09) ====================

@@ -26,7 +26,7 @@  import Language.Thrift.Parser (parse) -import qualified Language.Thrift.Types as T+import qualified Language.Thrift.AST as T  die :: String -> IO a die s = hPutStrLn stderr s >> exitFailure

@@ -1,16 +1,16 @@--- This file has been generated from package.yaml by hpack version 0.14.1.+-- This file has been generated from package.yaml by hpack version 0.13.0. -- -- see: https://github.com/sol/hpack  name:           language-thrift-version:        0.8.0.2+version:        0.9.0.0+bug-reports:    https://github.com/abhinav/language-thrift/issues cabal-version:  >= 1.10 build-type:     Simple license:        BSD3 license-file:   LICENSE maintainer:     Abhinav Gupta <mail@abhinavg.net> homepage:       https://github.com/abhinav/language-thrift#readme-bug-reports:    https://github.com/abhinav/language-thrift/issues synopsis:       Parser and pretty printer for the Thrift IDL format. description:    This package provides a parser and pretty printer for the                 <http://thrift.apache.org/docs/idl Thrift IDL format>.@@ -33,50 +33,43 @@     hs-source-dirs:         src     ghc-options: -Wall+    build-depends:+        base >= 4.7 && < 4.9,+        ansi-wl-pprint >= 0.6 && < 0.7,+        megaparsec >= 5.0 && < 6.0,+        text >= 1.2,+        scientific >= 0.3 && < 0.4,+        transformers     exposed-modules:+        Language.Thrift.AST         Language.Thrift.Parser         Language.Thrift.Pretty         Language.Thrift.Types     other-modules:-        Language.Thrift.Internal.Reserved-        Language.Thrift.Internal.Types+        Language.Thrift.Internal.AST+        Language.Thrift.Internal.Lens         Paths_language_thrift     default-language: Haskell2010-    build-depends:-        base >= 4.7 && < 5,-        ansi-wl-pprint >= 0.6 && < 0.7,-        containers >= 0.5 && < 0.6,-        megaparsec >= 4.0 && < 5.0,-        text >= 1.2,-        transformers  test-suite spec     type: exitcode-stdio-1.0     main-is: Main.hs+    hs-source-dirs:+        test+    ghc-options: -Wall     build-depends:-        base >= 4.7 && < 5,+        base >= 4.7 && < 4.9,         ansi-wl-pprint >= 0.6 && < 0.7,-        containers >= 0.5 && < 0.6,-        megaparsec >= 4.0 && < 5.0,+        megaparsec >= 5.0 && < 6.0,         text >= 1.2,-        transformers,         hspec >= 2.0,         hspec-discover >= 2.1,         language-thrift,         QuickCheck >= 2.5     other-modules:-        Language.Thrift.Internal.Reserved-        Language.Thrift.Internal.Types-        Language.Thrift.Parser-        Language.Thrift.Pretty-        Language.Thrift.Types         Language.Thrift.Arbitrary+        Language.Thrift.ASTSpec         Language.Thrift.ParserSpec-        Language.Thrift.TypesSpec         Spec         TestUtils     default-language: Haskell2010-    hs-source-dirs:-        src,-        test-    ghc-options: -Wall

@@ -0,0 +1,27 @@+-- |+-- Module      :  Language.Thrift.AST+-- Copyright   :  (c) Abhinav Gupta 2016+-- License     :  BSD3+--+-- Maintainer  :  Abhinav Gupta <mail@abhinavg.net>+-- Stability   :  experimental+--+-- This module defines types that compose a Thrift IDL file.+--+-- Most of the types have an optional @srcAnnot@ parameter that represents a+-- source annotation. The parser produces types annotated with their position+-- in the Thrift file ('Text.Megaparsec.SourcePos'). When constructing the AST+-- by hand, you can use @()@. The types are @Functor@s so you can use 'fmap'+-- to change the annotation on all objects in a tree.+--+-- Lenses for attributes of most types are provided for use with the `lens`+-- library.+--+-- Types representing the AST all have 'Text.PrettyPrint.ANSI.Leijen.Pretty'+-- instances to go with them.+module Language.Thrift.AST+    ( module Language.Thrift.Internal.AST+    ) where++import Language.Thrift.Internal.AST+import Language.Thrift.Pretty       ()

@@ -0,0 +1,781 @@+{-# LANGUAGE DeriveDataTypeable     #-}+{-# LANGUAGE DeriveFunctor          #-}+{-# LANGUAGE DeriveGeneric          #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses  #-}+{-# LANGUAGE RankNTypes             #-}+module Language.Thrift.Internal.AST+    (+    -- * AST++      Program(..)+    , headers+    , definitions++    , Header(..)++    , Include(..)+    , path++    , Namespace(..)+    , language++    , Definition(..)++    , Const(..)+    , Service(..)+    , functions+    , extends++    , Type(..)++    , Typedef(..)+    , targetType++    , Enum(..)+    , Struct(..)+    , Union(..)+    , Exception(..)+    , Senum(..)++    , FieldRequiredness(..)++    , Field(..)+    , identifier+    , requiredness+    , defaultValue++    , EnumDef(..)++    , ConstValue(..)++    , TypeReference(..)++    , Function(..)+    , oneWay+    , returnType+    , parameters+    , exceptions++    , TypeAnnotation(..)+    , Docstring++    -- * Typeclasses++    , HasAnnotations(..)+    , HasDocstring(..)+    , HasFields(..)+    , HasName(..)+    , HasSrcAnnot(..)+    , HasValue(..)+    , HasValues(..)+    , HasValueType(..)+    ) where++import Data.Data             (Data, Typeable)+import Data.Text             (Text)+import GHC.Generics          (Generic)+import Prelude               hiding (Enum)++import Language.Thrift.Internal.Lens++class HasSrcAnnot t where+    srcAnnot :: Lens (t a) a++class HasName t where+    name :: Lens t Text++class HasValue s a | s -> a where+    value :: Lens s a++-- | Type annoations may be added in various places in the form,+--+-- > (foo = "bar", baz, qux = "quux")+--+-- 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 :: Maybe Text+    -- ^ Value for the annotation.+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic)++instance HasName TypeAnnotation where+    name = lens typeAnnotationName (\s a -> s { typeAnnotationName = a })++instance HasValue TypeAnnotation (Maybe Text) where+    value = lens typeAnnotationValue (\s a -> s { typeAnnotationValue = a })++class HasAnnotations t where+    annotations :: Lens t [TypeAnnotation]++-- | Docstrings are Javadoc-style comments attached various defined objects.+--+-- > /**+-- >  * Fetches an item.+-- >  */+-- > Item getItem()+type Docstring = Maybe Text++class HasDocstring t where+    docstring :: Lens t Docstring++-- | 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 srcAnnot+    = ConstInt Integer srcAnnot+    -- ^ An integer. @42@+    | ConstFloat Double srcAnnot+    -- ^ A float. @4.2@+    | ConstLiteral Text srcAnnot+    -- ^ A literal string. @"hello"@+    | ConstIdentifier Text srcAnnot+    -- ^ A reference to another constant. @Foo.bar@+    | ConstList [ConstValue srcAnnot] srcAnnot+    -- ^ A literal list containing other constant values. @[42]@+    | ConstMap [(ConstValue srcAnnot, ConstValue srcAnnot)] srcAnnot+    -- ^ A literal list containing other constant values.+    -- @{"hellO": 1, "world": 2}@+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasSrcAnnot ConstValue where+    srcAnnot = lens getter setter+      where+        getter (ConstInt        _ a) = a+        getter (ConstFloat      _ a) = a+        getter (ConstLiteral    _ a) = a+        getter (ConstIdentifier _ a) = a+        getter (ConstList       _ a) = a+        getter (ConstMap        _ a) = a++        setter (ConstInt        x _) a = ConstInt        x a+        setter (ConstFloat      x _) a = ConstFloat      x a+        setter (ConstLiteral    x _) a = ConstLiteral    x a+        setter (ConstIdentifier x _) a = ConstIdentifier x a+        setter (ConstList       x _) a = ConstList       x a+        setter (ConstMap        x _) a = ConstMap        x a++-- | A reference to a type.+data TypeReference srcAnnot+    = DefinedType Text srcAnnot+    -- ^ A custom defined type referred to by name.++    | StringType [TypeAnnotation] srcAnnot+    -- ^ @string@ and annotations.+    | BinaryType [TypeAnnotation] srcAnnot+    -- ^ @binary@ and annotations.+    | SListType [TypeAnnotation] srcAnnot+    -- ^ @slist@ and annotations.+    | BoolType [TypeAnnotation] srcAnnot+    -- ^ @bool@ and annotations.+    | ByteType [TypeAnnotation] srcAnnot+    -- ^ @byte@ and annotations.+    | I16Type [TypeAnnotation] srcAnnot+    -- ^ @i16@ and annotations.+    | I32Type [TypeAnnotation] srcAnnot+    -- ^ @i32@ and annotations.+    | I64Type [TypeAnnotation] srcAnnot+    -- ^ @i64@ and annotations.+    | DoubleType [TypeAnnotation] srcAnnot+    -- ^ @double@ and annotations.++    -- Container types+    | MapType+        (TypeReference srcAnnot)+        (TypeReference srcAnnot)+        [TypeAnnotation]+        srcAnnot+    -- ^ @map\<foo, bar\>@ and annotations.+    | SetType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot+    -- ^ @set\<baz\>@ and annotations.+    | ListType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot+    -- ^ @list\<qux\>@ and annotations.+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasSrcAnnot TypeReference where+    srcAnnot = lens getter setter+      where+        getter (DefinedType _ a) = a+        getter (StringType  _ a) = a+        getter (BinaryType  _ a) = a+        getter (SListType   _ a) = a+        getter (BoolType    _ a) = a+        getter (ByteType    _ a) = a+        getter (I16Type     _ a) = a+        getter (I32Type     _ a) = a+        getter (I64Type     _ a) = a+        getter (DoubleType  _ a) = a+        getter (MapType _ _ _ a) = a+        getter (SetType   _ _ a) = a+        getter (ListType  _ _ a) = a++        setter (DefinedType x _) a = DefinedType x a+        setter (StringType  x _) a = StringType  x a+        setter (BinaryType  x _) a = BinaryType  x a+        setter (SListType   x _) a = SListType   x a+        setter (BoolType    x _) a = BoolType    x a+        setter (ByteType    x _) a = ByteType    x a+        setter (I16Type     x _) a = I16Type     x a+        setter (I32Type     x _) a = I32Type     x a+        setter (I64Type     x _) a = I64Type     x a+        setter (DoubleType  x _) a = DoubleType  x a+        setter (MapType k v x _) a = MapType k v x a+        setter (SetType   t x _) a = SetType   t x a+        setter (ListType  t x _) a = ListType  t x a++class HasValueType t where+    valueType :: Lens (t a) (TypeReference a)++-- | 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.+    , fieldValueType    :: TypeReference srcAnnot+    -- ^ Type of value the field holds.+    , fieldName         :: Text+    -- ^ Name of the field.+    , fieldDefaultValue :: Maybe (ConstValue srcAnnot)+    -- ^ Default value of the field, if any.+    , fieldAnnotations  :: [TypeAnnotation]+    -- ^ Field annotations.+    , fieldDocstring    :: Docstring+    -- ^ Documentation.+    , fieldSrcAnnot     :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++identifier :: Lens (Field a) (Maybe Integer)+identifier = lens fieldIdentifier (\s a -> s { fieldIdentifier = a })++requiredness :: Lens (Field a) (Maybe FieldRequiredness)+requiredness = lens fieldRequiredness (\s a -> s { fieldRequiredness = a })++defaultValue :: Lens (Field a) (Maybe (ConstValue a))+defaultValue = lens fieldDefaultValue (\s a -> s { fieldDefaultValue = a })++instance HasName (Field a) where+    name = lens fieldName (\s a -> s { fieldName = a })++instance HasValueType Field where+    valueType = lens fieldValueType (\s a -> s { fieldValueType = a })++instance HasSrcAnnot Field where+    srcAnnot = lens fieldSrcAnnot (\s a -> s { fieldSrcAnnot = a })++instance HasDocstring (Field a) where+    docstring = lens fieldDocstring (\s a -> s { fieldDocstring = a })++instance HasAnnotations (Field a) where+    annotations = lens fieldAnnotations (\s a -> s { fieldAnnotations = a })++class HasFields t where+    fields :: Lens (t a) [Field a]++-- | 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 (TypeReference srcAnnot)+    -- ^ 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, Functor)++oneWay :: Lens (Function a) Bool+oneWay = lens functionOneWay (\s a -> s { functionOneWay = a })++returnType :: Lens (Function a) (Maybe (TypeReference a))+returnType = lens functionReturnType (\s a -> s { functionReturnType = a })++parameters :: Lens (Function a) [Field a]+parameters = lens functionParameters (\s a -> s { functionParameters = a })++exceptions :: Lens (Function a) (Maybe [Field a])+exceptions = lens functionExceptions (\s a -> s { functionExceptions = a })++instance HasName (Function a) where+    name = lens functionName (\s a -> s { functionName = a })++instance HasSrcAnnot Function where+    srcAnnot = lens functionSrcAnnot (\s a -> s { functionSrcAnnot = a })++instance HasDocstring (Function a) where+    docstring = lens functionDocstring (\s a -> s { functionDocstring = a })++instance HasAnnotations (Function a) where+    annotations = lens functionAnnotations (\s a -> s { functionAnnotations = a })++-- | A service definition.+--+-- > service MyService {+-- >     // ...+-- > }+data Service srcAnnot = Service+    { 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, Functor)++functions :: Lens (Service a) [Function a]+functions = lens serviceFunctions (\s a -> s { serviceFunctions = a })++extends :: Lens (Service a) (Maybe Text)+extends = lens serviceExtends (\s a -> s { serviceExtends = a })++instance HasName (Service a) where+    name = lens serviceName (\s a -> s { serviceName = a })++instance HasSrcAnnot Service where+    srcAnnot = lens serviceSrcAnnot (\s a -> s { serviceSrcAnnot = a })++instance HasDocstring (Service a) where+    docstring = lens serviceDocstring (\s a -> s { serviceDocstring = a })++instance HasAnnotations (Service a) where+    annotations = lens serviceAnnotations (\s a -> s { serviceAnnotations = a })++-- | A declared constant.+--+-- > const i32 code = 1;+data Const srcAnnot = Const+    { constValueType :: TypeReference srcAnnot+    -- ^ Type of the constant.+    , constName      :: Text+    -- ^ Name of the constant.+    , constValue     :: ConstValue srcAnnot+    -- ^ Value of the constant.+    , constDocstring :: Docstring+    -- ^ Documentation.+    , constSrcAnnot  :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasValue (Const a) (ConstValue a) where+    value = lens constValue (\s a -> s { constValue = a })++instance HasName (Const a) where+    name = lens constName (\s a -> s { constName = a })++instance HasSrcAnnot Const where+    srcAnnot = lens constSrcAnnot (\s a -> s { constSrcAnnot = a })++instance HasValueType Const where+    valueType = lens constValueType (\s a -> s { constValueType = a })++instance HasDocstring (Const a) where+    docstring = lens constDocstring (\s a -> s { constDocstring = a })++-- | A typedef is just an alias for another type.+--+-- > typedef common.Foo Bar+data Typedef srcAnnot = Typedef+    { typedefTargetType  :: TypeReference srcAnnot+    -- ^ The aliased type.+    , typedefName        :: Text+    -- ^ Name of the new type.+    , typedefAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to the typedef.+    , typedefDocstring   :: Docstring+    -- ^ Documentation.+    , typedefSrcAnnot    :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++targetType :: Lens (Typedef a) (TypeReference a)+targetType = lens typedefTargetType (\s a -> s { typedefTargetType = a })++instance HasName (Typedef a) where+    name = lens typedefName (\s a -> s { typedefName = a })++instance HasSrcAnnot Typedef where+    srcAnnot = lens typedefSrcAnnot (\s a -> s { typedefSrcAnnot = a })++instance HasDocstring (Typedef a) where+    docstring = lens typedefDocstring (\s a -> s { typedefDocstring = a })++instance HasAnnotations (Typedef a) where+    annotations = lens typedefAnnotations (\s a -> s { typedefAnnotations = a })++-- | 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, Functor)++instance HasValue (EnumDef a) (Maybe Integer) where+    value = lens enumDefValue (\s a -> s { enumDefValue = a })++instance HasName (EnumDef a) where+    name = lens enumDefName (\s a -> s { enumDefName = a })++instance HasSrcAnnot EnumDef where+    srcAnnot = lens enumDefSrcAnnot (\s a -> s { enumDefSrcAnnot = a })++instance HasDocstring (EnumDef a) where+    docstring = lens enumDefDocstring (\s a -> s { enumDefDocstring = a })++instance HasAnnotations (EnumDef a) where+    annotations = lens enumDefAnnotations (\s a -> s { enumDefAnnotations = a })++-- | Enums are sets of named integer values.+--+-- > enum Role {+-- >     User = 1, Admin = 2+-- > }+data Enum srcAnnot = Enum+    { enumName        :: Text+    -- ^ Name of the enum type.+    , enumValues      :: [EnumDef srcAnnot]+    -- ^ Values defined in the enum.+    , enumAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to the enum.+    , enumDocstring   :: Docstring+    -- ^ Documentation.+    , enumSrcAnnot    :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++class HasValues s a | s -> a where+    values :: Lens s a++instance HasValues (Enum a) [EnumDef a] where+    values = lens enumValues (\s a -> s { enumValues = a })++instance HasName (Enum a) where+    name = lens enumName (\s a -> s { enumName = a })++instance HasSrcAnnot Enum where+    srcAnnot = lens enumSrcAnnot (\s a -> s { enumSrcAnnot = a })++instance HasDocstring (Enum a) where+    docstring = lens enumDocstring (\s a -> s { enumDocstring = a })++instance HasAnnotations (Enum a) where+    annotations = lens enumAnnotations (\s a -> s { enumAnnotations = a })++-- | A struct definition+--+-- > struct User {+-- >     1: Role role = Role.User;+-- > }+data Struct srcAnnot = Struct+    { structName        :: Text+    -- ^ Name of the struct.+    , structFields      :: [Field srcAnnot]+    -- ^ Fields defined in the struct.+    , structAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to the struct.+    , structDocstring   :: Docstring+    -- ^ Documentation.+    , structSrcAnnot    :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasName (Struct a) where+    name = lens structName (\s a -> s { structName = a })++instance HasFields Struct where+    fields = lens structFields (\s a -> s { structFields = a })++instance HasSrcAnnot Struct where+    srcAnnot = lens structSrcAnnot (\s a -> s { structSrcAnnot = a })++instance HasDocstring (Struct a) where+    docstring = lens structDocstring (\s a -> s { structDocstring = a })++instance HasAnnotations (Struct a) where+    annotations = lens structAnnotations (\s a -> s { structAnnotations = a })++-- | A union of other types.+--+-- > union Value {+-- >     1: string stringValue;+-- >     2: i32 intValue;+-- > }+data Union srcAnnot = Union+    { unionName        :: Text+    -- ^ Name of the union.+    , unionFields      :: [Field srcAnnot]+    -- ^ Fields defined in the union.+    , unionAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to the union.+    , unionDocstring   :: Docstring+    -- ^ Documentation.+    , unionSrcAnnot    :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasName (Union a) where+    name = lens unionName (\s a -> s { unionName = a })++instance HasFields Union where+    fields = lens unionFields (\s a -> s { unionFields = a })++instance HasSrcAnnot Union where+    srcAnnot = lens unionSrcAnnot (\s a -> s { unionSrcAnnot = a })++instance HasDocstring (Union a) where+    docstring = lens unionDocstring (\s a -> s { unionDocstring = a })++instance HasAnnotations (Union a) where+    annotations = lens unionAnnotations (\s a -> s { unionAnnotations = a })++-- | Exception types.+--+-- > exception UserDoesNotExist {+-- >     1: optional string message+-- >     2: required string username+-- > }+data Exception srcAnnot = Exception+    { exceptionName        :: Text+    -- ^ Name of the exception.+    , exceptionFields      :: [Field srcAnnot]+    -- ^ Fields defined in the exception.+    , exceptionAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to the exception.+    , exceptionDocstring   :: Docstring+    -- ^ Documentation.+    , exceptionSrcAnnot    :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasName (Exception a) where+    name = lens exceptionName (\s a -> s { exceptionName = a })++instance HasFields Exception where+    fields = lens exceptionFields (\s a -> s { exceptionFields = a })++instance HasSrcAnnot Exception where+    srcAnnot = lens exceptionSrcAnnot (\s a -> s { exceptionSrcAnnot = a })++instance HasDocstring (Exception a) where+    docstring = lens exceptionDocstring (\s a -> s { exceptionDocstring = a })++instance HasAnnotations (Exception a) where+    annotations = lens exceptionAnnotations (\s a -> s { exceptionAnnotations = a })++-- | An string-only enum. These are a deprecated feature of Thrift and+-- shouldn't be used.+data Senum srcAnnot = Senum+    { senumName        :: Text+    , senumValues      :: [Text]+    , senumAnnotations :: [TypeAnnotation]+    -- ^ Annotations added to the senum.+    , senumDocstring   :: Docstring+    -- ^ Documentation.+    , senumSrcAnnot    :: srcAnnot+    }+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasValues (Senum a) [Text] where+    values = lens senumValues (\s a -> s { senumValues = a })++instance HasName (Senum a) where+    name = lens senumName (\s a -> s { senumName = a })++instance HasSrcAnnot Senum where+    srcAnnot = lens senumSrcAnnot (\s a -> s { senumSrcAnnot = a })++instance HasDocstring (Senum a) where+    docstring = lens senumDocstring (\s a -> s { senumDocstring = a })++instance HasAnnotations (Senum a) where+    annotations = lens senumAnnotations (\s a -> s { senumAnnotations = a })++-- | Defines the various types that can be declared in Thrift.+data Type srcAnnot+    = -- | @typedef@+      TypedefType (Typedef srcAnnot)+    | -- | @enum@+      EnumType (Enum srcAnnot)+    | -- | @struct@+      StructType (Struct srcAnnot)+    | -- | @union@+      UnionType (Union srcAnnot)+    | -- | @exception@+      ExceptionType (Exception srcAnnot)+    | -- | @senum@+      SenumType (Senum srcAnnot)+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasName (Type a) where+    name = lens getter setter+      where+        getter (TypedefType   t) = view name t+        getter (EnumType      t) = view name t+        getter (StructType    t) = view name t+        getter (UnionType     t) = view name t+        getter (ExceptionType t) = view name t+        getter (SenumType     t) = view name t++        setter (TypedefType   t) n = TypedefType   $ set name n t+        setter (EnumType      t) n = EnumType      $ set name n t+        setter (StructType    t) n = StructType    $ set name n t+        setter (UnionType     t) n = UnionType     $ set name n t+        setter (ExceptionType t) n = ExceptionType $ set name n t+        setter (SenumType     t) n = SenumType     $ set name n t++instance HasSrcAnnot Type where+    srcAnnot = lens getter setter+      where+        getter (TypedefType   t) = view srcAnnot t+        getter (EnumType      t) = view srcAnnot t+        getter (StructType    t) = view srcAnnot t+        getter (UnionType     t) = view srcAnnot t+        getter (ExceptionType t) = view srcAnnot t+        getter (SenumType     t) = view srcAnnot t++        setter (TypedefType   t) a = TypedefType   $ set srcAnnot a t+        setter (EnumType      t) a = EnumType      $ set srcAnnot a t+        setter (StructType    t) a = StructType    $ set srcAnnot a t+        setter (UnionType     t) a = UnionType     $ set srcAnnot a t+        setter (ExceptionType t) a = ExceptionType $ set srcAnnot a t+        setter (SenumType     t) a = SenumType     $ set srcAnnot a t++-- | A definition either consists of new constants, new types, or new+-- services.+data Definition srcAnnot+    = -- | A declared constant.+      ConstDefinition (Const srcAnnot)+    | -- | A custom type.+      TypeDefinition (Type srcAnnot)+    | -- | A service definition.+      ServiceDefinition (Service srcAnnot)+  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++instance HasName (Definition a) where+    name = lens getter setter+      where+        getter (ConstDefinition   d) = view name d+        getter (TypeDefinition    d) = view name d+        getter (ServiceDefinition d) = view name d++        setter (ConstDefinition   d) n = ConstDefinition   $ set name n d+        setter (TypeDefinition    d) n = TypeDefinition    $ set name n d+        setter (ServiceDefinition d) n = ServiceDefinition $ set name n d++instance HasSrcAnnot Definition where+    srcAnnot = lens getter setter+      where+        getter (ConstDefinition   d) = view srcAnnot d+        getter (TypeDefinition    d) = view srcAnnot d+        getter (ServiceDefinition d) = view srcAnnot d++        setter (ConstDefinition   d) a = ConstDefinition   $ set srcAnnot a d+        setter (TypeDefinition    d) a = TypeDefinition    $ set srcAnnot a d+        setter (ServiceDefinition d) a = ServiceDefinition $ set srcAnnot a d+++-- | Namespace directives allows control of the namespace or package+-- name used by the generated code for certain languages.+--+-- > namespace py my_service.generated+data Namespace srcAnnot = 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.+    , namespaceSrcAnnot :: srcAnnot+    }+    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++language :: Lens (Namespace a) Text+language = lens namespaceLanguage (\s a -> s { namespaceLanguage = a })++instance HasName (Namespace a) where+    name = lens namespaceName (\s a -> s { namespaceName = a })++instance HasSrcAnnot Namespace where+    srcAnnot = lens namespaceSrcAnnot (\s a -> s { namespaceSrcAnnot = a })++-- | The IDL includes another Thrift file.+--+-- > include "common.thrift"+-- >+-- > typedef common.Foo Bar+--+data Include srcAnnot = Include+    { includePath     :: Text+    -- ^ Path to the included file.+    , includeSrcAnnot :: srcAnnot+    }+    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++path :: Lens (Include a) Text+path = lens includePath (\s a -> s { includePath = a })++instance HasSrcAnnot Include where+    srcAnnot = lens includeSrcAnnot (\s a -> s { includeSrcAnnot = a })++-- | Headers for a program.+data Header srcAnnot+    = -- | Request to include another Thrift file.+      HeaderInclude (Include srcAnnot)+    | -- | A @namespace@ specifier.+      HeaderNamespace (Namespace srcAnnot)+    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)++-- | A program represents a single Thrift document.+data Program srcAnnot = Program+    { programHeaders     :: [Header srcAnnot]+    -- ^ 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, Functor)++headers :: Lens (Program a) [Header a]+headers = lens programHeaders (\s a -> s { programHeaders = a })++definitions :: Lens (Program a) [Definition a]+definitions = lens programDefinitions (\s a -> s { programDefinitions = a })

@@ -0,0 +1,23 @@+{-# LANGUAGE RankNTypes #-}+-- | This module implements a minimal lens type.+module Language.Thrift.Internal.Lens+    ( Lens+    , lens+    , set+    , view+    ) where++import Data.Functor.Identity (Identity (..))++import qualified Control.Applicative as A++type Lens s a = forall f. Functor f => (a -> f a) -> s -> f s++lens :: (s -> a) -> (s -> a -> s) -> Lens s a+lens getter setter f s = setter s `fmap` f (getter s)++set :: Lens s a -> a -> s -> s+set l a = runIdentity . l (\_ -> Identity a)++view :: Lens s a -> s -> a+view l = A.getConst . l A.Const

@@ -1,59 +0,0 @@--- |--- Module      :  Language.Thrift.Internal.Reserved--- Copyright   :  (c) Abhinav Gupta 2016--- License     :  BSD3------ Maintainer  :  Abhinav Gupta <mail@abhinavg.net>--- Stability   :  experimental------ This module provides information about reserved Thrift identifiers.-module Language.Thrift.Internal.Reserved-    ( isReserved-    ) where--import           Data.Set (Set)-import qualified Data.Set as Set--isReserved :: String -> Bool-isReserved = (`Set.member` reservedKeywords)--reservedKeywords :: Set String-reservedKeywords = Set.fromList-    [ "include"-    , "namespace"-    , "cpp_namespace"-    , "php_namespace"-    , "py_module"-    , "perl_package"-    , "ruby_namespace"-    , "java_package"-    , "cocoa_package"-    , "csharp_namespace"-    , "typedef"-    , "enum"-    , "struct"-    , "union"-    , "exception"-    , "required"-    , "optional"-    , "senum"-    , "const"-    , "string"-    , "binary"-    , "slist"-    , "bool"-    , "byte"-    , "i8"-    , "i16"-    , "i32"-    , "i64"-    , "double"-    , "map"-    , "set"-    , "list"-    , "service"-    , "extends"-    , "oneway"-    , "void"-    , "throws"-    ]

@@ -1,793 +0,0 @@-{-# LANGUAGE DeriveDataTypeable     #-}-{-# LANGUAGE DeriveFunctor          #-}-{-# LANGUAGE DeriveGeneric          #-}-{-# LANGUAGE FlexibleInstances      #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses  #-}-{-# LANGUAGE RankNTypes             #-}-module Language.Thrift.Internal.Types-    (-    -- * AST--      Program(..)-    , headers-    , definitions--    , Header(..)--    , Include(..)-    , path--    , Namespace(..)-    , language--    , Definition(..)--    , Const(..)-    , Service(..)-    , functions-    , extends--    , Type(..)--    , Typedef(..)-    , targetType--    , Enum(..)-    , Struct(..)-    , Union(..)-    , Exception(..)-    , Senum(..)--    , FieldRequiredness(..)--    , Field(..)-    , identifier-    , requiredness-    , defaultValue--    , EnumDef(..)--    , ConstValue(..)--    , TypeReference(..)--    , Function(..)-    , oneWay-    , returnType-    , parameters-    , exceptions--    , TypeAnnotation(..)-    , Docstring--    -- * Typeclasses--    , HasAnnotations(..)-    , HasDocstring(..)-    , HasFields(..)-    , HasName(..)-    , HasSrcAnnot(..)-    , HasValue(..)-    , HasValues(..)-    , HasValueType(..)-    ) where--import Data.Data             (Data, Typeable)-import Data.Functor.Identity (Identity (..))-import Data.Text             (Text)-import GHC.Generics          (Generic)-import Prelude               hiding (Enum)--import qualified Control.Applicative as A--type Lens s a = forall f. Functor f => (a -> f a) -> s -> f s--lens :: (s -> a) -> (s -> a -> s) -> Lens s a-lens getter setter f s = setter s `fmap` f (getter s)--set :: Lens s a -> a -> s -> s-set l a = runIdentity . l (\_ -> Identity a)--view :: Lens s a -> s -> a-view l = A.getConst . l A.Const--class HasSrcAnnot t where-    srcAnnot :: Lens (t a) a--class HasName t where-    name :: Lens t Text--class HasValue s a | s -> a where-    value :: Lens s a---- | Type annoations may be added in various places in the form,------ > (foo = "bar", baz, qux = "quux")------ 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 :: Maybe Text-    -- ^ Value for the annotation.-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic)--instance HasName TypeAnnotation where-    name = lens typeAnnotationName (\s a -> s { typeAnnotationName = a })--instance HasValue TypeAnnotation (Maybe Text) where-    value = lens typeAnnotationValue (\s a -> s { typeAnnotationValue = a })--class HasAnnotations t where-    annotations :: Lens t [TypeAnnotation]---- | Docstrings are Javadoc-style comments attached various defined objects.------ > /**--- >  * Fetches an item.--- >  */--- > Item getItem()-type Docstring = Maybe Text--class HasDocstring t where-    docstring :: Lens t Docstring---- | 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 srcAnnot-    = ConstInt Integer srcAnnot-    -- ^ An integer. @42@-    | ConstFloat Double srcAnnot-    -- ^ A float. @4.2@-    | ConstLiteral Text srcAnnot-    -- ^ A literal string. @"hello"@-    | ConstIdentifier Text srcAnnot-    -- ^ A reference to another constant. @Foo.bar@-    | ConstList [ConstValue srcAnnot] srcAnnot-    -- ^ A literal list containing other constant values. @[42]@-    | ConstMap [(ConstValue srcAnnot, ConstValue srcAnnot)] srcAnnot-    -- ^ A literal list containing other constant values.-    -- @{"hellO": 1, "world": 2}@-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasSrcAnnot ConstValue where-    srcAnnot = lens getter setter-      where-        getter (ConstInt        _ a) = a-        getter (ConstFloat      _ a) = a-        getter (ConstLiteral    _ a) = a-        getter (ConstIdentifier _ a) = a-        getter (ConstList       _ a) = a-        getter (ConstMap        _ a) = a--        setter (ConstInt        x _) a = ConstInt        x a-        setter (ConstFloat      x _) a = ConstFloat      x a-        setter (ConstLiteral    x _) a = ConstLiteral    x a-        setter (ConstIdentifier x _) a = ConstIdentifier x a-        setter (ConstList       x _) a = ConstList       x a-        setter (ConstMap        x _) a = ConstMap        x a---- | A reference to a type.-data TypeReference srcAnnot-    = DefinedType Text srcAnnot-    -- ^ A custom defined type referred to by name.--    | StringType [TypeAnnotation] srcAnnot-    -- ^ @string@ and annotations.-    | BinaryType [TypeAnnotation] srcAnnot-    -- ^ @binary@ and annotations.-    | SListType [TypeAnnotation] srcAnnot-    -- ^ @slist@ and annotations.-    | BoolType [TypeAnnotation] srcAnnot-    -- ^ @bool@ and annotations.-    | ByteType [TypeAnnotation] srcAnnot-    -- ^ @byte@ and annotations.-    | I16Type [TypeAnnotation] srcAnnot-    -- ^ @i16@ and annotations.-    | I32Type [TypeAnnotation] srcAnnot-    -- ^ @i32@ and annotations.-    | I64Type [TypeAnnotation] srcAnnot-    -- ^ @i64@ and annotations.-    | DoubleType [TypeAnnotation] srcAnnot-    -- ^ @double@ and annotations.--    -- Container types-    | MapType-        (TypeReference srcAnnot)-        (TypeReference srcAnnot)-        [TypeAnnotation]-        srcAnnot-    -- ^ @map\<foo, bar\>@ and annotations.-    | SetType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot-    -- ^ @set\<baz\>@ and annotations.-    | ListType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot-    -- ^ @list\<qux\>@ and annotations.-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasSrcAnnot TypeReference where-    srcAnnot = lens getter setter-      where-        getter (DefinedType _ a) = a-        getter (StringType  _ a) = a-        getter (BinaryType  _ a) = a-        getter (SListType   _ a) = a-        getter (BoolType    _ a) = a-        getter (ByteType    _ a) = a-        getter (I16Type     _ a) = a-        getter (I32Type     _ a) = a-        getter (I64Type     _ a) = a-        getter (DoubleType  _ a) = a-        getter (MapType _ _ _ a) = a-        getter (SetType   _ _ a) = a-        getter (ListType  _ _ a) = a--        setter (DefinedType x _) a = DefinedType x a-        setter (StringType  x _) a = StringType  x a-        setter (BinaryType  x _) a = BinaryType  x a-        setter (SListType   x _) a = SListType   x a-        setter (BoolType    x _) a = BoolType    x a-        setter (ByteType    x _) a = ByteType    x a-        setter (I16Type     x _) a = I16Type     x a-        setter (I32Type     x _) a = I32Type     x a-        setter (I64Type     x _) a = I64Type     x a-        setter (DoubleType  x _) a = DoubleType  x a-        setter (MapType k v x _) a = MapType k v x a-        setter (SetType   t x _) a = SetType   t x a-        setter (ListType  t x _) a = ListType  t x a--class HasValueType t where-    valueType :: Lens (t a) (TypeReference a)---- | 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.-    , fieldValueType    :: TypeReference srcAnnot-    -- ^ Type of value the field holds.-    , fieldName         :: Text-    -- ^ Name of the field.-    , fieldDefaultValue :: Maybe (ConstValue srcAnnot)-    -- ^ Default value of the field, if any.-    , fieldAnnotations  :: [TypeAnnotation]-    -- ^ Field annotations.-    , fieldDocstring    :: Docstring-    -- ^ Documentation.-    , fieldSrcAnnot     :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--identifier :: Lens (Field a) (Maybe Integer)-identifier = lens fieldIdentifier (\s a -> s { fieldIdentifier = a })--requiredness :: Lens (Field a) (Maybe FieldRequiredness)-requiredness = lens fieldRequiredness (\s a -> s { fieldRequiredness = a })--defaultValue :: Lens (Field a) (Maybe (ConstValue a))-defaultValue = lens fieldDefaultValue (\s a -> s { fieldDefaultValue = a })--instance HasName (Field a) where-    name = lens fieldName (\s a -> s { fieldName = a })--instance HasValueType Field where-    valueType = lens fieldValueType (\s a -> s { fieldValueType = a })--instance HasSrcAnnot Field where-    srcAnnot = lens fieldSrcAnnot (\s a -> s { fieldSrcAnnot = a })--instance HasDocstring (Field a) where-    docstring = lens fieldDocstring (\s a -> s { fieldDocstring = a })--instance HasAnnotations (Field a) where-    annotations = lens fieldAnnotations (\s a -> s { fieldAnnotations = a })--class HasFields t where-    fields :: Lens (t a) [Field a]---- | 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 (TypeReference srcAnnot)-    -- ^ 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, Functor)--oneWay :: Lens (Function a) Bool-oneWay = lens functionOneWay (\s a -> s { functionOneWay = a })--returnType :: Lens (Function a) (Maybe (TypeReference a))-returnType = lens functionReturnType (\s a -> s { functionReturnType = a })--parameters :: Lens (Function a) [Field a]-parameters = lens functionParameters (\s a -> s { functionParameters = a })--exceptions :: Lens (Function a) (Maybe [Field a])-exceptions = lens functionExceptions (\s a -> s { functionExceptions = a })--instance HasName (Function a) where-    name = lens functionName (\s a -> s { functionName = a })--instance HasSrcAnnot Function where-    srcAnnot = lens functionSrcAnnot (\s a -> s { functionSrcAnnot = a })--instance HasDocstring (Function a) where-    docstring = lens functionDocstring (\s a -> s { functionDocstring = a })--instance HasAnnotations (Function a) where-    annotations = lens functionAnnotations (\s a -> s { functionAnnotations = a })---- | A service definition.------ > service MyService {--- >     // ...--- > }-data Service srcAnnot = Service-    { 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, Functor)--functions :: Lens (Service a) [Function a]-functions = lens serviceFunctions (\s a -> s { serviceFunctions = a })--extends :: Lens (Service a) (Maybe Text)-extends = lens serviceExtends (\s a -> s { serviceExtends = a })--instance HasName (Service a) where-    name = lens serviceName (\s a -> s { serviceName = a })--instance HasSrcAnnot Service where-    srcAnnot = lens serviceSrcAnnot (\s a -> s { serviceSrcAnnot = a })--instance HasDocstring (Service a) where-    docstring = lens serviceDocstring (\s a -> s { serviceDocstring = a })--instance HasAnnotations (Service a) where-    annotations = lens serviceAnnotations (\s a -> s { serviceAnnotations = a })---- | A declared constant.------ > const i32 code = 1;-data Const srcAnnot = Const-    { constValueType :: TypeReference srcAnnot-    -- ^ Type of the constant.-    , constName      :: Text-    -- ^ Name of the constant.-    , constValue     :: ConstValue srcAnnot-    -- ^ Value of the constant.-    , constDocstring :: Docstring-    -- ^ Documentation.-    , constSrcAnnot  :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasValue (Const a) (ConstValue a) where-    value = lens constValue (\s a -> s { constValue = a })--instance HasName (Const a) where-    name = lens constName (\s a -> s { constName = a })--instance HasSrcAnnot Const where-    srcAnnot = lens constSrcAnnot (\s a -> s { constSrcAnnot = a })--instance HasValueType Const where-    valueType = lens constValueType (\s a -> s { constValueType = a })--instance HasDocstring (Const a) where-    docstring = lens constDocstring (\s a -> s { constDocstring = a })---- | A typedef is just an alias for another type.------ > typedef common.Foo Bar-data Typedef srcAnnot = Typedef-    { typedefTargetType  :: TypeReference srcAnnot-    -- ^ The aliased type.-    , typedefName        :: Text-    -- ^ Name of the new type.-    , typedefAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the typedef.-    , typedefDocstring   :: Docstring-    -- ^ Documentation.-    , typedefSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--targetType :: Lens (Typedef a) (TypeReference a)-targetType = lens typedefTargetType (\s a -> s { typedefTargetType = a })--instance HasName (Typedef a) where-    name = lens typedefName (\s a -> s { typedefName = a })--instance HasSrcAnnot Typedef where-    srcAnnot = lens typedefSrcAnnot (\s a -> s { typedefSrcAnnot = a })--instance HasDocstring (Typedef a) where-    docstring = lens typedefDocstring (\s a -> s { typedefDocstring = a })--instance HasAnnotations (Typedef a) where-    annotations = lens typedefAnnotations (\s a -> s { typedefAnnotations = a })---- | 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, Functor)--instance HasValue (EnumDef a) (Maybe Integer) where-    value = lens enumDefValue (\s a -> s { enumDefValue = a })--instance HasName (EnumDef a) where-    name = lens enumDefName (\s a -> s { enumDefName = a })--instance HasSrcAnnot EnumDef where-    srcAnnot = lens enumDefSrcAnnot (\s a -> s { enumDefSrcAnnot = a })--instance HasDocstring (EnumDef a) where-    docstring = lens enumDefDocstring (\s a -> s { enumDefDocstring = a })--instance HasAnnotations (EnumDef a) where-    annotations = lens enumDefAnnotations (\s a -> s { enumDefAnnotations = a })---- | Enums are sets of named integer values.------ > enum Role {--- >     User = 1, Admin = 2--- > }-data Enum srcAnnot = Enum-    { enumName        :: Text-    -- ^ Name of the enum type.-    , enumValues      :: [EnumDef srcAnnot]-    -- ^ Values defined in the enum.-    , enumAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the enum.-    , enumDocstring   :: Docstring-    -- ^ Documentation.-    , enumSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--class HasValues s a | s -> a where-    values :: Lens s a--instance HasValues (Enum a) [EnumDef a] where-    values = lens enumValues (\s a -> s { enumValues = a })--instance HasName (Enum a) where-    name = lens enumName (\s a -> s { enumName = a })--instance HasSrcAnnot Enum where-    srcAnnot = lens enumSrcAnnot (\s a -> s { enumSrcAnnot = a })--instance HasDocstring (Enum a) where-    docstring = lens enumDocstring (\s a -> s { enumDocstring = a })--instance HasAnnotations (Enum a) where-    annotations = lens enumAnnotations (\s a -> s { enumAnnotations = a })---- | A struct definition------ > struct User {--- >     1: Role role = Role.User;--- > }-data Struct srcAnnot = Struct-    { structName        :: Text-    -- ^ Name of the struct.-    , structFields      :: [Field srcAnnot]-    -- ^ Fields defined in the struct.-    , structAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the struct.-    , structDocstring   :: Docstring-    -- ^ Documentation.-    , structSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasName (Struct a) where-    name = lens structName (\s a -> s { structName = a })--instance HasFields Struct where-    fields = lens structFields (\s a -> s { structFields = a })--instance HasSrcAnnot Struct where-    srcAnnot = lens structSrcAnnot (\s a -> s { structSrcAnnot = a })--instance HasDocstring (Struct a) where-    docstring = lens structDocstring (\s a -> s { structDocstring = a })--instance HasAnnotations (Struct a) where-    annotations = lens structAnnotations (\s a -> s { structAnnotations = a })---- | A union of other types.------ > union Value {--- >     1: string stringValue;--- >     2: i32 intValue;--- > }-data Union srcAnnot = Union-    { unionName        :: Text-    -- ^ Name of the union.-    , unionFields      :: [Field srcAnnot]-    -- ^ Fields defined in the union.-    , unionAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the union.-    , unionDocstring   :: Docstring-    -- ^ Documentation.-    , unionSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasName (Union a) where-    name = lens unionName (\s a -> s { unionName = a })--instance HasFields Union where-    fields = lens unionFields (\s a -> s { unionFields = a })--instance HasSrcAnnot Union where-    srcAnnot = lens unionSrcAnnot (\s a -> s { unionSrcAnnot = a })--instance HasDocstring (Union a) where-    docstring = lens unionDocstring (\s a -> s { unionDocstring = a })--instance HasAnnotations (Union a) where-    annotations = lens unionAnnotations (\s a -> s { unionAnnotations = a })---- | Exception types.------ > exception UserDoesNotExist {--- >     1: optional string message--- >     2: required string username--- > }-data Exception srcAnnot = Exception-    { exceptionName        :: Text-    -- ^ Name of the exception.-    , exceptionFields      :: [Field srcAnnot]-    -- ^ Fields defined in the exception.-    , exceptionAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the exception.-    , exceptionDocstring   :: Docstring-    -- ^ Documentation.-    , exceptionSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasName (Exception a) where-    name = lens exceptionName (\s a -> s { exceptionName = a })--instance HasFields Exception where-    fields = lens exceptionFields (\s a -> s { exceptionFields = a })--instance HasSrcAnnot Exception where-    srcAnnot = lens exceptionSrcAnnot (\s a -> s { exceptionSrcAnnot = a })--instance HasDocstring (Exception a) where-    docstring = lens exceptionDocstring (\s a -> s { exceptionDocstring = a })--instance HasAnnotations (Exception a) where-    annotations = lens exceptionAnnotations (\s a -> s { exceptionAnnotations = a })---- | An string-only enum. These are a deprecated feature of Thrift and--- shouldn't be used.-data Senum srcAnnot = Senum-    { senumName        :: Text-    , senumValues      :: [Text]-    , senumAnnotations :: [TypeAnnotation]-    -- ^ Annotations added to the senum.-    , senumDocstring   :: Docstring-    -- ^ Documentation.-    , senumSrcAnnot    :: srcAnnot-    }-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasValues (Senum a) [Text] where-    values = lens senumValues (\s a -> s { senumValues = a })--instance HasName (Senum a) where-    name = lens senumName (\s a -> s { senumName = a })--instance HasSrcAnnot Senum where-    srcAnnot = lens senumSrcAnnot (\s a -> s { senumSrcAnnot = a })--instance HasDocstring (Senum a) where-    docstring = lens senumDocstring (\s a -> s { senumDocstring = a })--instance HasAnnotations (Senum a) where-    annotations = lens senumAnnotations (\s a -> s { senumAnnotations = a })---- | Defines the various types that can be declared in Thrift.-data Type srcAnnot-    = -- | @typedef@-      TypedefType (Typedef srcAnnot)-    | -- | @enum@-      EnumType (Enum srcAnnot)-    | -- | @struct@-      StructType (Struct srcAnnot)-    | -- | @union@-      UnionType (Union srcAnnot)-    | -- | @exception@-      ExceptionType (Exception srcAnnot)-    | -- | @senum@-      SenumType (Senum srcAnnot)-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasName (Type a) where-    name = lens getter setter-      where-        getter (TypedefType   t) = view name t-        getter (EnumType      t) = view name t-        getter (StructType    t) = view name t-        getter (UnionType     t) = view name t-        getter (ExceptionType t) = view name t-        getter (SenumType     t) = view name t--        setter (TypedefType   t) n = TypedefType   $ set name n t-        setter (EnumType      t) n = EnumType      $ set name n t-        setter (StructType    t) n = StructType    $ set name n t-        setter (UnionType     t) n = UnionType     $ set name n t-        setter (ExceptionType t) n = ExceptionType $ set name n t-        setter (SenumType     t) n = SenumType     $ set name n t--instance HasSrcAnnot Type where-    srcAnnot = lens getter setter-      where-        getter (TypedefType   t) = view srcAnnot t-        getter (EnumType      t) = view srcAnnot t-        getter (StructType    t) = view srcAnnot t-        getter (UnionType     t) = view srcAnnot t-        getter (ExceptionType t) = view srcAnnot t-        getter (SenumType     t) = view srcAnnot t--        setter (TypedefType   t) a = TypedefType   $ set srcAnnot a t-        setter (EnumType      t) a = EnumType      $ set srcAnnot a t-        setter (StructType    t) a = StructType    $ set srcAnnot a t-        setter (UnionType     t) a = UnionType     $ set srcAnnot a t-        setter (ExceptionType t) a = ExceptionType $ set srcAnnot a t-        setter (SenumType     t) a = SenumType     $ set srcAnnot a t---- | A definition either consists of new constants, new types, or new--- services.-data Definition srcAnnot-    = -- | A declared constant.-      ConstDefinition (Const srcAnnot)-    | -- | A custom type.-      TypeDefinition (Type srcAnnot)-    | -- | A service definition.-      ServiceDefinition (Service srcAnnot)-  deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--instance HasName (Definition a) where-    name = lens getter setter-      where-        getter (ConstDefinition   d) = view name d-        getter (TypeDefinition    d) = view name d-        getter (ServiceDefinition d) = view name d--        setter (ConstDefinition   d) n = ConstDefinition   $ set name n d-        setter (TypeDefinition    d) n = TypeDefinition    $ set name n d-        setter (ServiceDefinition d) n = ServiceDefinition $ set name n d--instance HasSrcAnnot Definition where-    srcAnnot = lens getter setter-      where-        getter (ConstDefinition   d) = view srcAnnot d-        getter (TypeDefinition    d) = view srcAnnot d-        getter (ServiceDefinition d) = view srcAnnot d--        setter (ConstDefinition   d) a = ConstDefinition   $ set srcAnnot a d-        setter (TypeDefinition    d) a = TypeDefinition    $ set srcAnnot a d-        setter (ServiceDefinition d) a = ServiceDefinition $ set srcAnnot a d----- | Namespace directives allows control of the namespace or package--- name used by the generated code for certain languages.------ > namespace py my_service.generated-data Namespace srcAnnot = 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.-    , namespaceSrcAnnot :: srcAnnot-    }-    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--language :: Lens (Namespace a) Text-language = lens namespaceLanguage (\s a -> s { namespaceLanguage = a })--instance HasName (Namespace a) where-    name = lens namespaceName (\s a -> s { namespaceName = a })--instance HasSrcAnnot Namespace where-    srcAnnot = lens namespaceSrcAnnot (\s a -> s { namespaceSrcAnnot = a })---- | The IDL includes another Thrift file.------ > include "common.thrift"--- >--- > typedef common.Foo Bar----data Include srcAnnot = Include-    { includePath     :: Text-    -- ^ Path to the included file.-    , includeSrcAnnot :: srcAnnot-    }-    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)--path :: Lens (Include a) Text-path = lens includePath (\s a -> s { includePath = a })--instance HasSrcAnnot Include where-    srcAnnot = lens includeSrcAnnot (\s a -> s { includeSrcAnnot = a })---- | Headers for a program.-data Header srcAnnot-    = -- | Request to include another Thrift file.-      HeaderInclude (Include srcAnnot)-    | -- | A @namespace@ specifier.-      HeaderNamespace (Namespace srcAnnot)-    deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)---- | A program represents a single Thrift document.-data Program srcAnnot = Program-    { programHeaders     :: [Header srcAnnot]-    -- ^ 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, Functor)--headers :: Lens (Program a) [Header a]-headers = lens programHeaders (\s a -> s { programHeaders = a })--definitions :: Lens (Program a) [Definition a]-definitions = lens programDefinitions (\s a -> s { programDefinitions = a })

@@ -2,6 +2,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings     #-} {-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-} -- | -- Module      :  Language.Thrift.Parser -- Copyright   :  (c) Abhinav Gupta 2016@@ -64,16 +65,16 @@ import Control.Applicative import Control.Monad import Control.Monad.Trans.State (StateT)+import Data.Scientific           (floatingOrInteger) import Data.Text                 (Text)  import qualified Control.Monad.Trans.State as State import qualified Data.Text                 as Text+import qualified Data.Text.IO              as Text import qualified Text.Megaparsec           as P import qualified Text.Megaparsec.Lexer     as PL -import Language.Thrift.Internal.Reserved (isReserved)--import qualified Language.Thrift.Types as T+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.@@ -83,47 +84,53 @@     deriving (Show, Eq)  -- | Underlying Parser type.-type Parser s = StateT State (P.Parsec s)+type Parser s = StateT State (P.Parsec P.Dec s)  -- | Evaluates the underlying parser with a default state and get the Megaparsec -- parser.-runParser :: Parser s a -> P.Parsec s a+runParser+    :: (P.Stream s, P.Token s ~ Char)+    => Parser s a -> P.Parsec P.Dec s a runParser p = State.evalStateT p (State Nothing)  -- | Parses the Thrift file at the given path.-parseFromFile :: FilePath -> IO (Either P.ParseError (T.Program P.SourcePos))-parseFromFile =-    P.parseFromFile (thriftIDL :: P.Parsec Text (T.Program P.SourcePos))+parseFromFile+    :: FilePath+    -> IO (Either (P.ParseError Char P.Dec) (T.Program P.SourcePos))+parseFromFile path = P.runParser thriftIDL path <$> Text.readFile path  -- | @parse name contents@ parses the contents of a Thrift document with name -- @name@ held in @contents@. parse-    :: P.Stream s Char-    => FilePath -> s -> Either P.ParseError (T.Program P.SourcePos)+    :: (P.Stream s, P.Token s ~ Char)+    => FilePath+    -> s -> Either (P.ParseError Char P.Dec) (T.Program P.SourcePos) parse = P.parse thriftIDL  -- | Megaparsec parser that is able to parse full Thrift documents.-thriftIDL :: P.Stream s Char => P.Parsec s (T.Program P.SourcePos)+thriftIDL+    :: (P.Stream s, P.Token s ~ Char)+    => P.Parsec P.Dec s (T.Program P.SourcePos) thriftIDL = runParser program  -clearDocstring :: Parser s ()+clearDocstring :: P.Stream s => Parser s () clearDocstring = State.modify' (\s -> s { stateDocstring = Nothing })   -- | Returns the last docstring recorded by the parser and forgets about it.-lastDocstring :: Parser s T.Docstring+lastDocstring :: P.Stream s => Parser s T.Docstring lastDocstring = do     s <- State.gets stateDocstring     clearDocstring     return s  -- | Optional whitespace.-whiteSpace :: P.Stream s Char => Parser s ()+whiteSpace :: (P.Stream s, P.Token s ~ Char) => Parser s () whiteSpace = someSpace <|> pure ()  -- | Required whitespace.-someSpace :: P.Stream s Char => Parser s ()+someSpace :: (P.Stream s, P.Token s ~ Char) => Parser s () someSpace = P.skipSome $ readDocstring <|> skipComments <|> skipSpace   where     readDocstring = do@@ -145,14 +152,23 @@     skipLine = void P.eol <|> P.eof <|> (P.anyChar *> skipLine)      skipCStyleComment = P.choice-      [ P.try (P.string "*/")      *> pure ()-      , P.skipSome (P.noneOf "/*") *> skipCStyleComment-      , P.oneOf "/*"               *> skipCStyleComment+      [ P.try (P.string "*/")    *> pure ()+      , P.skipSome (noneOf "/*") *> skipCStyleComment+      , oneOf "/*"               *> skipCStyleComment       ] +oneOf :: (P.Stream s, P.Token s ~ Char) => String -> Parser s Char+oneOf = P.oneOf+{-# INLINE oneOf #-}++noneOf :: (P.Stream s, P.Token s ~ Char) => String -> Parser s Char+noneOf = P.noneOf+{-# INLINE noneOf #-}+ -- | @p `skipUpTo` n@ skips @p@ @n@ times or until @p@ stops matching -- -- whichever comes first.-skipUpTo :: P.Stream s Char => Parser s a -> Int -> Parser s ()+skipUpTo+    :: (P.Stream s, P.Token s ~ Char) => Parser s a -> Int -> Parser s () skipUpTo p = loop   where     loop 0 = return ()@@ -162,8 +178,8 @@             loop $! n - 1         ) <|> return () -hspace :: P.Stream s Char => Parser s ()-hspace = void $ P.oneOf " \t"+hspace :: (P.Stream s, P.Token s ~ Char) => Parser s ()+hspace = void $ oneOf " \t"  -- | A javadoc-style docstring. --@@ -174,10 +190,10 @@ -- 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.Stream s Char => Parser s Text+docstring :: (P.Stream s, P.Token s ~ Char) => Parser s Text docstring = do     P.try (P.string "/**") >> P.skipMany hspace-    indent <- P.sourceColumn <$> P.getPosition+    indent <- fromIntegral . P.unPos <$> PL.indentLevel     isNewLine <- maybeEOL     chunks <- loop isNewLine (indent - 1) []     return $! Text.intercalate "\n" chunks@@ -185,7 +201,7 @@     maybeEOL = (P.eol >> return True) <|> return False      commentChar =-        P.noneOf "*\r\n" <|>+        noneOf "*\r\n" <|>         P.try (P.char '*' <* P.notFollowedBy (P.char '/'))      loop shouldDedent maxDedent chunks = do@@ -222,68 +238,59 @@             loop True maxDedent (line:chunks)  -symbolic :: P.Stream s Char => Char -> Parser s ()+symbolic :: (P.Stream s, P.Token s ~ Char) => Char -> Parser s () symbolic c = void $ PL.symbol whiteSpace [c] -token :: P.Stream s Char => Parser s a -> Parser s a+token :: (P.Stream s, P.Token s ~ Char) => Parser s a -> Parser s a token = PL.lexeme whiteSpace -braces, angles, parens :: P.Stream s Char => Parser s a -> Parser s a+braces, angles, parens+    :: (P.Stream s, P.Token s ~ Char) => Parser s a -> Parser s a  braces = P.between (symbolic '{') (symbolic '}') angles = P.between (symbolic '<') (symbolic '>') parens = P.between (symbolic '(') (symbolic ')') -comma, semi, colon, equals :: P.Stream s Char => Parser s ()+comma, semi, colon, equals :: (P.Stream s, P.Token s ~ Char) => Parser s ()  comma  = symbolic ',' semi   = symbolic ';' colon  = symbolic ':' equals = symbolic '=' --- | 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 name =-    unless (isReserved name) $-        error ("reserved called with unreserved identifier " ++ show name)- -- | Parses a reserved identifier and adds it to the collection of known -- reserved keywords.-reserved :: P.Stream s Char => String -> Parser s ()-reserved name =-    errorUnlessReserved name >>-    P.label name $ token $ P.try $ do-        void (P.string name)-        P.notFollowedBy (P.alphaNumChar <|> P.oneOf "_.")+reserved :: (P.Stream s, P.Token s ~ Char) => String -> Parser s ()+reserved name = P.label name $ token $ P.try $ do+    void (P.string name)+    P.notFollowedBy (P.alphaNumChar <|> oneOf "_.") + -- | A string literal. @"hello"@-literal :: P.Stream s Char => Parser s Text+literal :: (P.Stream s, P.Token s ~ Char) => Parser s Text literal = P.label "string literal" $ token $     stringLiteral '"' <|> stringLiteral '\'' -stringLiteral :: P.Stream s Char => Char -> Parser s Text+stringLiteral :: (P.Stream s, P.Token s ~ Char) => Char -> Parser s Text stringLiteral q = fmap Text.pack $     P.char q >> P.manyTill PL.charLiteral (P.char q)  -integer :: P.Stream s Char => Parser s Integer+integer :: (P.Stream s, P.Token s ~ Char) => Parser s Integer integer = token PL.integer   -- | An identifier in a Thrift file.-identifier :: P.Stream s Char => Parser s Text+identifier :: (P.Stream s, P.Token s ~ Char) => Parser s Text identifier = P.label "identifier" $ token $ do     name <- (:)         <$> (P.letterChar <|> P.char '_')-        <*> many (P.alphaNumChar <|> P.oneOf "_.")-    when (isReserved name) $-        P.unexpected name+        <*> many (P.alphaNumChar <|> oneOf "_.")     return (Text.pack name)   -- | Top-level parser to parse complete Thrift documents.-program :: P.Stream s Char => Parser s (T.Program P.SourcePos)+program :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Program P.SourcePos) program = whiteSpace >>     T.Program         <$> many (header     <* optionalSep)@@ -291,7 +298,7 @@         <*  P.eof  -- | Headers defined for the IDL.-header :: P.Stream s Char => Parser s (T.Header P.SourcePos)+header :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Header P.SourcePos) header = P.choice   [ T.HeaderInclude   <$> include   , T.HeaderNamespace <$> namespace@@ -304,7 +311,7 @@ -- > -- > typedef common.Foo Bar ---include :: P.Stream s Char => Parser s (T.Include P.SourcePos)+include :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Include P.SourcePos) include = reserved "include" >> withPosition (T.Include <$> literal)  @@ -312,7 +319,8 @@ -- name used by the generated code for certain languages. -- -- > namespace py my_service.generated-namespace :: P.Stream s Char => Parser s (T.Namespace P.SourcePos)+namespace+    :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Namespace P.SourcePos) namespace = P.choice   [ reserved "namespace" >>     withPosition (T.Namespace <$> (star <|> identifier) <*> identifier)@@ -340,7 +348,9 @@ -- | Convenience wrapper for parsers expecting a position. -- -- The position will be retrieved BEFORE the parser itself is executed.-withPosition :: P.Stream s Char => Parser s (P.SourcePos -> a) -> Parser s a+withPosition+    :: (P.Stream s, P.Token s ~ Char)+    => Parser s (P.SourcePos -> a) -> Parser s a withPosition p = P.getPosition >>= \pos -> p <*> pure pos  @@ -350,7 +360,7 @@ -- > -- > parseFoo = withDocstring $ Foo <$> parseBar withDocstring-    :: P.Stream s Char+    :: (P.Stream s, P.Token s ~ Char)     => Parser s (T.Docstring -> P.SourcePos -> a) -> Parser s a withDocstring p = lastDocstring >>= \s -> do     pos <- P.getPosition@@ -358,7 +368,8 @@   -- | A constant, type, or service definition.-definition :: P.Stream s Char => Parser s (T.Definition P.SourcePos)+definition+    :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Definition P.SourcePos) definition = whiteSpace >> P.choice     [ T.ConstDefinition   <$> constant     , T.TypeDefinition    <$> typeDefinition@@ -367,7 +378,8 @@   -- | A type definition.-typeDefinition :: P.Stream s Char => Parser s (T.Type P.SourcePos)+typeDefinition+    :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Type P.SourcePos) typeDefinition = P.choice     [ T.TypedefType   <$> typedef     , T.EnumType      <$> enum@@ -381,7 +393,7 @@ -- | A typedef is just an alias for another type. -- -- > typedef common.Foo Bar-typedef :: P.Stream s Char => Parser s (T.Typedef P.SourcePos)+typedef :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Typedef P.SourcePos) typedef = reserved "typedef" >> withDocstring     (T.Typedef <$> typeReference <*> identifier <*> typeAnnotations) @@ -390,8 +402,8 @@ -- -- > enum Role { -- >     User = 1, Admin--- > }-enum :: P.Stream s Char => Parser s (T.Enum P.SourcePos)+-- >+enum :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Enum P.SourcePos) enum = reserved "enum" >> withDocstring     ( T.Enum         <$> identifier@@ -406,7 +418,7 @@ -- >     1: string name -- >     2: Role role = Role.User; -- > }-struct :: P.Stream s Char => Parser s (T.Struct P.SourcePos)+struct :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Struct P.SourcePos) struct = reserved "struct" >> withDocstring     ( T.Struct         <$> identifier@@ -421,7 +433,7 @@ -- >     1: string stringValue; -- >     2: i32 intValue; -- > }-union :: P.Stream s Char => Parser s (T.Union P.SourcePos)+union :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Union P.SourcePos) union = reserved "union" >> withDocstring     ( T.Union         <$> identifier@@ -436,7 +448,8 @@ -- >     1: optional string message -- >     2: required string username -- > }-exception :: P.Stream s Char => Parser s (T.Exception P.SourcePos)+exception+    :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Exception P.SourcePos) exception = reserved "exception" >> withDocstring     ( T.Exception         <$> identifier@@ -446,7 +459,8 @@   -- | Whether a field is @required@ or @optional@.-fieldRequiredness :: P.Stream s Char => Parser s T.FieldRequiredness+fieldRequiredness+    :: (P.Stream s, P.Token s ~ Char) => Parser s T.FieldRequiredness fieldRequiredness = P.choice   [ reserved "required" *> pure T.Required   , reserved "optional" *> pure T.Optional@@ -454,7 +468,7 @@   -- | A struct field.-field :: P.Stream s Char => Parser s (T.Field P.SourcePos)+field :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Field P.SourcePos) field = withDocstring $   T.Field     <$> optional (integer <* colon)@@ -467,7 +481,7 @@   -- | A value defined inside an @enum@.-enumDef :: P.Stream s Char => Parser s (T.EnumDef P.SourcePos)+enumDef :: (P.Stream s, P.Token s ~ Char) => Parser s (T.EnumDef P.SourcePos) enumDef = withDocstring $   T.EnumDef     <$> identifier@@ -478,7 +492,7 @@  -- | An string-only enum. These are a deprecated feature of Thrift and shouldn't -- be used.-senum :: P.Stream s Char => Parser s (T.Senum P.SourcePos)+senum :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Senum P.SourcePos) senum = reserved "senum" >> withDocstring     ( T.Senum         <$> identifier@@ -490,7 +504,7 @@ -- | A 'const' definition. -- -- > const i32 code = 1;-constant :: P.Stream s Char => Parser s (T.Const P.SourcePos)+constant :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Const P.SourcePos) constant = do   reserved "const"   withDocstring $@@ -502,19 +516,23 @@   -- | A constant value literal.-constantValue :: P.Stream s Char => Parser s (T.ConstValue P.SourcePos)+constantValue+    :: (P.Stream s, P.Token s ~ Char) => Parser s (T.ConstValue P.SourcePos) constantValue = withPosition $ P.choice   [ P.try (P.string "0x") >> T.ConstInt <$> token PL.hexadecimal-  , either T.ConstInt T.ConstFloat-                      <$> token (PL.signed whiteSpace PL.number)+  , either T.ConstFloat T.ConstInt+                      <$> token signedNumber   , T.ConstLiteral    <$> literal   , T.ConstIdentifier <$> identifier   , T.ConstList       <$> constList   , T.ConstMap        <$> constMap   ]+  where+    signedNumber = floatingOrInteger <$> PL.signed whiteSpace PL.number  -constList :: P.Stream s Char => Parser s [T.ConstValue P.SourcePos]+constList+    :: (P.Stream s, P.Token s ~ Char) => Parser s [T.ConstValue P.SourcePos] constList = symbolic '[' *> loop []   where     loop xs = P.choice@@ -526,7 +544,7 @@   constMap-    :: P.Stream s Char+    :: (P.Stream s, P.Token s ~ Char)     => Parser s [(T.ConstValue P.SourcePos, T.ConstValue P.SourcePos)] constMap = symbolic '{' *> loop []   where@@ -539,7 +557,7 @@   constantValuePair-    :: P.Stream s Char+    :: (P.Stream s, P.Token s ~ Char)     => Parser s (T.ConstValue P.SourcePos, T.ConstValue P.SourcePos) constantValuePair =     (,) <$> (constantValue <* colon)@@ -547,7 +565,9 @@   -- | A reference to a built-in or defined field.-typeReference :: P.Stream s Char => Parser s (T.TypeReference P.SourcePos)+typeReference+    :: (P.Stream s, P.Token s ~ Char)+    => Parser s (T.TypeReference P.SourcePos) typeReference = P.choice   [ baseType   , containerType@@ -556,7 +576,8 @@   baseType-    :: P.Stream s Char => Parser s (T.TypeReference P.SourcePos)+    :: (P.Stream s, P.Token s ~ Char)+    => Parser s (T.TypeReference P.SourcePos) baseType = withPosition $     P.choice [reserved s *> (v <$> typeAnnotations) | (s, v) <- bases]   where@@ -575,7 +596,8 @@   containerType-    :: P.Stream s Char => Parser s (T.TypeReference P.SourcePos)+    :: (P.Stream s, P.Token s ~ Char)+    => Parser s (T.TypeReference P.SourcePos) containerType = withPosition $     P.choice [mapType, setType, listType] <*> typeAnnotations   where@@ -590,7 +612,7 @@ -- > service MyService { -- >     // ... -- > }-service :: P.Stream s Char => Parser s (T.Service P.SourcePos)+service :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Service P.SourcePos) service = do   reserved "service"   withDocstring $@@ -605,7 +627,8 @@ -- -- > Foo getFoo() throws (1: FooDoesNotExist doesNotExist); -- > oneway void putBar(1: Bar bar);-function :: P.Stream s Char => Parser s (T.Function P.SourcePos)+function+    :: (P.Stream s, P.Token s ~ Char) => Parser s (T.Function P.SourcePos) function = withDocstring $     T.Function         <$> ((reserved "oneway" *> pure True) <|> pure False)@@ -623,16 +646,17 @@ -- -- These do not usually affect code generation but allow for custom logic if -- writing your own code generator.-typeAnnotations :: P.Stream s Char => Parser s [T.TypeAnnotation]+typeAnnotations+    :: (P.Stream s, P.Token s ~ Char) => Parser s [T.TypeAnnotation] typeAnnotations = parens (many typeAnnotation) <|> pure []  -typeAnnotation :: P.Stream s Char => Parser s T.TypeAnnotation+typeAnnotation :: (P.Stream s, P.Token s ~ Char) => Parser s T.TypeAnnotation typeAnnotation =     T.TypeAnnotation         <$> identifier         <*> (optional (equals *> literal) <* optionalSep)  -optionalSep :: P.Stream s Char => Parser s ()+optionalSep :: (P.Stream s, P.Token s ~ Char) => Parser s () optionalSep = void $ optional (comma <|> semi)

@@ -73,8 +73,8 @@                                      linebreak, magenta, nest, plain, space,                                      vsep, yellow, (<$$>), (<$>), (<+>), (<>)) -import qualified Language.Thrift.Internal.Types as T-import qualified Text.PrettyPrint.ANSI.Leijen   as P+import qualified Language.Thrift.Internal.AST as T+import qualified Text.PrettyPrint.ANSI.Leijen as P  -- | Configuration for the pretty printer. data Config = Config

@@ -6,22 +6,10 @@ -- Maintainer  :  Abhinav Gupta <mail@abhinavg.net> -- Stability   :  experimental ----- This module defines types that compose a Thrift IDL file.------ Most of the types have an optional @srcAnnot@ parameter that represents a--- source annotation. The parser produces types annotated with their position--- in the Thrift file ('Text.Megaparsec.SourcePos'). When constructing the AST--- by hand, you can use @()@. The types are @Functor@s so you can use 'fmap'--- to change the annotation on all objects in a tree.------ Lenses for attributes of most types are provided for use with the `lens`--- library.------ Types representing the AST all have 'Text.PrettyPrint.ANSI.Leijen.Pretty'--- instances to go with them.+-- This module is deprecated. Use "Language.Thrift.AST" instead. module Language.Thrift.Types-    ( module Language.Thrift.Internal.Types+    {-# DEPRECATED "This module will be removed in a future release." #-}+    ( module Language.Thrift.AST     ) where -import Language.Thrift.Internal.Types-import Language.Thrift.Pretty         ()+import Language.Thrift.AST

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedStrings #-}+module Language.Thrift.ASTSpec (spec) where++import Control.Monad         (void)+import Test.Hspec+import Test.Hspec.QuickCheck+import Text.Megaparsec       (SourcePos)++import qualified Text.PrettyPrint.ANSI.Leijen as PP (Doc, plain)++import Language.Thrift.Arbitrary ()+import TestUtils++import qualified Language.Thrift.Parser as P+import qualified Language.Thrift.Pretty as PP++spec :: Spec+spec =+    describe "Parser and Printer" $ do++        prop "can round-trip type references" $+            roundtrip PP.typeReference P.typeReference++        prop "can round-trip constant values" $+            roundtrip PP.constantValue P.constantValue++        prop "can round-trip typedefs" $+            roundtrip PP.typedef (P.whiteSpace >> P.typedef)++        prop "can round-trip enums" $+            roundtrip PP.enum (P.whiteSpace >> P.enum)++        prop "can round-trip structs" $+            roundtrip PP.struct (P.whiteSpace >> P.struct)++        prop "can round-trip unions" $+            roundtrip PP.union (P.whiteSpace >> P.union)++        prop "can round-trip exceptions" $+            roundtrip PP.exception (P.whiteSpace >> P.exception)++        prop "can round-trip senums" $+            roundtrip PP.senum (P.whiteSpace >> P.senum)++        prop "can round-trip services" $+            roundtrip PP.service (P.whiteSpace >> P.service)++        prop "can round-trip constants" $+            roundtrip PP.constant (P.whiteSpace >> P.constant)++        prop "can round-trip includes" $+            roundtrip (const PP.include) (P.whiteSpace >> P.include)++        prop "can round-trip namespaces" $+            roundtrip (const PP.namespace) (P.whiteSpace >> P.namespace)++        prop "can round-trip documents" $+            roundtrip PP.program P.program+++roundtrip+    :: (Show (n ()), Eq (n ()), Functor n)+    => (PP.Config  -> n () ->  PP.Doc)+    -> Parser (n SourcePos)+    -> n ()+    -> IO ()+roundtrip printer parser value =+    assertParses (void `fmap` parser) value+        (show . PP.plain $ printer (PP.Config 4) value)

@@ -17,9 +17,7 @@  import qualified Data.Text as Text -import Language.Thrift.Internal.Reserved (isReserved)--import qualified Language.Thrift.Types as T+import qualified Language.Thrift.AST as T  #ifdef MIN_VERSION_QuickCheck #if !MIN_VERSION_QuickCheck(2, 8, 0)@@ -66,15 +64,6 @@      shrink (Docstring t) = Docstring <$> shrink t -newtype Identifier = Identifier { getIdentifier :: Text }-    deriving (Show, Typeable, Generic)--instance Arbitrary Identifier where-    arbitrary = Identifier <$> arbitrary `suchThat` (not . isReserved . Text.unpack)--    shrink (Identifier t) =-        [Identifier t' | t' <- shrink t, not (isReserved (Text.unpack t'))]- ------------------------------------------------------------------------------  instance Arbitrary (T.Program ()) where@@ -94,11 +83,7 @@  instance Arbitrary (T.Namespace ()) where     shrink = genericShrink-    arbitrary =-        T.Namespace-            <$> elements scopes-            <*> (getIdentifier <$> arbitrary)-            <*> pure ()+    arbitrary = T.Namespace <$> elements scopes <*> arbitrary <*> pure ()       where         scopes = ["*", "py", "rb", "java", "hs", "cpp"] @@ -116,8 +101,8 @@     arbitrary =         T.Const             <$> arbitrary-            <*> (getIdentifier <$> arbitrary)             <*> arbitrary+            <*> arbitrary             <*> (getDocstring <$> arbitrary)             <*> pure () @@ -125,12 +110,9 @@     shrink = genericShrink     arbitrary =         T.Service-            <$> (getIdentifier <$> arbitrary)-            <*> frequency-                    [ (1, return Nothing)-                    , (3, Just . getIdentifier <$> arbitrary)-                    ]+            <$> arbitrary             <*> arbitrary+            <*> arbitrary             <*> halfSize arbitrary             <*> (getDocstring <$> arbitrary)             <*> pure ()@@ -141,7 +123,7 @@         T.Function             <$> arbitrary             <*> halfSize arbitrary-            <*> (getIdentifier <$> arbitrary)+            <*> arbitrary             <*> halfSize arbitrary             <*> halfSize arbitrary             <*> halfSize arbitrary@@ -163,7 +145,7 @@     shrink = genericShrink     arbitrary = T.Typedef         <$> arbitrary-        <*> (getIdentifier <$> arbitrary)+        <*> arbitrary         <*> halfSize arbitrary         <*> (getDocstring <$> arbitrary)         <*> pure ()@@ -171,7 +153,7 @@ instance Arbitrary (T.Enum ()) where     shrink = genericShrink     arbitrary = T.Enum-        <$> (getIdentifier <$> arbitrary)+        <$> arbitrary         <*> arbitrary         <*> halfSize arbitrary         <*> (getDocstring <$> arbitrary)@@ -181,7 +163,7 @@     shrink = genericShrink     arbitrary =         T.EnumDef-            <$> (getIdentifier <$> arbitrary)+            <$> arbitrary             <*> arbitrary             <*> halfSize arbitrary             <*> (getDocstring <$> arbitrary)@@ -190,7 +172,7 @@ instance Arbitrary (T.Struct ()) where     shrink = genericShrink     arbitrary = T.Struct-        <$> (getIdentifier <$> arbitrary)+        <$> arbitrary         <*> arbitrary         <*> halfSize arbitrary         <*> (getDocstring <$> arbitrary)@@ -199,7 +181,7 @@ instance Arbitrary (T.Union ()) where     shrink = genericShrink     arbitrary = T.Union-        <$> (getIdentifier <$> arbitrary)+        <$> arbitrary         <*> arbitrary         <*> halfSize arbitrary         <*> (getDocstring <$> arbitrary)@@ -208,7 +190,7 @@ instance Arbitrary (T.Exception ()) where     shrink = genericShrink     arbitrary = T.Exception-        <$> (getIdentifier <$> arbitrary)+        <$> arbitrary         <*> arbitrary         <*> halfSize arbitrary         <*> (getDocstring <$> arbitrary)@@ -217,7 +199,7 @@ instance Arbitrary (T.Senum ()) where     shrink = genericShrink     arbitrary = T.Senum-        <$> (getIdentifier <$> arbitrary)+        <$> arbitrary         <*> arbitrary         <*> halfSize arbitrary         <*> (getDocstring <$> arbitrary)@@ -230,7 +212,7 @@             <$> (fmap getPositive <$> arbitrary)             <*> arbitrary             <*> halfSize arbitrary-            <*> (getIdentifier <$> arbitrary)+            <*> arbitrary             <*> halfSize arbitrary             <*> halfSize arbitrary             <*> (getDocstring <$> arbitrary)@@ -239,8 +221,7 @@ instance Arbitrary (T.TypeReference ()) where     shrink = genericShrink     arbitrary = oneof-        [ T.DefinedType           <$> (getIdentifier <$> arbitrary)-                                  <*> pure ()+        [ T.DefinedType           <$> arbitrary <*> pure ()         , halfSize $ T.StringType <$> arbitrary <*> pure ()         , halfSize $ T.BinaryType <$> arbitrary <*> pure ()         , halfSize $ T.SListType  <$> arbitrary <*> pure ()@@ -261,7 +242,7 @@  instance Arbitrary T.TypeAnnotation where     shrink = genericShrink-    arbitrary = T.TypeAnnotation <$> (getIdentifier <$> arbitrary) <*> arbitrary+    arbitrary = T.TypeAnnotation <$> arbitrary <*> arbitrary   newtype BasicConstValue = BasicConstValue {@@ -275,8 +256,7 @@         [ T.ConstFloat      <$> choose (0.0, 10000.0) <*> pure ()         , T.ConstInt        <$> arbitrary <*> pure ()         , T.ConstLiteral    <$> arbitrary <*> pure ()-        , T.ConstIdentifier <$> (getIdentifier <$> arbitrary)-                            <*> pure ()+        , T.ConstIdentifier <$> arbitrary <*> pure ()         ]  -- | newtype wrapper around const values so that we're not generating lists

@@ -14,8 +14,8 @@  import TestUtils +import qualified Language.Thrift.AST    as T import qualified Language.Thrift.Parser as P-import qualified Language.Thrift.Types  as T  spec :: Spec spec = describe "Parser" $ do@@ -79,13 +79,6 @@         , "map<i64>"         , "something_else<foo>"         ]--    it "cannot parse reserved keywords in names" $-        parseFailureCases P.program-            [ "enum struct {}"-            , "strut Foo { 1: required string service }"-            ]-  parseFailureCases :: Show a => Parser a -> [String] -> Expectation parseFailureCases p = mapM_ (p `shouldNotParse`)

@@ -1,69 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Language.Thrift.TypesSpec (spec) where--import Control.Monad         (void)-import Test.Hspec-import Test.Hspec.QuickCheck-import Text.Megaparsec       (SourcePos)--import qualified Text.PrettyPrint.ANSI.Leijen as PP (Doc, plain)--import Language.Thrift.Arbitrary ()-import TestUtils--import qualified Language.Thrift.Parser as P-import qualified Language.Thrift.Pretty as PP--spec :: Spec-spec =-    describe "Parser and Printer" $ do--        prop "can round-trip type references" $-            roundtrip PP.typeReference P.typeReference--        prop "can round-trip constant values" $-            roundtrip PP.constantValue P.constantValue--        prop "can round-trip typedefs" $-            roundtrip PP.typedef (P.whiteSpace >> P.typedef)--        prop "can round-trip enums" $-            roundtrip PP.enum (P.whiteSpace >> P.enum)--        prop "can round-trip structs" $-            roundtrip PP.struct (P.whiteSpace >> P.struct)--        prop "can round-trip unions" $-            roundtrip PP.union (P.whiteSpace >> P.union)--        prop "can round-trip exceptions" $-            roundtrip PP.exception (P.whiteSpace >> P.exception)--        prop "can round-trip senums" $-            roundtrip PP.senum (P.whiteSpace >> P.senum)--        prop "can round-trip services" $-            roundtrip PP.service (P.whiteSpace >> P.service)--        prop "can round-trip constants" $-            roundtrip PP.constant (P.whiteSpace >> P.constant)--        prop "can round-trip includes" $-            roundtrip (const PP.include) (P.whiteSpace >> P.include)--        prop "can round-trip namespaces" $-            roundtrip (const PP.namespace) (P.whiteSpace >> P.namespace)--        prop "can round-trip documents" $-            roundtrip PP.program P.program---roundtrip-    :: (Show (n ()), Eq (n ()), Functor n)-    => (PP.Config  -> n () ->  PP.Doc)-    -> Parser (n SourcePos)-    -> n ()-    -> IO ()-roundtrip printer parser value =-    assertParses (void `fmap` parser) value-        (show . PP.plain $ printer (PP.Config 4) value)

@@ -13,7 +13,7 @@  type Parser = T.Parser String -parse :: Parser a -> String -> Either P.ParseError a+parse :: Parser a -> String -> Either (P.ParseError Char P.Dec) a parse parser = P.parse (T.runParser parser) "memory"  -- | @assertParses parser expected input@ will assert that running @parser@ on