{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable,
  OverloadedStrings #-}
module Data.Bond.Schema.BondDataType where
import qualified Data.Bond.Internal.Imports as B'
import qualified Prelude as P'

newtype BondDataType = BondDataType B'.Int32
                     deriving (P'.Show, P'.Eq, B'.NFData, P'.Ord, P'.Enum, B'.Hashable,
                               B'.Default, B'.Typeable)

instance B'.BondType BondDataType where
        bondPut (BondDataType v') = B'.bondPut v'
        bondGet = P'.fmap BondDataType B'.bondGet
        getName _ = "BondDataType"
        getQualifiedName _ = "bond.BondDataType"
        getElementType _ = B'.ElementInt32

instance B'.BondEnum BondDataType where
        toName (BondDataType 0) = P'.Just "BT_STOP"
        toName (BondDataType 1) = P'.Just "BT_STOP_BASE"
        toName (BondDataType 2) = P'.Just "BT_BOOL"
        toName (BondDataType 3) = P'.Just "BT_UINT8"
        toName (BondDataType 4) = P'.Just "BT_UINT16"
        toName (BondDataType 5) = P'.Just "BT_UINT32"
        toName (BondDataType 6) = P'.Just "BT_UINT64"
        toName (BondDataType 7) = P'.Just "BT_FLOAT"
        toName (BondDataType 8) = P'.Just "BT_DOUBLE"
        toName (BondDataType 9) = P'.Just "BT_STRING"
        toName (BondDataType 10) = P'.Just "BT_STRUCT"
        toName (BondDataType 11) = P'.Just "BT_LIST"
        toName (BondDataType 12) = P'.Just "BT_SET"
        toName (BondDataType 13) = P'.Just "BT_MAP"
        toName (BondDataType 14) = P'.Just "BT_INT8"
        toName (BondDataType 15) = P'.Just "BT_INT16"
        toName (BondDataType 16) = P'.Just "BT_INT32"
        toName (BondDataType 17) = P'.Just "BT_INT64"
        toName (BondDataType 18) = P'.Just "BT_WSTRING"
        toName (BondDataType 127) = P'.Just "BT_UNAVAILABLE"
        toName _ = P'.Nothing
        fromName "BT_STOP" = P'.Just bT_STOP
        fromName "BT_STOP_BASE" = P'.Just bT_STOP_BASE
        fromName "BT_BOOL" = P'.Just bT_BOOL
        fromName "BT_UINT8" = P'.Just bT_UINT8
        fromName "BT_UINT16" = P'.Just bT_UINT16
        fromName "BT_UINT32" = P'.Just bT_UINT32
        fromName "BT_UINT64" = P'.Just bT_UINT64
        fromName "BT_FLOAT" = P'.Just bT_FLOAT
        fromName "BT_DOUBLE" = P'.Just bT_DOUBLE
        fromName "BT_STRING" = P'.Just bT_STRING
        fromName "BT_STRUCT" = P'.Just bT_STRUCT
        fromName "BT_LIST" = P'.Just bT_LIST
        fromName "BT_SET" = P'.Just bT_SET
        fromName "BT_MAP" = P'.Just bT_MAP
        fromName "BT_INT8" = P'.Just bT_INT8
        fromName "BT_INT16" = P'.Just bT_INT16
        fromName "BT_INT32" = P'.Just bT_INT32
        fromName "BT_INT64" = P'.Just bT_INT64
        fromName "BT_WSTRING" = P'.Just bT_WSTRING
        fromName "BT_UNAVAILABLE" = P'.Just bT_UNAVAILABLE
        fromName _ = P'.Nothing

bT_STOP, bT_STOP_BASE, bT_BOOL, bT_UINT8, bT_UINT16, bT_UINT32,
         bT_UINT64, bT_FLOAT, bT_DOUBLE, bT_STRING, bT_STRUCT, bT_LIST,
         bT_SET, bT_MAP, bT_INT8, bT_INT16, bT_INT32, bT_INT64, bT_WSTRING,
         bT_UNAVAILABLE :: BondDataType
bT_STOP = BondDataType 0
bT_STOP_BASE = BondDataType 1
bT_BOOL = BondDataType 2
bT_UINT8 = BondDataType 3
bT_UINT16 = BondDataType 4
bT_UINT32 = BondDataType 5
bT_UINT64 = BondDataType 6
bT_FLOAT = BondDataType 7
bT_DOUBLE = BondDataType 8
bT_STRING = BondDataType 9
bT_STRUCT = BondDataType 10
bT_LIST = BondDataType 11
bT_SET = BondDataType 12
bT_MAP = BondDataType 13
bT_INT8 = BondDataType 14
bT_INT16 = BondDataType 15
bT_INT32 = BondDataType 16
bT_INT64 = BondDataType 17
bT_WSTRING = BondDataType 18
bT_UNAVAILABLE = BondDataType 127