{-# LINE 1 "Database/MySQL/Base/Types.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, EmptyDataDecls, ForeignFunctionInterface #-}
{-# LINE 2 "Database/MySQL/Base/Types.hsc" #-}
module Database.MySQL.Base.Types
(
Type(..)
, Seconds
, Protocol(..)
, Option(..)
, Field(..)
, FieldFlag
, FieldFlags
, MYSQL
, MYSQL_RES
, MYSQL_ROW
, MYSQL_ROWS
, MYSQL_ROW_OFFSET
, MyBool
, hasAllFlags
, flagNotNull
, flagPrimaryKey
, flagUniqueKey
, flagMultipleKey
, flagUnsigned
, flagZeroFill
, flagBinary
, flagAutoIncrement
, flagNumeric
, flagNoDefaultValue
, toConnectFlag
) where
{-# LINE 49 "Database/MySQL/Base/Types.hsc" #-}
import Control.Applicative ((<$>), (<*>), pure)
import Data.Bits ((.|.), (.&.))
import Data.ByteString hiding (intercalate)
import Data.ByteString.Internal (create, memcpy)
import Data.List (intercalate)
import Data.Maybe (catMaybes)
import Data.Monoid (Monoid(..))
import Data.Typeable (Typeable)
import Data.Word (Word, Word8)
import Foreign.C.Types (CChar, CInt, CUInt, CULong)
import Foreign.Ptr (Ptr)
import Foreign.Storable (Storable(..), peekByteOff)
import qualified Data.IntMap as IntMap
data MYSQL
data MYSQL_RES
data MYSQL_ROWS
type MYSQL_ROW = Ptr (Ptr CChar)
type MYSQL_ROW_OFFSET = Ptr MYSQL_ROWS
type MyBool = CChar
data Type = Decimal
| Tiny
| Short
| Long
| Float
| Double
| Null
| Timestamp
| LongLong
| Int24
| Date
| Time
| DateTime
| Year
| NewDate
| VarChar
| Bit
| NewDecimal
| Enum
| Set
| TinyBlob
| MediumBlob
| LongBlob
| Blob
| VarString
| String
| Geometry
deriving (Enum, Eq, Show, Typeable)
toType :: CInt -> Type
toType v = IntMap.findWithDefault oops (fromIntegral v) typeMap
where
oops = error $ "Database.MySQL: unknown field type " ++ show v
typeMap = IntMap.fromList [
((0), Decimal),
{-# LINE 107 "Database/MySQL/Base/Types.hsc" #-}
((1), Tiny),
{-# LINE 108 "Database/MySQL/Base/Types.hsc" #-}
((2), Short),
{-# LINE 109 "Database/MySQL/Base/Types.hsc" #-}
((9), Int24),
{-# LINE 110 "Database/MySQL/Base/Types.hsc" #-}
((3), Long),
{-# LINE 111 "Database/MySQL/Base/Types.hsc" #-}
((4), Float),
{-# LINE 112 "Database/MySQL/Base/Types.hsc" #-}
((5), Double),
{-# LINE 113 "Database/MySQL/Base/Types.hsc" #-}
((6), Null),
{-# LINE 114 "Database/MySQL/Base/Types.hsc" #-}
((7), Timestamp),
{-# LINE 115 "Database/MySQL/Base/Types.hsc" #-}
((8), LongLong),
{-# LINE 116 "Database/MySQL/Base/Types.hsc" #-}
((10), Date),
{-# LINE 117 "Database/MySQL/Base/Types.hsc" #-}
((11), Time),
{-# LINE 118 "Database/MySQL/Base/Types.hsc" #-}
((12), DateTime),
{-# LINE 119 "Database/MySQL/Base/Types.hsc" #-}
((13), Year),
{-# LINE 120 "Database/MySQL/Base/Types.hsc" #-}
((14), NewDate),
{-# LINE 121 "Database/MySQL/Base/Types.hsc" #-}
((15), VarChar),
{-# LINE 122 "Database/MySQL/Base/Types.hsc" #-}
((16), Bit),
{-# LINE 123 "Database/MySQL/Base/Types.hsc" #-}
((246), NewDecimal),
{-# LINE 124 "Database/MySQL/Base/Types.hsc" #-}
((247), Enum),
{-# LINE 125 "Database/MySQL/Base/Types.hsc" #-}
((248), Set),
{-# LINE 126 "Database/MySQL/Base/Types.hsc" #-}
((249), TinyBlob),
{-# LINE 127 "Database/MySQL/Base/Types.hsc" #-}
((250), MediumBlob),
{-# LINE 128 "Database/MySQL/Base/Types.hsc" #-}
((251), LongBlob),
{-# LINE 129 "Database/MySQL/Base/Types.hsc" #-}
((252), Blob),
{-# LINE 130 "Database/MySQL/Base/Types.hsc" #-}
((253), VarString),
{-# LINE 131 "Database/MySQL/Base/Types.hsc" #-}
((254), String),
{-# LINE 132 "Database/MySQL/Base/Types.hsc" #-}
((255), Geometry)
{-# LINE 133 "Database/MySQL/Base/Types.hsc" #-}
]
data Field = Field {
fieldName :: ByteString
, fieldOrigName :: ByteString
, fieldTable :: ByteString
, fieldOrigTable :: ByteString
, fieldDB :: ByteString
, fieldCatalog :: ByteString
, fieldDefault :: Maybe ByteString
, fieldLength :: Word
, fieldMaxLength :: Word
, fieldFlags :: FieldFlags
, fieldDecimals :: Word
, fieldCharSet :: Word
, fieldType :: Type
} deriving (Eq, Show, Typeable)
newtype FieldFlags = FieldFlags CUInt
deriving (Eq, Typeable)
instance Show FieldFlags where
show f = '[' : z ++ "]"
where z = intercalate "," . catMaybes $ [
flagNotNull ??? "flagNotNull"
, flagPrimaryKey ??? "flagPrimaryKey"
, flagUniqueKey ??? "flagUniqueKey"
, flagMultipleKey ??? "flagMultipleKey"
, flagUnsigned ??? "flagUnsigned"
, flagZeroFill ??? "flagZeroFill"
, flagBinary ??? "flagBinary"
, flagAutoIncrement ??? "flagAutoIncrement"
, flagNumeric ??? "flagNumeric"
, flagNoDefaultValue ??? "flagNoDefaultValue"
]
flag ??? name | f `hasAllFlags` flag = Just name
| otherwise = Nothing
type FieldFlag = FieldFlags
instance Monoid FieldFlags where
mempty = FieldFlags 0
{-# INLINE mempty #-}
mappend (FieldFlags a) (FieldFlags b) = FieldFlags (a .|. b)
{-# INLINE mappend #-}
flagNotNull, flagPrimaryKey, flagUniqueKey, flagMultipleKey :: FieldFlag
flagNotNull = FieldFlags 1
{-# LINE 182 "Database/MySQL/Base/Types.hsc" #-}
flagPrimaryKey = FieldFlags 2
{-# LINE 183 "Database/MySQL/Base/Types.hsc" #-}
flagUniqueKey = FieldFlags 4
{-# LINE 184 "Database/MySQL/Base/Types.hsc" #-}
flagMultipleKey = FieldFlags 8
{-# LINE 185 "Database/MySQL/Base/Types.hsc" #-}
flagUnsigned, flagZeroFill, flagBinary, flagAutoIncrement :: FieldFlag
flagUnsigned = FieldFlags 32
{-# LINE 188 "Database/MySQL/Base/Types.hsc" #-}
flagZeroFill = FieldFlags 64
{-# LINE 189 "Database/MySQL/Base/Types.hsc" #-}
flagBinary = FieldFlags 128
{-# LINE 190 "Database/MySQL/Base/Types.hsc" #-}
flagAutoIncrement = FieldFlags 512
{-# LINE 191 "Database/MySQL/Base/Types.hsc" #-}
flagNumeric, flagNoDefaultValue :: FieldFlag
flagNumeric = FieldFlags 32768
{-# LINE 194 "Database/MySQL/Base/Types.hsc" #-}
flagNoDefaultValue = FieldFlags 4096
{-# LINE 195 "Database/MySQL/Base/Types.hsc" #-}
hasAllFlags :: FieldFlags -> FieldFlags -> Bool
FieldFlags a `hasAllFlags` FieldFlags b = a .&. b == b
{-# INLINE hasAllFlags #-}
peekField :: Ptr Field -> IO Field
peekField ptr = do
flags <- FieldFlags <$> ((\hsc_ptr -> peekByteOff hsc_ptr 100)) ptr
{-# LINE 203 "Database/MySQL/Base/Types.hsc" #-}
Field
<$> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 0))) (((\hsc_ptr -> peekByteOff hsc_ptr 72)))
{-# LINE 205 "Database/MySQL/Base/Types.hsc" #-}
<*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 8))) (((\hsc_ptr -> peekByteOff hsc_ptr 76)))
{-# LINE 206 "Database/MySQL/Base/Types.hsc" #-}
<*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 16))) (((\hsc_ptr -> peekByteOff hsc_ptr 80)))
{-# LINE 207 "Database/MySQL/Base/Types.hsc" #-}
<*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 24))) (((\hsc_ptr -> peekByteOff hsc_ptr 84)))
{-# LINE 208 "Database/MySQL/Base/Types.hsc" #-}
<*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 32))) (((\hsc_ptr -> peekByteOff hsc_ptr 88)))
{-# LINE 209 "Database/MySQL/Base/Types.hsc" #-}
<*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 40))) (((\hsc_ptr -> peekByteOff hsc_ptr 92)))
{-# LINE 210 "Database/MySQL/Base/Types.hsc" #-}
<*> (if flags `hasAllFlags` flagNoDefaultValue
then pure Nothing
else Just <$> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 48))) (((\hsc_ptr -> peekByteOff hsc_ptr 96))))
{-# LINE 213 "Database/MySQL/Base/Types.hsc" #-}
<*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr)
{-# LINE 214 "Database/MySQL/Base/Types.hsc" #-}
<*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr)
{-# LINE 215 "Database/MySQL/Base/Types.hsc" #-}
<*> pure flags
<*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 104)) ptr)
{-# LINE 217 "Database/MySQL/Base/Types.hsc" #-}
<*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 108)) ptr)
{-# LINE 218 "Database/MySQL/Base/Types.hsc" #-}
<*> (toType <$> ((\hsc_ptr -> peekByteOff hsc_ptr 112)) ptr)
{-# LINE 219 "Database/MySQL/Base/Types.hsc" #-}
where
uint = fromIntegral :: CUInt -> Word
peekS :: (Ptr Field -> IO (Ptr Word8)) -> (Ptr Field -> IO CUInt)
-> IO ByteString
peekS peekPtr peekLen = do
p <- peekPtr ptr
l <- peekLen ptr
create (fromIntegral l) $ \d -> memcpy d p (fromIntegral l)
instance Storable Field where
sizeOf _ = (128)
{-# LINE 230 "Database/MySQL/Base/Types.hsc" #-}
alignment _ = alignment (undefined :: Ptr CChar)
peek = peekField
type Seconds = Word
data Protocol = TCP
| Socket
| Pipe
| Memory
deriving (Eq, Read, Show, Enum, Typeable)
data Option =
ConnectTimeout Seconds
| Compress
| NamedPipe
| InitCommand ByteString
| ReadDefaultFile FilePath
| ReadDefaultGroup ByteString
| CharsetDir FilePath
| CharsetName String
| LocalInFile Bool
| Protocol Protocol
| SharedMemoryBaseName ByteString
| ReadTimeout Seconds
| WriteTimeout Seconds
| UseRemoteConnection
| UseEmbeddedConnection
| GuessConnection
| ClientIP ByteString
| SecureAuth Bool
| ReportDataTruncation Bool
| Reconnect Bool
| SSLVerifyServerCert Bool
| FoundRows
| IgnoreSIGPIPE
| IgnoreSpace
| Interactive
| LocalFiles
| MultiResults
| MultiStatements
| NoSchema
deriving (Eq, Read, Show, Typeable)
toConnectFlag :: Option -> CULong
toConnectFlag Compress = 32
{-# LINE 277 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag FoundRows = 2
{-# LINE 278 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag IgnoreSIGPIPE = 4096
{-# LINE 279 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag IgnoreSpace = 256
{-# LINE 280 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag Interactive = 1024
{-# LINE 281 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag LocalFiles = 128
{-# LINE 282 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag MultiResults = 131072
{-# LINE 283 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag MultiStatements = 65536
{-# LINE 284 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag NoSchema = 16
{-# LINE 285 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag _ = 0