module Language.Thrift.Internal.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
, 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
data TypeAnnotation = TypeAnnotation
{ typeAnnotationName :: Text
, typeAnnotationValue :: Maybe Text
}
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]
type Docstring = Maybe Text
class HasDocstring t where
docstring :: Lens t Docstring
data ConstValue srcAnnot
= ConstInt Integer srcAnnot
| ConstFloat Double srcAnnot
| ConstLiteral Text srcAnnot
| ConstIdentifier Text srcAnnot
| ConstList [ConstValue srcAnnot] srcAnnot
| ConstMap [(ConstValue srcAnnot, ConstValue srcAnnot)] srcAnnot
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
data TypeReference srcAnnot
= DefinedType Text srcAnnot
| StringType [TypeAnnotation] srcAnnot
| BinaryType [TypeAnnotation] srcAnnot
| SListType [TypeAnnotation] srcAnnot
| BoolType [TypeAnnotation] srcAnnot
| ByteType [TypeAnnotation] srcAnnot
| I16Type [TypeAnnotation] srcAnnot
| I32Type [TypeAnnotation] srcAnnot
| I64Type [TypeAnnotation] srcAnnot
| DoubleType [TypeAnnotation] srcAnnot
| MapType
(TypeReference srcAnnot)
(TypeReference srcAnnot)
[TypeAnnotation]
srcAnnot
| SetType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot
| ListType (TypeReference srcAnnot) [TypeAnnotation] srcAnnot
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)
data FieldRequiredness
= Required
| Optional
deriving (Show, Ord, Eq, Data, Typeable, Generic)
data Field srcAnnot = Field
{ fieldIdentifier :: Maybe Integer
, fieldRequiredness :: Maybe FieldRequiredness
, fieldValueType :: TypeReference srcAnnot
, fieldName :: Text
, fieldDefaultValue :: Maybe (ConstValue srcAnnot)
, fieldAnnotations :: [TypeAnnotation]
, fieldDocstring :: Docstring
, 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]
data Function srcAnnot = Function
{ functionOneWay :: Bool
, functionReturnType :: Maybe (TypeReference srcAnnot)
, functionName :: Text
, functionParameters :: [Field srcAnnot]
, functionExceptions :: Maybe [Field srcAnnot]
, functionAnnotations :: [TypeAnnotation]
, functionDocstring :: Docstring
, 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 })
data Service srcAnnot = Service
{ serviceName :: Text
, serviceExtends :: Maybe Text
, serviceFunctions :: [Function srcAnnot]
, serviceAnnotations :: [TypeAnnotation]
, serviceDocstring :: Docstring
, 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 })
data Const srcAnnot = Const
{ constValueType :: TypeReference srcAnnot
, constName :: Text
, constValue :: ConstValue srcAnnot
, constDocstring :: Docstring
, 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 })
data Typedef srcAnnot = Typedef
{ typedefTargetType :: TypeReference srcAnnot
, typedefName :: Text
, typedefAnnotations :: [TypeAnnotation]
, typedefDocstring :: Docstring
, 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 })
data EnumDef srcAnnot = EnumDef
{ enumDefName :: Text
, enumDefValue :: Maybe Integer
, enumDefAnnotations :: [TypeAnnotation]
, enumDefDocstring :: Docstring
, 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 })
data Enum srcAnnot = Enum
{ enumName :: Text
, enumValues :: [EnumDef srcAnnot]
, enumAnnotations :: [TypeAnnotation]
, enumDocstring :: Docstring
, 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 })
data Struct srcAnnot = Struct
{ structName :: Text
, structFields :: [Field srcAnnot]
, structAnnotations :: [TypeAnnotation]
, structDocstring :: Docstring
, 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 })
data Union srcAnnot = Union
{ unionName :: Text
, unionFields :: [Field srcAnnot]
, unionAnnotations :: [TypeAnnotation]
, unionDocstring :: Docstring
, 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 })
data Exception srcAnnot = Exception
{ exceptionName :: Text
, exceptionFields :: [Field srcAnnot]
, exceptionAnnotations :: [TypeAnnotation]
, exceptionDocstring :: Docstring
, 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 })
data Senum srcAnnot = Senum
{ senumName :: Text
, senumValues :: [Text]
, senumAnnotations :: [TypeAnnotation]
, senumDocstring :: Docstring
, 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 })
data Type srcAnnot
=
TypedefType (Typedef srcAnnot)
|
EnumType (Enum srcAnnot)
|
StructType (Struct srcAnnot)
|
UnionType (Union srcAnnot)
|
ExceptionType (Exception srcAnnot)
|
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
data Definition srcAnnot
=
ConstDefinition (Const srcAnnot)
|
TypeDefinition (Type srcAnnot)
|
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
data Namespace srcAnnot = Namespace
{ namespaceLanguage :: Text
, namespaceName :: Text
, 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 })
data Include srcAnnot = Include
{ includePath :: Text
, 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 })
data Header srcAnnot
=
HeaderInclude (Include srcAnnot)
|
HeaderNamespace (Namespace srcAnnot)
deriving (Show, Ord, Eq, Data, Typeable, Generic, Functor)
data Program srcAnnot = Program
{ programHeaders :: [Header srcAnnot]
, programDefinitions :: [Definition srcAnnot]
}
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 })