module Network.ONCRPC.XDR.Specification
where
import qualified Network.ONCRPC.XDR.Types as XDR
import qualified Network.ONCRPC.Types as RPC
data ArrayLength
= FixedLength { ArrayLength -> Length
arrayLength :: !XDR.Length }
| VariableLength { arrayLength :: !XDR.Length
}
data TypeDescriptor
= TypeSingle
{ TypeDescriptor -> TypeSpecifier
descriptorType :: !TypeSpecifier
}
| TypeArray
{ descriptorType :: !TypeSpecifier
, TypeDescriptor -> ArrayLength
descriptorLength :: !ArrayLength
}
| TypeOpaque
{ descriptorLength :: !ArrayLength
}
| TypeString
{ descriptorLength :: !ArrayLength
}
| TypeOptional
{ descriptorType :: !TypeSpecifier
}
data TypeSpecifier
= TypeInt
| TypeUnsignedInt
| TypeHyper
| TypeUnsignedHyper
| TypeFloat
| TypeDouble
| TypeQuadruple
| TypeBool
| TypeEnum !EnumBody
| TypeStruct !StructBody
| TypeUnion !UnionBody
| TypeIdentifier !String
data Declaration = Declaration
{ Declaration -> String
declarationIdentifier :: !String
, Declaration -> TypeDescriptor
declarationType :: TypeDescriptor
}
type OptionalDeclaration = Maybe Declaration
type EnumValues = [(String, XDR.Int)]
newtype EnumBody = EnumBody
{ EnumBody -> EnumValues
enumValues :: EnumValues
}
boolValues :: EnumValues
boolValues :: EnumValues
boolValues = [(String
"FALSE", Int
0), (String
"TRUE", Int
1)]
newtype StructBody = StructBody
{ StructBody -> [Declaration]
structMembers :: [Declaration]
}
data UnionArm = UnionArm
{ UnionArm -> String
unionCaseIdentifier :: String
, UnionArm -> OptionalDeclaration
unionDeclaration :: OptionalDeclaration
}
data UnionBody = UnionBody
{ UnionBody -> Declaration
unionDiscriminant :: !Declaration
, UnionBody -> [(Int, UnionArm)]
unionCases :: [(XDR.Int, UnionArm)]
, UnionBody -> Maybe UnionArm
unionDefault :: Maybe UnionArm
}
data Procedure = Procedure
{ Procedure -> Maybe TypeSpecifier
procedureRes :: Maybe TypeSpecifier
, Procedure -> String
procedureIdentifier :: !String
, Procedure -> [TypeSpecifier]
procedureArgs :: [TypeSpecifier]
, Procedure -> Length
procedureNumber :: !RPC.ProcNum
}
data Version = Version
{ Version -> String
versionIdentifier :: !String
, Version -> String
versionTypeIdentifier :: !String
, Version -> [Procedure]
versionProcedures :: [Procedure]
, Version -> Length
versionNumber :: !RPC.VersNum
}
data DefinitionBody
= TypeDef TypeDescriptor
| Constant Integer
| Program
{ DefinitionBody -> String
programTypeIdentifier :: !String
, DefinitionBody -> [Version]
programVersions :: [Version]
, DefinitionBody -> Length
programNumber :: !RPC.ProgNum
}
data Definition = Definition
{ Definition -> String
definitionIdentifier :: !String
, Definition -> DefinitionBody
definitionBody :: !DefinitionBody
}
type Specification = [Definition]