{-# LINE 1 "Database/MySQL/Base/Types.hsc" #-}
{-# LANGUAGE DeriveDataTypeable, EmptyDataDecls, ForeignFunctionInterface #-}

-- |
-- Module:      Database.MySQL.Base.C
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     BSD3
-- Maintainer:  Paul Rouse <pyr@doynton.org>
-- Stability:   experimental
-- Portability: portable
--
-- Types for working with the direct bindings to the C @mysqlclient@
-- API.

module Database.MySQL.Base.Types
    (
    -- * Types
    -- * High-level types
      Type(..)
    , Seconds
    , Protocol(..)
    , Option(..)
    , Field(..)
    , FieldFlag
    , FieldFlags
    -- * Low-level types
    , MYSQL
    , MYSQL_RES
    , MYSQL_ROW
    , MYSQL_ROWS
    , MYSQL_ROW_OFFSET
    , MyBool
    -- * Field flags
    , hasAllFlags
    , flagNotNull
    , flagPrimaryKey
    , flagUniqueKey
    , flagMultipleKey
    , flagUnsigned
    , flagZeroFill
    , flagBinary
    , flagAutoIncrement
    , flagNumeric
    , flagNoDefaultValue
    -- * Connect flags
    , toConnectFlag
    ) where



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.Semigroup (Semigroup(..))
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

-- "mysql.h" defines the `MYSQL_TYPE_...` symbols as values of an enumeration,
-- not as preprocessor symbols.  Therefore we can't test for the presence of
-- `MYSQL_TYPE_JSON` using `#ifdef` or `#if defined()`, yet it is not available
-- in all versions of MySQL and MariaDB.  Although this is very unsatisfactory,
-- we have little alternative but to define it here.
--
mysql_type_json :: Int
mysql_type_json :: Int
mysql_type_json = Int
245

-- | Column types supported by MySQL.
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
          | Json
            deriving (Int -> Type
Type -> Int
Type -> [Type]
Type -> Type
Type -> Type -> [Type]
Type -> Type -> Type -> [Type]
(Type -> Type)
-> (Type -> Type)
-> (Int -> Type)
-> (Type -> Int)
-> (Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> [Type])
-> (Type -> Type -> Type -> [Type])
-> Enum Type
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Type -> Type -> Type -> [Type]
$cenumFromThenTo :: Type -> Type -> Type -> [Type]
enumFromTo :: Type -> Type -> [Type]
$cenumFromTo :: Type -> Type -> [Type]
enumFromThen :: Type -> Type -> [Type]
$cenumFromThen :: Type -> Type -> [Type]
enumFrom :: Type -> [Type]
$cenumFrom :: Type -> [Type]
fromEnum :: Type -> Int
$cfromEnum :: Type -> Int
toEnum :: Int -> Type
$ctoEnum :: Int -> Type
pred :: Type -> Type
$cpred :: Type -> Type
succ :: Type -> Type
$csucc :: Type -> Type
Enum, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Typeable)

toType :: CInt -> Type
toType :: CInt -> Type
toType CInt
v = Type -> Int -> IntMap Type -> Type
forall a. a -> Int -> IntMap a -> a
IntMap.findWithDefault Type
forall a. a
oops (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
v) IntMap Type
typeMap
  where
    oops :: a
oops = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Database.MySQL: unknown field type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ CInt -> String
forall a. Show a => a -> String
show CInt
v
    typeMap :: IntMap Type
typeMap = [(Int, Type)] -> IntMap Type
forall a. [(Int, a)] -> IntMap a
IntMap.fromList
      [ ((Int
0), Type
Decimal)
{-# LINE 118 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
1), Type
Tiny)
{-# LINE 119 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
2), Type
Short)
{-# LINE 120 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
9), Type
Int24)
{-# LINE 121 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
3), Type
Long)
{-# LINE 122 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
4), Type
Float)
{-# LINE 123 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
5), Type
Double)
{-# LINE 124 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
6), Type
Null)
{-# LINE 125 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
7), Type
Timestamp)
{-# LINE 126 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
8), Type
LongLong)
{-# LINE 127 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
10), Type
Date)
{-# LINE 128 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
11), Type
Time)
{-# LINE 129 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
12), Type
DateTime)
{-# LINE 130 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
13), Type
Year)
{-# LINE 131 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
14), Type
NewDate)
{-# LINE 132 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
15), Type
VarChar)
{-# LINE 133 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
16), Type
Bit)
{-# LINE 134 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
246), Type
NewDecimal)
{-# LINE 135 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
247), Type
Enum)
{-# LINE 136 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
248), Type
Set)
{-# LINE 137 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
249), Type
TinyBlob)
{-# LINE 138 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
250), Type
MediumBlob)
{-# LINE 139 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
251), Type
LongBlob)
{-# LINE 140 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
252), Type
Blob)
{-# LINE 141 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
253), Type
VarString)
{-# LINE 142 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
254), Type
String)
{-# LINE 143 "Database/MySQL/Base/Types.hsc" #-}
      , ((Int
255), Type
Geometry)
{-# LINE 144 "Database/MySQL/Base/Types.hsc" #-}
      , (Int
mysql_type_json, Type
Json)
      ]

-- | A description of a field (column) of a table.
data Field = Field {
      Field -> ByteString
fieldName :: ByteString   -- ^ Name of column.
    , Field -> ByteString
fieldOrigName :: ByteString -- ^ Original column name, if an alias.
    , Field -> ByteString
fieldTable :: ByteString -- ^ Table of column, if column was a field.
    , Field -> ByteString
fieldOrigTable :: ByteString -- ^ Original table name, if table was an alias.
    , Field -> ByteString
fieldDB :: ByteString        -- ^ Database for table.
    , Field -> ByteString
fieldCatalog :: ByteString   -- ^ Catalog for table.
    , Field -> Word
fieldLength :: Word          -- ^ Width of column (create length).
    , Field -> Word
fieldMaxLength :: Word    -- ^ Maximum width for selected set.
    , Field -> FieldFlags
fieldFlags :: FieldFlags        -- ^ Div flags.
    , Field -> Word
fieldDecimals :: Word -- ^ Number of decimals in field.
    , Field -> Word
fieldCharSet :: Word -- ^ Character set number.
    , Field -> Type
fieldType :: Type
    } deriving (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show, Typeable)

newtype FieldFlags = FieldFlags CUInt
    deriving (FieldFlags -> FieldFlags -> Bool
(FieldFlags -> FieldFlags -> Bool)
-> (FieldFlags -> FieldFlags -> Bool) -> Eq FieldFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldFlags -> FieldFlags -> Bool
$c/= :: FieldFlags -> FieldFlags -> Bool
== :: FieldFlags -> FieldFlags -> Bool
$c== :: FieldFlags -> FieldFlags -> Bool
Eq, Typeable)

instance Show FieldFlags where
    show :: FieldFlags -> String
show FieldFlags
f = Char
'[' Char -> ShowS
forall a. a -> [a] -> [a]
: String
z String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
      where z :: String
z = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> String)
-> ([Maybe String] -> [String]) -> [Maybe String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> String) -> [Maybe String] -> String
forall a b. (a -> b) -> a -> b
$ [
                          FieldFlags
flagNotNull FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagNotNull"
                        , FieldFlags
flagPrimaryKey FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagPrimaryKey"
                        , FieldFlags
flagUniqueKey FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagUniqueKey"
                        , FieldFlags
flagMultipleKey FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagMultipleKey"
                        , FieldFlags
flagUnsigned FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagUnsigned"
                        , FieldFlags
flagZeroFill FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagZeroFill"
                        , FieldFlags
flagBinary FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagBinary"
                        , FieldFlags
flagAutoIncrement FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagAutoIncrement"
                        , FieldFlags
flagNumeric FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagNumeric"
                        , FieldFlags
flagNoDefaultValue FieldFlags -> String -> Maybe String
forall a. FieldFlags -> a -> Maybe a
??? String
"flagNoDefaultValue"
                        ]
            FieldFlags
