-- |XDR specification, as per RFC4506 and RPC extensions from RFC5531

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 -- ^defaulted to maxLength
    }

data TypeDescriptor
  = TypeSingle
    { TypeDescriptor -> TypeSpecifier
descriptorType :: !TypeSpecifier
    }
  | TypeArray 
    { descriptorType :: !TypeSpecifier
    , TypeDescriptor -> ArrayLength
descriptorLength :: !ArrayLength
    }
  | TypeOpaque
    { descriptorLength :: !ArrayLength
    }
  | TypeString
    { descriptorLength :: !ArrayLength -- ^only 'VariableArray'
    }
  | TypeOptional
    { descriptorType :: !TypeSpecifier
    }

data TypeSpecifier
  = TypeInt
  | TypeUnsignedInt
  | TypeHyper
  | TypeUnsignedHyper
  | TypeFloat
  | TypeDouble
  | TypeQuadruple
  | TypeBool
  | TypeEnum !EnumBody
  | TypeStruct !StructBody
  | TypeUnion !UnionBody
  | TypeIdentifier !String

-- |Non-void declaration
data Declaration = Declaration
  { Declaration -> String
declarationIdentifier :: !String
  , Declaration -> TypeDescriptor
declarationType :: TypeDescriptor
  }

-- |'Declaration' or void
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] -- ^with voids elided
  }

data UnionArm = UnionArm
  { UnionArm -> String
unionCaseIdentifier :: String -- ^The literal string found after "case", for labeling
  , 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]