flag ??? :: FieldFlags -> a -> Maybe a
??? a
name | FieldFlags
f FieldFlags -> FieldFlags -> Bool
`hasAllFlags` FieldFlags
flag = a -> Maybe a
forall a. a -> Maybe a
Just a
name
                          | Bool
otherwise            = Maybe a
forall a. Maybe a
Nothing

type FieldFlag = FieldFlags

instance Semigroup FieldFlags where
    <> :: FieldFlags -> FieldFlags -> FieldFlags
(<>) (FieldFlags CUInt
a) (FieldFlags CUInt
b) = CUInt -> FieldFlags
FieldFlags (CUInt
a CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.|. CUInt
b)
    {-# INLINE (<>) #-}

instance Monoid FieldFlags where
    mempty :: FieldFlags
mempty = CUInt -> FieldFlags
FieldFlags CUInt
0
    {-# INLINE mempty #-}
    mappend :: FieldFlags -> FieldFlags -> FieldFlags
mappend = FieldFlags -> FieldFlags -> FieldFlags
forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mappend #-}

flagNotNull, flagPrimaryKey, flagUniqueKey, flagMultipleKey :: FieldFlag
flagNotNull :: FieldFlags
flagNotNull = CUInt -> FieldFlags
FieldFlags CUInt
1
{-# LINE 197 "Database/MySQL/Base/Types.hsc" #-}
flagPrimaryKey = FieldFlags 2
{-# LINE 198 "Database/MySQL/Base/Types.hsc" #-}
flagUniqueKey = FieldFlags 4
{-# LINE 199 "Database/MySQL/Base/Types.hsc" #-}
flagMultipleKey = FieldFlags 8
{-# LINE 200 "Database/MySQL/Base/Types.hsc" #-}

flagUnsigned, flagZeroFill, flagBinary, flagAutoIncrement :: FieldFlag
flagUnsigned :: FieldFlags
flagUnsigned = CUInt -> FieldFlags
FieldFlags CUInt
32
{-# LINE 203 "Database/MySQL/Base/Types.hsc" #-}
flagZeroFill = FieldFlags 64
{-# LINE 204 "Database/MySQL/Base/Types.hsc" #-}
flagBinary = FieldFlags 128
{-# LINE 205 "Database/MySQL/Base/Types.hsc" #-}
flagAutoIncrement = FieldFlags 512
{-# LINE 206 "Database/MySQL/Base/Types.hsc" #-}

flagNumeric, flagNoDefaultValue :: FieldFlag
flagNumeric :: FieldFlags
flagNumeric = CUInt -> FieldFlags
FieldFlags CUInt
32768
{-# LINE 209 "Database/MySQL/Base/Types.hsc" #-}
flagNoDefaultValue = FieldFlags 4096
{-# LINE 210 "Database/MySQL/Base/Types.hsc" #-}

hasAllFlags :: FieldFlags -> FieldFlags -> Bool
FieldFlags CUInt
a hasAllFlags :: FieldFlags -> FieldFlags -> Bool
`hasAllFlags` FieldFlags CUInt
b = CUInt
a CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
.&. CUInt
b CUInt -> CUInt -> Bool
forall a. Eq a => a -> a -> Bool
== CUInt
b
{-# INLINE hasAllFlags #-}

peekField :: Ptr Field -> IO Field
peekField :: Ptr Field -> IO Field
peekField Ptr Field
ptr = do
  FieldFlags
flags <- CUInt -> FieldFlags
FieldFlags (CUInt -> FieldFlags) -> IO CUInt -> IO FieldFlags
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((\Ptr Field
hsc_ptr -> Ptr Field -> Int -> IO CUInt
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Field
hsc_ptr Int
100)) Ptr Field
ptr
{-# LINE 218 "Database/MySQL/Base/Types.hsc" #-}
  Field
   <$> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 0))) (((\hsc_ptr -> peekByteOff hsc_ptr 72)))
{-# LINE 220 "Database/MySQL/Base/Types.hsc" #-}
   <*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 8))) (((\hsc_ptr -> peekByteOff hsc_ptr 76)))
{-# LINE 221 "Database/MySQL/Base/Types.hsc" #-}
   <*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 16))) (((\hsc_ptr -> peekByteOff hsc_ptr 80)))
{-# LINE 222 "Database/MySQL/Base/Types.hsc" #-}
   <*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 24))) (((\hsc_ptr -> peekByteOff hsc_ptr 84)))
{-# LINE 223 "Database/MySQL/Base/Types.hsc" #-}
   <*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 32))) (((\hsc_ptr -> peekByteOff hsc_ptr 88)))
{-# LINE 224 "Database/MySQL/Base/Types.hsc" #-}
   <*> peekS (((\hsc_ptr -> peekByteOff hsc_ptr 40))) (((\hsc_ptr -> peekByteOff hsc_ptr 92)))
{-# LINE 225 "Database/MySQL/Base/Types.hsc" #-}
   <*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr)
{-# LINE 226 "Database/MySQL/Base/Types.hsc" #-}
   <*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr)
{-# LINE 227 "Database/MySQL/Base/Types.hsc" #-}
   <*> pure flags
   <*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 104)) ptr)
{-# LINE 229 "Database/MySQL/Base/Types.hsc" #-}
   <*> (uint <$> ((\hsc_ptr -> peekByteOff hsc_ptr 108)) ptr)
{-# LINE 230 "Database/MySQL/Base/Types.hsc" #-}
   <*> (toType <$> ((\hsc_ptr -> peekByteOff hsc_ptr 112)) ptr)
{-# LINE 231 "Database/MySQL/Base/Types.hsc" #-}
 where
   uint :: CUInt -> Word
uint = CUInt -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: CUInt -> Word
   peekS :: (Ptr Field -> IO (Ptr Word8)) -> (Ptr Field -> IO CUInt)
         -> IO ByteString
   peekS :: (Ptr Field -> IO (Ptr Word8))
-> (Ptr Field -> IO CUInt) -> IO ByteString
peekS Ptr Field -> IO (Ptr Word8)
peekPtr Ptr Field -> IO CUInt
peekLen = do
     Ptr Word8
p <- Ptr Field -> IO (Ptr Word8)
peekPtr Ptr Field
ptr
     CUInt
l <- Ptr Field -> IO CUInt
peekLen Ptr Field
ptr
     Int -> (Ptr Word8 -> IO ()) -> IO ByteString
create (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
l) ((Ptr Word8 -> IO ()) -> IO ByteString)
-> (Ptr Word8 -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
d -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy Ptr Word8
d Ptr Word8
p (CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
l)

instance Storable Field where
    sizeOf :: Field -> Int
sizeOf Field
_    = (Int
128)
{-# LINE 242 "Database/MySQL/Base/Types.hsc" #-}
    alignment _ = alignment (undefined :: Ptr CChar)
    peek :: Ptr Field -> IO Field
peek = Ptr Field -> IO Field
peekField
    poke :: Ptr Field -> Field -> IO ()
poke Ptr Field
_ Field
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()   -- Unused, but define it to avoid a warning

type Seconds = Word

data Protocol = TCP
              | Socket
              | Pipe
              | Memory
                deriving (Protocol -> Protocol -> Bool
(Protocol -> Protocol -> Bool)
-> (Protocol -> Protocol -> Bool) -> Eq Protocol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Protocol -> Protocol -> Bool
$c/= :: Protocol -> Protocol -> Bool
== :: Protocol -> Protocol -> Bool
$c== :: Protocol -> Protocol -> Bool
Eq, ReadPrec [Protocol]
ReadPrec Protocol
Int -> ReadS Protocol
ReadS [Protocol]
(Int -> ReadS Protocol)
-> ReadS [Protocol]
-> ReadPrec Protocol
-> ReadPrec [Protocol]
-> Read Protocol
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Protocol]
$creadListPrec :: ReadPrec [Protocol]
readPrec :: ReadPrec Protocol
$creadPrec :: ReadPrec Protocol
readList :: ReadS [Protocol]
$creadList :: ReadS [Protocol]
readsPrec :: Int -> ReadS Protocol
$creadsPrec :: Int -> ReadS Protocol
Read, Int -> Protocol -> ShowS
[Protocol] -> ShowS
Protocol -> String
(Int -> Protocol -> ShowS)
-> (Protocol -> String) -> ([Protocol] -> ShowS) -> Show Protocol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Protocol] -> ShowS
$cshowList :: [Protocol] -> ShowS
show :: Protocol -> String
$cshow :: Protocol -> String
showsPrec :: Int -> Protocol -> ShowS
$cshowsPrec :: Int -> Protocol -> ShowS
Show, Int -> Protocol
Protocol -> Int
Protocol -> [Protocol]
Protocol -> Protocol
Protocol -> Protocol -> [Protocol]
Protocol -> Protocol -> Protocol -> [Protocol]
(Protocol -> Protocol)
-> (Protocol -> Protocol)
-> (Int -> Protocol)
-> (Protocol -> Int)
-> (Protocol -> [Protocol])
-> (Protocol -> Protocol -> [Protocol])
-> (Protocol -> Protocol -> [Protocol])
-> (Protocol -> Protocol -> Protocol -> [Protocol])
-> Enum Protocol
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Protocol -> Protocol -> Protocol -> [Protocol]
$cenumFromThenTo :: Protocol -> Protocol -> Protocol -> [Protocol]
enumFromTo :: Protocol -> Protocol -> [Protocol]
$cenumFromTo :: Protocol -> Protocol -> [Protocol]
enumFromThen :: Protocol -> Protocol -> [Protocol]
$cenumFromThen :: Protocol -> Protocol -> [Protocol]
enumFrom :: Protocol -> [Protocol]
$cenumFrom :: Protocol -> [Protocol]
fromEnum :: Protocol -> Int
$cfromEnum :: Protocol -> Int
toEnum :: Int -> Protocol
$ctoEnum :: Int -> Protocol
pred :: Protocol -> Protocol
$cpred :: Protocol -> Protocol
succ :: Protocol -> Protocol
$csucc :: Protocol -> Protocol
Enum, Typeable)

data Option =
            -- Options accepted by mysq_options.
              ConnectTimeout Seconds
            | Compress
            | NamedPipe
            | InitCommand ByteString
            | ReadDefaultFile FilePath
            | ReadDefaultGroup ByteString
            | CharsetDir FilePath
            | CharsetName String
            | LocalInFile Bool
            | Protocol Protocol
            | SharedMemoryBaseName ByteString
            | ReadTimeout Seconds
            | WriteTimeout Seconds

{-# LINE 271 "Database/MySQL/Base/Types.hsc" #-}
            | UseRemoteConnection
            | UseEmbeddedConnection
            | GuessConnection
            | ClientIP ByteString

{-# LINE 276 "Database/MySQL/Base/Types.hsc" #-}
            | SecureAuth Bool
            | ReportDataTruncation Bool
            | Reconnect Bool

{-# LINE 281 "Database/MySQL/Base/Types.hsc" #-}
            | SSLVerifyServerCert Bool

{-# LINE 283 "Database/MySQL/Base/Types.hsc" #-}
            -- Flags accepted by mysql_real_connect.
            | FoundRows
            | IgnoreSIGPIPE
            | IgnoreSpace
            | Interactive
            | LocalFiles
            | MultiResults
            | MultiStatements
            | NoSchema
              deriving (Option -> Option -> Bool
(Option -> Option -> Bool)
-> (Option -> Option -> Bool) -> Eq Option
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Option -> Option -> Bool
$c/= :: Option -> Option -> Bool
== :: Option -> Option -> Bool
$c== :: Option -> Option -> Bool
Eq, ReadPrec [Option]
ReadPrec Option
Int -> ReadS Option
ReadS [Option]
(Int -> ReadS Option)
-> ReadS [Option]
-> ReadPrec Option
-> ReadPrec [Option]
-> Read Option
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Option]
$creadListPrec :: ReadPrec [Option]
readPrec :: ReadPrec Option
$creadPrec :: ReadPrec Option
readList :: ReadS [Option]
$creadList :: ReadS [Option]
readsPrec :: Int -> ReadS Option
$creadsPrec :: Int -> ReadS Option
Read, Int -> Option -> ShowS
[Option] -> ShowS
Option -> String
(Int -> Option -> ShowS)
-> (Option -> String) -> ([Option] -> ShowS) -> Show Option
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option] -> ShowS
$cshowList :: [Option] -> ShowS
show :: Option -> String
$cshow :: Option -> String
showsPrec :: Int -> Option -> ShowS
$cshowsPrec :: Int -> Option -> ShowS
Show, Typeable)

toConnectFlag :: Option -> CULong
toConnectFlag :: Option -> CULong
toConnectFlag Option
Compress  = CULong
32
{-# LINE 296 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag FoundRows = 2
{-# LINE 297 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag IgnoreSIGPIPE = 4096
{-# LINE 298 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag IgnoreSpace = 256
{-# LINE 299 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag Interactive = 1024
{-# LINE 300 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag LocalFiles = 128
{-# LINE 301 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag MultiResults = 131072
{-# LINE 302 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag MultiStatements = 65536
{-# LINE 303 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag NoSchema = 16
{-# LINE 304 "Database/MySQL/Base/Types.hsc" #-}
toConnectFlag _        = 0