{-# LANGUAGE OverloadedStrings #-}
module SQL.CLI.Utils where
import Prelude hiding (fail, log)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Fail (MonadFail, fail)
import Control.Logging (debugS)
import System.IO (hPutStrLn, stderr)
import Foreign.C.String (withCStringLen, peekCString, peekCStringLen, CStringLen, CString)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Storable (Storable, peek, peekElemOff, sizeOf, poke)
import Foreign.Ptr (nullPtr, castPtr, Ptr)
import Data.Maybe (maybe)
import Data.String (IsString(fromString))
import Data.Text (Text)
import Data.List (insert)
import Data.Semigroup ((<>))
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Control.Monad.Trans.Reader (ReaderT, asks)
import SQL.CLI (sqlallochandle,
sqlfreehandle,
sqlgetdiagfield,
sqlgetdiagrec,
sqlconnect,
sqldescribecol,
sqldisconnect,
sqlexecdirect,
sqlexecute,
sqlprepare,
sqlbindcol,
sqlfetch,
sqlgetdata,
sqltables,
sqlcolumns,
sqlparamdata,
sqlputdata,
sqlbindparam,
sqlgetstmtattr,
sqlnumresultcols,
sqlgetdescrec,
sqlsetdescrec,
sqlgetdescfield,
sqlsetdescfield,
sqlsetconnectattr,
sqlendtran,
sql_handle_env,
sql_handle_dbc,
sql_handle_stmt,
sql_handle_desc,
sql_null_handle,
sql_error,
sql_diag_number,
sql_success,
sql_success_with_info,
sql_invalid_handle,
sql_no_data,
sql_need_data,
sql_max_message_length,
sql_null_data,
sql_char,
sql_smallint,
sql_integer,
sql_numeric,
sql_decimal,
sql_integer,
sql_smallint,
sql_float,
sql_real,
sql_double,
sql_datetime,
sql_varchar,
sql_no_nulls,
SQLSMALLINT,
SQLINTEGER,
SQLHENV,
SQLHDBC,
SQLHSTMT,
SQLHDESC,
SQLCHAR,
SQLPOINTER,
SQLHANDLE,
SQLLEN,
SQLULEN)
logSrc :: Text
logSrc :: Text
logSrc = String -> Text
forall a. IsString a => String -> a
fromString "SQL.CLI.Utils."
toCLIType :: SQLSMALLINT -> SQLSMALLINT
toCLIType :: SQLSMALLINT -> SQLSMALLINT
toCLIType t :: SQLSMALLINT
t = if SQLSMALLINT -> [SQLSMALLINT] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem SQLSMALLINT
t [SQLSMALLINT
forall a. Num a => a
sql_char, SQLSMALLINT
forall a. Num a => a
sql_numeric, SQLSMALLINT
forall a. Num a => a
sql_decimal, SQLSMALLINT
forall a. Num a => a
sql_integer, SQLSMALLINT
forall a. Num a => a
sql_smallint,
SQLSMALLINT
forall a. Num a => a
sql_float, SQLSMALLINT
forall a. Num a => a
sql_real, SQLSMALLINT
forall a. Num a => a
sql_double, SQLSMALLINT
forall a. Num a => a
sql_datetime, SQLSMALLINT
forall a. Num a => a
sql_varchar]
then SQLSMALLINT
t
else SQLSMALLINT
forall a. Num a => a
sql_char
data SQLConfig = SQLConfig {
SQLConfig -> SQLSMALLINT
sql_cli_flds_table_cat :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_table_schem :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_table_name :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_column_name :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_data_type :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_type_name :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_column_size :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_buffer_length :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_decimal_digits :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_num_prec_radix :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_nullable :: SQLSMALLINT,
:: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_column_def :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_datetime_code :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_char_octet_length :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_ordinal_position :: SQLSMALLINT,
SQLConfig -> SQLSMALLINT
sql_cli_flds_is_nullable :: SQLSMALLINT
}
data ColumnInfo = ColumnInfo {
ColumnInfo -> Maybe String
ci_TableCat :: Maybe String,
ColumnInfo -> String
ci_TableSchem :: String,
ColumnInfo -> String
ci_TableName :: String,
ColumnInfo -> String
ci_ColumnName :: String,
ColumnInfo -> SQLSMALLINT
ci_DataType :: SQLSMALLINT,
ColumnInfo -> String
ci_TypeName :: String,
ColumnInfo -> Maybe SQLINTEGER
ci_ColumnSize :: Maybe SQLINTEGER,
ColumnInfo -> Maybe SQLINTEGER
ci_BufferLength :: Maybe SQLINTEGER,
ColumnInfo -> Maybe SQLSMALLINT
ci_DecimalDigits :: Maybe SQLSMALLINT,
ColumnInfo -> Maybe SQLSMALLINT
ci_NumPrecRadix :: Maybe SQLSMALLINT,
ColumnInfo -> SQLSMALLINT
ci_Nullable :: SQLSMALLINT,
:: Maybe String,
ColumnInfo -> Maybe String
ci_ColumnDef :: Maybe String,
ColumnInfo -> Maybe SQLINTEGER
ci_DatetimeCode :: Maybe SQLINTEGER,
ColumnInfo -> Maybe SQLINTEGER
ci_CharOctetLength :: Maybe SQLINTEGER,
ColumnInfo -> SQLINTEGER
ci_OrdinalPosition :: SQLINTEGER,
ColumnInfo -> Maybe String
ci_IsNullable :: Maybe String }
deriving (ColumnInfo -> ColumnInfo -> Bool
(ColumnInfo -> ColumnInfo -> Bool)
-> (ColumnInfo -> ColumnInfo -> Bool) -> Eq ColumnInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColumnInfo -> ColumnInfo -> Bool
$c/= :: ColumnInfo -> ColumnInfo -> Bool
== :: ColumnInfo -> ColumnInfo -> Bool
$c== :: ColumnInfo -> ColumnInfo -> Bool
Eq, Int -> ColumnInfo -> ShowS
[ColumnInfo] -> ShowS
ColumnInfo -> String
(Int -> ColumnInfo -> ShowS)
-> (ColumnInfo -> String)
-> ([ColumnInfo] -> ShowS)
-> Show ColumnInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColumnInfo] -> ShowS
$cshowList :: [ColumnInfo] -> ShowS
show :: ColumnInfo -> String
$cshow :: ColumnInfo -> String
showsPrec :: Int -> ColumnInfo -> ShowS
$cshowsPrec :: Int -> ColumnInfo -> ShowS
Show)
instance Ord ColumnInfo where
compare :: ColumnInfo -> ColumnInfo -> Ordering
compare c1 :: ColumnInfo
c1 c2 :: ColumnInfo
c2 = SQLINTEGER -> SQLINTEGER -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ColumnInfo -> SQLINTEGER
ci_OrdinalPosition ColumnInfo
c1) (ColumnInfo -> SQLINTEGER
ci_OrdinalPosition ColumnInfo
c2)
collectColumnsInfo :: (MonadIO m, MonadFail m) => SQLHDBC
-> String
-> String
-> ReaderT SQLConfig m [ColumnInfo]
collectColumnsInfo :: SQLINTEGER -> String -> String -> ReaderT SQLConfig m [ColumnInfo]
collectColumnsInfo hdbc :: SQLINTEGER
hdbc schemaName :: String
schemaName tableName :: String
tableName = do
SQLINTEGER
hstmt <- SQLSMALLINT -> SQLINTEGER -> ReaderT SQLConfig m SQLINTEGER
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
allocHandle SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hdbc
SQLINTEGER
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> ReaderT SQLConfig m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> m ()
columns SQLINTEGER
hstmt Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
schemaName) (String -> Maybe String
forall a. a -> Maybe a
Just String
tableName) Maybe String
forall a. Maybe a
Nothing
SQLINTEGER -> ReaderT SQLConfig m [ColumnInfo]
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER -> ReaderT SQLConfig m [ColumnInfo]
collectColumnsInfo' SQLINTEGER
hstmt
collectColumnsInfo' :: (MonadIO m, MonadFail m) => SQLHSTMT -> ReaderT SQLConfig m [ColumnInfo]
collectColumnsInfo' :: SQLINTEGER -> ReaderT SQLConfig m [ColumnInfo]
collectColumnsInfo' hstmt :: SQLINTEGER
hstmt = do
SQLSMALLINT
table_cat_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_table_cat
SQLSMALLINT
table_schem_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_table_schem
SQLSMALLINT
table_name_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_table_name
SQLSMALLINT
column_name_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_column_name
SQLSMALLINT
data_type_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_data_type
SQLSMALLINT
type_name_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_type_name
SQLSMALLINT
column_size_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_column_size
SQLSMALLINT
buffer_length_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_buffer_length
SQLSMALLINT
decimal_digits_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_decimal_digits
SQLSMALLINT
num_prec_radix_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_num_prec_radix
SQLSMALLINT
nullable_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_nullable
SQLSMALLINT
remarks_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_remarks
SQLSMALLINT
column_def_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_column_def
SQLSMALLINT
datetime_code_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_datetime_code
SQLSMALLINT
char_octet_length_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_char_octet_length
SQLSMALLINT
ordinal_position_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_ordinal_position
SQLSMALLINT
is_nullable_fld <- (SQLConfig -> SQLSMALLINT) -> ReaderT SQLConfig m SQLSMALLINT
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks SQLConfig -> SQLSMALLINT
sql_cli_flds_is_nullable
Maybe [ColumnInfo]
cols <- IO (Maybe [ColumnInfo]) -> ReaderT SQLConfig m (Maybe [ColumnInfo])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe [ColumnInfo])
-> ReaderT SQLConfig m (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
-> ReaderT SQLConfig m (Maybe [ColumnInfo])
forall a b. (a -> b) -> a -> b
$
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 129
(\ p_table_cat :: Ptr CChar
p_table_cat ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_table_cat_ind :: Ptr SQLINTEGER
p_table_cat_ind ->
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 129
(\ p_table_schem :: Ptr CChar
p_table_schem ->
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 129
(\ p_table_name :: Ptr CChar
p_table_name ->
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 129
(\ p_column_name :: Ptr CChar
p_column_name ->
(Ptr SQLSMALLINT -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_data_type :: Ptr SQLSMALLINT
p_data_type ->
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 129
(\ p_type_name :: Ptr CChar
p_type_name ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_column_size :: Ptr SQLINTEGER
p_column_size ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_column_size_ind :: Ptr SQLINTEGER
p_column_size_ind ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
( \ p_buffer_length :: Ptr SQLINTEGER
p_buffer_length ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_buffer_length_ind :: Ptr SQLINTEGER
p_buffer_length_ind ->
(Ptr SQLSMALLINT -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_decimal_digits :: Ptr SQLSMALLINT
p_decimal_digits ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_decimal_digits_ind :: Ptr SQLINTEGER
p_decimal_digits_ind ->
(Ptr SQLSMALLINT -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_num_prec_radix :: Ptr SQLSMALLINT
p_num_prec_radix ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_num_prec_radix_ind :: Ptr SQLINTEGER
p_num_prec_radix_ind ->
(Ptr SQLSMALLINT -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_nullable :: Ptr SQLSMALLINT
p_nullable ->
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 255
(\ p_remarks :: Ptr CChar
p_remarks ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_remarks_ind :: Ptr SQLINTEGER
p_remarks_ind ->
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 255
(\ p_column_def :: Ptr CChar
p_column_def ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_column_def_ind :: Ptr SQLINTEGER
p_column_def_ind ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_datetime_code :: Ptr SQLINTEGER
p_datetime_code ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_datetime_code_ind :: Ptr SQLINTEGER
p_datetime_code_ind ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_char_octet_length :: Ptr SQLINTEGER
p_char_octet_length ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_char_octet_length_ind :: Ptr SQLINTEGER
p_char_octet_length_ind ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_ordinal_position :: Ptr SQLINTEGER
p_ordinal_position ->
Int
-> (Ptr CChar -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 255
(\ p_is_nullable :: Ptr CChar
p_is_nullable ->
(Ptr SQLINTEGER -> IO (Maybe [ColumnInfo]))
-> IO (Maybe [ColumnInfo])
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_is_nullable_ind :: Ptr SQLINTEGER
p_is_nullable_ind ->
let readColumnInfo :: [ColumnInfo] -> MaybeT IO [ColumnInfo]
readColumnInfo :: [ColumnInfo] -> MaybeT IO [ColumnInfo]
readColumnInfo cols' :: [ColumnInfo]
cols' = do
ColumnInfo
col <- IO ColumnInfo -> MaybeT IO ColumnInfo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ColumnInfo -> MaybeT IO ColumnInfo)
-> IO ColumnInfo -> MaybeT IO ColumnInfo
forall a b. (a -> b) -> a -> b
$ Maybe String
-> String
-> String
-> String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo
ColumnInfo
(Maybe String
-> String
-> String
-> String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO (Maybe String)
-> IO
(String
-> String
-> String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Ptr CChar -> Ptr SQLINTEGER -> IO (Maybe String)
peekMaybeTextCol Ptr CChar
p_table_cat Ptr SQLINTEGER
p_table_cat_ind)
IO
(String
-> String
-> String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO String
-> IO
(String
-> String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CChar -> IO String
peekCString Ptr CChar
p_table_schem)
IO
(String
-> String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO String
-> IO
(String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CChar -> IO String
peekCString Ptr CChar
p_table_name)
IO
(String
-> SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO String
-> IO
(SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CChar -> IO String
peekCString Ptr CChar
p_column_name)
IO
(SQLSMALLINT
-> String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO SQLSMALLINT
-> IO
(String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_data_type)
IO
(String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO String
-> IO
(Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CChar -> IO String
peekCString Ptr CChar
p_type_name)
IO
(Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO (Maybe SQLINTEGER)
-> IO
(Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLINTEGER -> Ptr SQLINTEGER -> IO (Maybe SQLINTEGER)
forall a. Storable a => Ptr a -> Ptr SQLINTEGER -> IO (Maybe a)
peekMaybeCol Ptr SQLINTEGER
p_column_size Ptr SQLINTEGER
p_column_size_ind)
IO
(Maybe SQLINTEGER
-> Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO (Maybe SQLINTEGER)
-> IO
(Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLINTEGER -> Ptr SQLINTEGER -> IO (Maybe SQLINTEGER)
forall a. Storable a => Ptr a -> Ptr SQLINTEGER -> IO (Maybe a)
peekMaybeCol Ptr SQLINTEGER
p_buffer_length Ptr SQLINTEGER
p_buffer_length_ind)
IO
(Maybe SQLSMALLINT
-> Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO (Maybe SQLSMALLINT)
-> IO
(Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLSMALLINT -> Ptr SQLINTEGER -> IO (Maybe SQLSMALLINT)
forall a. Storable a => Ptr a -> Ptr SQLINTEGER -> IO (Maybe a)
peekMaybeCol Ptr SQLSMALLINT
p_decimal_digits Ptr SQLINTEGER
p_decimal_digits_ind)
IO
(Maybe SQLSMALLINT
-> SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO (Maybe SQLSMALLINT)
-> IO
(SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLSMALLINT -> Ptr SQLINTEGER -> IO (Maybe SQLSMALLINT)
forall a. Storable a => Ptr a -> Ptr SQLINTEGER -> IO (Maybe a)
peekMaybeCol Ptr SQLSMALLINT
p_num_prec_radix Ptr SQLINTEGER
p_num_prec_radix_ind)
IO
(SQLSMALLINT
-> Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO SQLSMALLINT
-> IO
(Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_nullable)
IO
(Maybe String
-> Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO (Maybe String)
-> IO
(Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CChar -> Ptr SQLINTEGER -> IO (Maybe String)
peekMaybeTextCol Ptr CChar
p_remarks Ptr SQLINTEGER
p_remarks_ind)
IO
(Maybe String
-> Maybe SQLINTEGER
-> Maybe SQLINTEGER
-> SQLINTEGER
-> Maybe String
-> ColumnInfo)
-> IO (Maybe String)
-> IO
(Maybe SQLINTEGER
-> Maybe SQLINTEGER -> SQLINTEGER -> Maybe String -> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CChar -> Ptr SQLINTEGER -> IO (Maybe String)
peekMaybeTextCol Ptr CChar
p_column_def Ptr SQLINTEGER
p_column_def_ind)
IO
(Maybe SQLINTEGER
-> Maybe SQLINTEGER -> SQLINTEGER -> Maybe String -> ColumnInfo)
-> IO (Maybe SQLINTEGER)
-> IO
(Maybe SQLINTEGER -> SQLINTEGER -> Maybe String -> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLINTEGER -> Ptr SQLINTEGER -> IO (Maybe SQLINTEGER)
forall a. Storable a => Ptr a -> Ptr SQLINTEGER -> IO (Maybe a)
peekMaybeCol Ptr SQLINTEGER
p_datetime_code Ptr SQLINTEGER
p_datetime_code_ind)
IO (Maybe SQLINTEGER -> SQLINTEGER -> Maybe String -> ColumnInfo)
-> IO (Maybe SQLINTEGER)
-> IO (SQLINTEGER -> Maybe String -> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLINTEGER -> Ptr SQLINTEGER -> IO (Maybe SQLINTEGER)
forall a. Storable a => Ptr a -> Ptr SQLINTEGER -> IO (Maybe a)
peekMaybeCol Ptr SQLINTEGER
p_char_octet_length Ptr SQLINTEGER
p_char_octet_length_ind)
IO (SQLINTEGER -> Maybe String -> ColumnInfo)
-> IO SQLINTEGER -> IO (Maybe String -> ColumnInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
p_ordinal_position)
IO (Maybe String -> ColumnInfo)
-> IO (Maybe String) -> IO ColumnInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Ptr CChar -> Ptr SQLINTEGER -> IO (Maybe String)
peekMaybeTextCol Ptr CChar
p_is_nullable Ptr SQLINTEGER
p_is_nullable_ind)
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLSMALLINT -> SQLSMALLINT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLSMALLINT
p_data_type 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_column_size 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_buffer_length 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLSMALLINT -> SQLSMALLINT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLSMALLINT
p_decimal_digits 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLSMALLINT -> SQLSMALLINT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLSMALLINT
p_num_prec_radix 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLSMALLINT -> SQLSMALLINT -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLSMALLINT
p_nullable 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_datetime_code 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_char_octet_length 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_ordinal_position 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_table_cat_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_column_size_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_buffer_length_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_decimal_digits_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_num_prec_radix_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_remarks_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_column_def_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_datetime_code_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_char_octet_length_ind 0
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_is_nullable_ind 0
[ColumnInfo] -> MaybeT IO [ColumnInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ColumnInfo] -> MaybeT IO [ColumnInfo])
-> [ColumnInfo] -> MaybeT IO [ColumnInfo]
forall a b. (a -> b) -> a -> b
$ ColumnInfo -> [ColumnInfo] -> [ColumnInfo]
forall a. Ord a => a -> [a] -> [a]
insert ColumnInfo
col [ColumnInfo]
cols'
in MaybeT IO [ColumnInfo] -> IO (Maybe [ColumnInfo])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO [ColumnInfo] -> IO (Maybe [ColumnInfo]))
-> MaybeT IO [ColumnInfo] -> IO (Maybe [ColumnInfo])
forall a b. (a -> b) -> a -> b
$ do
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
table_cat_fld Ptr CChar
p_table_cat 129 Ptr SQLINTEGER
p_table_cat_ind
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
table_schem_fld Ptr CChar
p_table_schem 129 Ptr SQLINTEGER
forall a. Ptr a
nullPtr
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
table_name_fld Ptr CChar
p_table_name 129 Ptr SQLINTEGER
forall a. Ptr a
nullPtr
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
column_name_fld Ptr CChar
p_column_name 129 Ptr SQLINTEGER
forall a. Ptr a
nullPtr
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> m ()
bindSmallIntCol SQLINTEGER
hstmt SQLSMALLINT
data_type_fld Ptr SQLSMALLINT
p_data_type Ptr SQLINTEGER
forall a. Ptr a
nullPtr
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
type_name_fld Ptr CChar
p_type_name 129 Ptr SQLINTEGER
forall a. Ptr a
nullPtr
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindIntegerCol SQLINTEGER
hstmt SQLSMALLINT
column_size_fld Ptr SQLINTEGER
p_column_size Ptr SQLINTEGER
p_column_size_ind
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindIntegerCol SQLINTEGER
hstmt SQLSMALLINT
buffer_length_fld Ptr SQLINTEGER
p_buffer_length Ptr SQLINTEGER
p_buffer_length_ind
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> m ()
bindSmallIntCol SQLINTEGER
hstmt SQLSMALLINT
decimal_digits_fld Ptr SQLSMALLINT
p_decimal_digits Ptr SQLINTEGER
p_decimal_digits_ind
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> m ()
bindSmallIntCol SQLINTEGER
hstmt SQLSMALLINT
num_prec_radix_fld Ptr SQLSMALLINT
p_num_prec_radix Ptr SQLINTEGER
p_num_prec_radix_ind
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> m ()
bindSmallIntCol SQLINTEGER
hstmt SQLSMALLINT
nullable_fld Ptr SQLSMALLINT
p_nullable Ptr SQLINTEGER
forall a. Ptr a
nullPtr
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
remarks_fld Ptr CChar
p_remarks 255 Ptr SQLINTEGER
p_remarks_ind
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
column_def_fld Ptr CChar
p_column_def 255 Ptr SQLINTEGER
p_column_def_ind
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindIntegerCol SQLINTEGER
hstmt SQLSMALLINT
datetime_code_fld Ptr SQLINTEGER
p_datetime_code Ptr SQLINTEGER
p_datetime_code_ind
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindIntegerCol SQLINTEGER
hstmt SQLSMALLINT
char_octet_length_fld Ptr SQLINTEGER
p_char_octet_length Ptr SQLINTEGER
p_char_octet_length_ind
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindIntegerCol SQLINTEGER
hstmt SQLSMALLINT
ordinal_position_fld Ptr SQLINTEGER
p_ordinal_position Ptr SQLINTEGER
forall a. Ptr a
nullPtr
SQLINTEGER
-> SQLSMALLINT
-> Ptr CChar
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol SQLINTEGER
hstmt SQLSMALLINT
is_nullable_fld Ptr CChar
p_is_nullable 255 Ptr SQLINTEGER
p_is_nullable_ind
IO () -> MaybeT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> MaybeT IO ()) -> IO () -> MaybeT IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "reading columns info records"
SQLINTEGER
-> ([ColumnInfo] -> MaybeT IO [ColumnInfo])
-> [ColumnInfo]
-> MaybeT IO [ColumnInfo]
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER -> (a -> m a) -> a -> m a
forAllRecords SQLINTEGER
hstmt [ColumnInfo] -> MaybeT IO [ColumnInfo]
readColumnInfo [])))))))))))))))))))))))))))
IO () -> ReaderT SQLConfig m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SQLConfig m ())
-> IO () -> ReaderT SQLConfig m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
freeHandle SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
ReaderT SQLConfig m [ColumnInfo]
-> ([ColumnInfo] -> ReaderT SQLConfig m [ColumnInfo])
-> Maybe [ColumnInfo]
-> ReaderT SQLConfig m [ColumnInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> ReaderT SQLConfig m [ColumnInfo]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "collectColumnsInfo failed") [ColumnInfo] -> ReaderT SQLConfig m [ColumnInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [ColumnInfo]
cols
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ("collectColumnsInfo'" :: Text)
tableExists :: (MonadIO m, MonadFail m) => SQLHDBC
-> String
-> String
-> m Bool
tableExists :: SQLINTEGER -> String -> String -> m Bool
tableExists hdbc :: SQLINTEGER
hdbc schemaName :: String
schemaName tableName :: String
tableName = do
SQLINTEGER
tables_stmt <- SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
allocHandle SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hdbc
SQLINTEGER
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> m ()
tables SQLINTEGER
tables_stmt Maybe String
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
schemaName) (String -> Maybe String
forall a. a -> Maybe a
Just String
tableName) Maybe String
forall a. Maybe a
Nothing
Bool
exists <- SQLINTEGER -> m Bool
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER -> m Bool
fetch SQLINTEGER
tables_stmt
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
freeHandle SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
tables_stmt
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
endTran :: (MonadIO m, MonadFail m) =>
SQLSMALLINT
-> SQLHANDLE
-> SQLSMALLINT
-> m ()
endTran :: SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> m ()
endTran handleType :: SQLSMALLINT
handleType handle :: SQLINTEGER
handle completion :: SQLSMALLINT
completion = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> IO SQLSMALLINT
sqlendtran SQLSMALLINT
handleType SQLINTEGER
handle SQLSMALLINT
completion
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "call to SQL/CLI function EndTran failed, on handle type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
handleType SQLINTEGER
handle
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "call to SQL/CLI function EndTran generated warnings for handle type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
handleType SQLINTEGER
handle
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle was given to a call to the SQL/CLI function EndTran, for handle type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unexpected result was returned by a call to SQL/CLI function EndTran for handleType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
handleType SQLINTEGER
handle
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "endTran"
setConnectAttr :: (MonadIO m, MonadFail m) => SQLHDBC -> SQLINTEGER -> SQLPOINTER -> SQLINTEGER -> m ()
setConnectAttr :: SQLINTEGER -> SQLINTEGER -> SQLPOINTER -> SQLINTEGER -> m ()
setConnectAttr hdbc :: SQLINTEGER
hdbc attribute :: SQLINTEGER
attribute value :: SQLPOINTER
value stringLen :: SQLINTEGER
stringLen = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLINTEGER -> SQLPOINTER -> SQLINTEGER -> IO SQLSMALLINT
sqlsetconnectattr SQLINTEGER
hdbc SQLINTEGER
attribute SQLPOINTER
value SQLINTEGER
stringLen
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "call to SQL/CLI function SetConnectAttr failed for attribute: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "call to SQL/CLI function SetConnectAttr returned warnings for attribute " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle given to SQL/CLI function SetConnectAtr when setting attribute: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unknown result returned by the call of SQL/CLI function SetConnectAttr for attribute " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "setConnectAttr"
setDescField :: (MonadIO m, MonadFail m) => SQLHDESC
-> SQLSMALLINT
-> SQLSMALLINT
-> Ptr a
-> SQLINTEGER
-> m ()
setDescField :: SQLINTEGER
-> SQLSMALLINT -> SQLSMALLINT -> Ptr a -> SQLINTEGER -> m ()
setDescField hdesc :: SQLINTEGER
hdesc recno :: SQLSMALLINT
recno field :: SQLSMALLINT
field pbuf :: Ptr a
pbuf buflen :: SQLINTEGER
buflen = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> IO SQLSMALLINT
sqlsetdescfield SQLINTEGER
hdesc SQLSMALLINT
recno SQLSMALLINT
field (Ptr a -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr a
pbuf) SQLINTEGER
buflen
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "call to SQL/CLI function SetDescField failed, for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "call to SQL/CLI function SetDescField for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " generated warnings"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle was given to a call to SQL/CLI function SetDescField for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unexpected result code was returned by the call to SQL/CLI function SetDescField for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "setDescField"
getDescField :: (MonadIO m, MonadFail m) => SQLHDESC
-> SQLSMALLINT
-> SQLSMALLINT
-> Ptr a
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
getDescField :: SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> Ptr a
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
getDescField hdesc :: SQLINTEGER
hdesc recno :: SQLSMALLINT
recno field :: SQLSMALLINT
field pbuf :: Ptr a
pbuf buflen :: SQLINTEGER
buflen plen :: Ptr SQLINTEGER
plen = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> IO SQLSMALLINT
sqlgetdescfield SQLINTEGER
hdesc SQLSMALLINT
recno SQLSMALLINT
field (Ptr a -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr a
pbuf) SQLINTEGER
buflen Ptr SQLINTEGER
plen
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "call to SQL/CLI function GetDescField failed for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "call to SQL/CLI function for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " generated warnings"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle was given to the call of getDescField for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unexpected result code returned by the call to SQL/CLI function GetDescField for record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ", field " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
field) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "getDescField"
setDescRec :: (MonadIO m, MonadFail m) => SQLHDESC
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> Ptr a
-> Ptr SQLLEN
-> Ptr SQLLEN
-> m ()
setDescRec :: SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> Ptr a
-> Ptr SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
setDescRec hdesc :: SQLINTEGER
hdesc recno :: SQLSMALLINT
recno coltype :: SQLSMALLINT
coltype subtype :: SQLSMALLINT
subtype len :: SQLINTEGER
len precision :: SQLSMALLINT
precision scale :: SQLSMALLINT
scale p_data :: Ptr a
p_data p_stringlength :: Ptr SQLINTEGER
p_stringlength p_indicator :: Ptr SQLINTEGER
p_indicator = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> Ptr SQLINTEGER
-> Ptr SQLINTEGER
-> IO SQLSMALLINT
sqlsetdescrec SQLINTEGER
hdesc SQLSMALLINT
recno SQLSMALLINT
coltype SQLSMALLINT
subtype SQLINTEGER
len SQLSMALLINT
precision SQLSMALLINT
scale (Ptr a -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p_data) Ptr SQLINTEGER
p_stringlength Ptr SQLINTEGER
p_indicator
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "call to SQL/CLI function SetDescRec failed for record number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "call to SQL/CLI function SetDescRec generated warnings for record number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle was given to the call of SQL/CLI function SetDescRec for record number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unexpected result code (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") returned by the call to SQL/CLI function SetDescRec for record number " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "setDescRec"
getDescRec :: (MonadIO m, MonadFail m) => SQLHDESC
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLLEN
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> m ()
getDescRec :: SQLINTEGER
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLINTEGER
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> m ()
getDescRec hdesc :: SQLINTEGER
hdesc recno :: SQLSMALLINT
recno p_colname :: Ptr SQLCHAR
p_colname buflen :: SQLSMALLINT
buflen p_namelen :: Ptr SQLSMALLINT
p_namelen p_type :: Ptr SQLSMALLINT
p_type p_subtype :: Ptr SQLSMALLINT
p_subtype p_length :: Ptr SQLINTEGER
p_length p_precision :: Ptr SQLSMALLINT
p_precision p_scale :: Ptr SQLSMALLINT
p_scale p_nullable :: Ptr SQLSMALLINT
p_nullable = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLINTEGER
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> IO SQLSMALLINT
sqlgetdescrec SQLINTEGER
hdesc SQLSMALLINT
recno Ptr SQLCHAR
p_colname SQLSMALLINT
buflen Ptr SQLSMALLINT
p_namelen Ptr SQLSMALLINT
p_type Ptr SQLSMALLINT
p_subtype Ptr SQLINTEGER
p_length Ptr SQLSMALLINT
p_precision Ptr SQLSMALLINT
p_scale Ptr SQLSMALLINT
p_nullable
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "call to SQL/CLI function GetDescRec failed"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
let err :: String
err = "call to SQL/CLI function GetDescRec returned warnings"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_desc SQLINTEGER
hdesc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle was given to the call of SQL/CLI functiion GetDescRec"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
let err :: String
err = "(GetDescRec) there is no record in the descriptor for this record number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recno)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unexpected result code was returned by the call to SQL/CLI function GetDescRec: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "getDescRec"
numResultCols :: (MonadIO m, MonadFail m) => SQLHSTMT -> m SQLSMALLINT
numResultCols :: SQLINTEGER -> m SQLSMALLINT
numResultCols hstmt :: SQLINTEGER
hstmt = do
Maybe SQLSMALLINT
cols <- IO (Maybe SQLSMALLINT) -> m (Maybe SQLSMALLINT)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SQLSMALLINT) -> m (Maybe SQLSMALLINT))
-> IO (Maybe SQLSMALLINT) -> m (Maybe SQLSMALLINT)
forall a b. (a -> b) -> a -> b
$ (Ptr SQLSMALLINT -> IO (Maybe SQLSMALLINT))
-> IO (Maybe SQLSMALLINT)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_cols :: Ptr SQLSMALLINT
p_cols -> do
SQLSMALLINT
result <- SQLINTEGER -> Ptr SQLSMALLINT -> IO SQLSMALLINT
sqlnumresultcols SQLINTEGER
hstmt Ptr SQLSMALLINT
p_cols
let cols :: IO (Maybe SQLSMALLINT)
cols = SQLSMALLINT -> Maybe SQLSMALLINT
forall a. a -> Maybe a
Just (SQLSMALLINT -> Maybe SQLSMALLINT)
-> IO SQLSMALLINT -> IO (Maybe SQLSMALLINT)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_cols
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> IO (Maybe SQLSMALLINT)
cols
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "call to SQL/CLI function NumResultCols failed"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
Maybe SQLSMALLINT -> IO (Maybe SQLSMALLINT)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLSMALLINT
forall a. Maybe a
Nothing
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "call to SQL/CLI function NumResultColss returned warnings"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
IO (Maybe SQLSMALLINT)
cols
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "invalid handle given to call to SQL/CLI function NumResultCols"
Maybe SQLSMALLINT -> IO (Maybe SQLSMALLINT)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLSMALLINT
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "unexpected value returned by a call to NumResultCols: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
Maybe SQLSMALLINT -> IO (Maybe SQLSMALLINT)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLSMALLINT
forall a. Maybe a
Nothing )
m SQLSMALLINT
-> (SQLSMALLINT -> m SQLSMALLINT)
-> Maybe SQLSMALLINT
-> m SQLSMALLINT
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m SQLSMALLINT
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "numResultCols failed") SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLSMALLINT
cols
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "numResultCols"
getStorableStmtAttr :: (MonadIO m, MonadFail m, Storable a) => SQLHSTMT -> SQLINTEGER -> m a
getStorableStmtAttr :: SQLINTEGER -> SQLINTEGER -> m a
getStorableStmtAttr hstmt :: SQLINTEGER
hstmt attr :: SQLINTEGER
attr = do
Maybe a
value <- IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe a) -> m (Maybe a)) -> IO (Maybe a) -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ (Ptr a -> IO (Maybe a)) -> IO (Maybe a)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_value :: Ptr a
p_value -> MaybeT IO a -> IO (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO a -> IO (Maybe a)) -> MaybeT IO a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
SQLINTEGER
-> SQLINTEGER
-> Ptr a
-> SQLINTEGER
-> Ptr SQLINTEGER
-> MaybeT IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLINTEGER -> Ptr a -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
getStmtAttr SQLINTEGER
hstmt SQLINTEGER
attr Ptr a
p_value 0 Ptr SQLINTEGER
forall a. Ptr a
nullPtr
IO a -> MaybeT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> MaybeT IO a) -> IO a -> MaybeT IO a
forall a b. (a -> b) -> a -> b
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p_value)
m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ "failed to get the statement's attribute value for attribute: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attr)) a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
value
getStmtAttr :: (MonadIO m, MonadFail m) => SQLHSTMT
-> SQLINTEGER
-> Ptr a
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
getStmtAttr :: SQLINTEGER
-> SQLINTEGER -> Ptr a -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
getStmtAttr hstmt :: SQLINTEGER
hstmt attribute :: SQLINTEGER
attribute p_buf :: Ptr a
p_buf buflen :: SQLINTEGER
buflen p_vallen :: Ptr SQLINTEGER
p_vallen = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLINTEGER
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> IO SQLSMALLINT
sqlgetstmtattr SQLINTEGER
hstmt SQLINTEGER
attribute (Ptr a -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p_buf) SQLINTEGER
buflen Ptr SQLINTEGER
p_vallen
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "error calling SQL/CLI function 'GetStmtAttr' for attribute " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "getting statement attribute " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " returned warnings"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle was given to a call to SQL/CLI function GetStmtAttr for attribute " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unexpected result returned by a call to SQL/CLI function GetStmtAttr for attribute " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
attribute)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "getStmtAttr"
bindParam :: (MonadIO m, MonadFail m) => SQLHSTMT
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLULEN
-> SQLSMALLINT
-> Ptr a
-> Ptr SQLLEN
-> m ()
bindParam :: SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLULEN
-> SQLSMALLINT
-> Ptr a
-> Ptr SQLINTEGER
-> m ()
bindParam hstmt :: SQLINTEGER
hstmt paramno :: SQLSMALLINT
paramno valtype :: SQLSMALLINT
valtype paramtype :: SQLSMALLINT
paramtype paramlenprec :: SQLULEN
paramlenprec paramscale :: SQLSMALLINT
paramscale p_value :: Ptr a
p_value p_strlen_or_ind :: Ptr SQLINTEGER
p_strlen_or_ind = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLULEN
-> SQLSMALLINT
-> SQLPOINTER
-> Ptr SQLINTEGER
-> IO SQLSMALLINT
sqlbindparam SQLINTEGER
hstmt SQLSMALLINT
paramno SQLSMALLINT
valtype SQLSMALLINT
paramtype SQLULEN
paramlenprec SQLSMALLINT
paramscale (Ptr a -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p_value) Ptr SQLINTEGER
p_strlen_or_ind
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "Error binding parameter " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
paramno)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "binding parameter " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
paramno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " returned with warnings"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "biniding parameter " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
paramno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " was invoked with an invalid statement handler"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "binding parameter " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
paramno) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " returned unexepcted result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "bindParam"
putData :: (MonadIO m, MonadFail m) => SQLHSTMT -> Ptr a -> SQLLEN -> m ()
putData :: SQLINTEGER -> Ptr a -> SQLINTEGER -> m ()
putData hstmt :: SQLINTEGER
hstmt p_buf :: Ptr a
p_buf len :: SQLINTEGER
len = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER -> SQLPOINTER -> SQLINTEGER -> IO SQLSMALLINT
sqlputdata SQLINTEGER
hstmt (Ptr a -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr a
p_buf) SQLINTEGER
len
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "error in the call of SQL/CLI function PutData"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "call to SQL/CLI function PutData returned warnings"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "an invalid handle was used when calling putData"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "call to SQL/CLI function PutData returned unexpected result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "putData"
paramData :: (MonadIO m, MonadFail m) => SQLHSTMT -> (SQLPOINTER -> m ()) -> m ()
paramData :: SQLINTEGER -> (SQLPOINTER -> m ()) -> m ()
paramData hstmt :: SQLINTEGER
hstmt f :: SQLPOINTER -> m ()
f = do
(result :: SQLSMALLINT
result, value :: SQLPOINTER
value) <- IO (SQLSMALLINT, SQLPOINTER) -> m (SQLSMALLINT, SQLPOINTER)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SQLSMALLINT, SQLPOINTER) -> m (SQLSMALLINT, SQLPOINTER))
-> IO (SQLSMALLINT, SQLPOINTER) -> m (SQLSMALLINT, SQLPOINTER)
forall a b. (a -> b) -> a -> b
$ (Ptr SQLPOINTER -> IO (SQLSMALLINT, SQLPOINTER))
-> IO (SQLSMALLINT, SQLPOINTER)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca (\ p_value :: Ptr SQLPOINTER
p_value -> do
SQLSMALLINT
result' <- SQLINTEGER -> Ptr SQLPOINTER -> IO SQLSMALLINT
sqlparamdata SQLINTEGER
hstmt Ptr SQLPOINTER
p_value
SQLPOINTER
value' <- Ptr SQLPOINTER -> IO SQLPOINTER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLPOINTER
p_value
(SQLSMALLINT, SQLPOINTER) -> IO (SQLSMALLINT, SQLPOINTER)
forall (m :: * -> *) a. Monad m => a -> m a
return (SQLSMALLINT
result', SQLPOINTER
value'))
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_need_data -> do
SQLPOINTER -> m ()
f SQLPOINTER
value
SQLINTEGER -> (SQLPOINTER -> m ()) -> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER -> (SQLPOINTER -> m ()) -> m ()
paramData SQLINTEGER
hstmt SQLPOINTER -> m ()
f
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "call to SQL/CLI function ParamData failed"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "(ParamData) statement executed but generated warnings"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "ParamData: statement executed but returned no_data"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "invalid handle has been given to paramData"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "unexpected result returned by a call to SQL/CLI function ParamData: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "paramData"
prepare :: (MonadIO m, MonadFail m) => SQLHSTMT -> String -> m ()
prepare :: SQLINTEGER -> String -> m ()
prepare hstmt :: SQLINTEGER
hstmt sql :: String
sql = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
sql
(\ (p_sql :: Ptr CChar
p_sql, len_sql :: Int
len_sql) -> SQLINTEGER -> Ptr SQLCHAR -> SQLINTEGER -> IO SQLSMALLINT
sqlprepare SQLINTEGER
hstmt (Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_sql) (Int -> SQLINTEGER
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len_sql))
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "Failed preparing statement: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sql
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Statement prepared but warnings were returned: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sql
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "Failed preparing statement because an invalid handle was given to 'prepare' call: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sql
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| Bool
otherwise -> do
let err :: String
err = "Unexpected returned code (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ") was returned by 'sqlprepare' call when preparing statement: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
sql
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "prepare"
execute :: (MonadIO m, MonadFail m) => SQLHSTMT -> m () -> m ()
execute :: SQLINTEGER -> m () -> m ()
execute hstmt :: SQLINTEGER
hstmt feeddata :: m ()
feeddata = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER -> IO SQLSMALLINT
sqlexecute SQLINTEGER
hstmt
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "'Execute' API call succeded but returned more info"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
let err :: String
err = "'Execute' API call failed"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
let err :: String
err = "'Execute' has been called with invalid statement handle"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "'Execute' returned SQL_NO_DATA"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_need_data -> do
m ()
feeddata
| Bool
otherwise -> do
let err :: String
err = "'Execute' call returned unexpected result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString String
err
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "execute"
data ConciseColInfo = ConciseColInfo {
ConciseColInfo -> String
cci_ColumnName :: String,
ConciseColInfo -> SQLSMALLINT
cci_DataType :: SQLSMALLINT,
ConciseColInfo -> SQLULEN
cci_ColumnSize :: SQLULEN,
ConciseColInfo -> SQLSMALLINT
cci_DecimalDigits :: SQLSMALLINT,
ConciseColInfo -> Bool
cci_Nullable :: Bool }
describeCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> m ConciseColInfo
describeCol :: SQLINTEGER -> SQLSMALLINT -> m ConciseColInfo
describeCol hstmt :: SQLINTEGER
hstmt colnum :: SQLSMALLINT
colnum = do
Maybe ConciseColInfo
info <- IO (Maybe ConciseColInfo) -> m (Maybe ConciseColInfo)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ConciseColInfo) -> m (Maybe ConciseColInfo))
-> IO (Maybe ConciseColInfo) -> m (Maybe ConciseColInfo)
forall a b. (a -> b) -> a -> b
$ Int
-> (Ptr SQLCHAR -> IO (Maybe ConciseColInfo))
-> IO (Maybe ConciseColInfo)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 255
(\ p_columnName :: Ptr SQLCHAR
p_columnName ->
(Ptr SQLSMALLINT -> IO (Maybe ConciseColInfo))
-> IO (Maybe ConciseColInfo)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_nameLength :: Ptr SQLSMALLINT
p_nameLength ->
(Ptr SQLSMALLINT -> IO (Maybe ConciseColInfo))
-> IO (Maybe ConciseColInfo)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_dataType :: Ptr SQLSMALLINT
p_dataType ->
(Ptr SQLULEN -> IO (Maybe ConciseColInfo))
-> IO (Maybe ConciseColInfo)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_columnSize :: Ptr SQLULEN
p_columnSize ->
(Ptr SQLSMALLINT -> IO (Maybe ConciseColInfo))
-> IO (Maybe ConciseColInfo)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_decimalDigits :: Ptr SQLSMALLINT
p_decimalDigits ->
(Ptr SQLSMALLINT -> IO (Maybe ConciseColInfo))
-> IO (Maybe ConciseColInfo)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ p_nullable :: Ptr SQLSMALLINT
p_nullable -> do
SQLSMALLINT
result <- SQLINTEGER
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLULEN
-> Ptr SQLSMALLINT
-> Ptr SQLSMALLINT
-> IO SQLSMALLINT
sqldescribecol SQLINTEGER
hstmt SQLSMALLINT
colnum Ptr SQLCHAR
p_columnName 255 Ptr SQLSMALLINT
p_nameLength Ptr SQLSMALLINT
p_dataType Ptr SQLULEN
p_columnSize Ptr SQLSMALLINT
p_decimalDigits Ptr SQLSMALLINT
p_nullable
let readInfo :: IO (Maybe ConciseColInfo)
readInfo = ConciseColInfo -> Maybe ConciseColInfo
forall a. a -> Maybe a
Just (ConciseColInfo -> Maybe ConciseColInfo)
-> IO ConciseColInfo -> IO (Maybe ConciseColInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
SQLSMALLINT
nameLength <- Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_nameLength
SQLSMALLINT
nullable <- Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_nullable
String
-> SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> Bool -> ConciseColInfo
ConciseColInfo
(String
-> SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> Bool -> ConciseColInfo)
-> IO String
-> IO
(SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> Bool -> ConciseColInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CStringLen -> IO String
peekCStringLen (Ptr SQLCHAR -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr SQLCHAR
p_columnName, SQLSMALLINT -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral SQLSMALLINT
nameLength)
IO
(SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> Bool -> ConciseColInfo)
-> IO SQLSMALLINT
-> IO (SQLULEN -> SQLSMALLINT -> Bool -> ConciseColInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_dataType
IO (SQLULEN -> SQLSMALLINT -> Bool -> ConciseColInfo)
-> IO SQLULEN -> IO (SQLSMALLINT -> Bool -> ConciseColInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr SQLULEN -> IO SQLULEN
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLULEN
p_columnSize
IO (SQLSMALLINT -> Bool -> ConciseColInfo)
-> IO SQLSMALLINT -> IO (Bool -> ConciseColInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_decimalDigits
IO (Bool -> ConciseColInfo) -> IO Bool -> IO ConciseColInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ if SQLSMALLINT
nullable SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
forall a. Num a => a
sql_no_nulls then Bool
False else Bool
True)
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> IO (Maybe ConciseColInfo)
readInfo
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "More information returned by DescribeCol"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
IO (Maybe ConciseColInfo)
readInfo
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Error calling DescribeCol"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
Maybe ConciseColInfo -> IO (Maybe ConciseColInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConciseColInfo
forall a. Maybe a
Nothing
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Invalid handle calling DescribeCol"
Maybe ConciseColInfo -> IO (Maybe ConciseColInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConciseColInfo
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Unexpected result returned by the call to DescribeCol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
Maybe ConciseColInfo -> IO (Maybe ConciseColInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConciseColInfo
forall a. Maybe a
Nothing))))))
m ConciseColInfo
-> (ConciseColInfo -> m ConciseColInfo)
-> Maybe ConciseColInfo
-> m ConciseColInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m ConciseColInfo
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ConciseColInfo) -> String -> m ConciseColInfo
forall a b. (a -> b) -> a -> b
$ "describeCol " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
colnum) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " failed") ConciseColInfo -> m ConciseColInfo
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConciseColInfo
info
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "describe col"
columns :: (MonadIO m, MonadFail m) => SQLHSTMT -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> m ()
columns :: SQLINTEGER
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> m ()
columns hstmt :: SQLINTEGER
hstmt catalogName :: Maybe String
catalogName schemaName :: Maybe String
schemaName tableName :: Maybe String
tableName columnName :: Maybe String
columnName = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
catalogName
(\ (p_catalogName :: Ptr CChar
p_catalogName, catalogNameLen :: Int
catalogNameLen) ->
Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
schemaName
(\ (p_schemaName :: Ptr CChar
p_schemaName, schemaNameLen :: Int
schemaNameLen) ->
Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
tableName
(\ (p_tableName :: Ptr CChar
p_tableName, tableNameLen :: Int
tableNameLen) ->
Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
columnName
(\ (p_columnName :: Ptr CChar
p_columnName, columnNameLen :: Int
columnNameLen) ->
SQLINTEGER
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> IO SQLSMALLINT
sqlcolumns SQLINTEGER
hstmt
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_catalogName) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
catalogNameLen)
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_schemaName) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
schemaNameLen)
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_tableName) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tableNameLen)
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_columnName) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
columnNameLen)))))
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Error calling Columns"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Columns failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Columns returned more info"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Invalid statement handle passed to Columns call"
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Columns failed"
| Bool
otherwise -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Unexpected return code returned by call to Columns. Trying to display diagnostic info:"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Columns failed"
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "columns"
tables :: (MonadIO m, MonadFail m) => SQLHSTMT -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> m ()
tables :: SQLINTEGER
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> m ()
tables hstmt :: SQLINTEGER
hstmt catalogName :: Maybe String
catalogName schemaName :: Maybe String
schemaName tableName :: Maybe String
tableName tableType :: Maybe String
tableType = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$
Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
catalogName
(\ (p_catalogName :: Ptr CChar
p_catalogName, catalogNameLen :: Int
catalogNameLen) ->
Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
schemaName
( \ (p_schemaName :: Ptr CChar
p_schemaName, schemaNameLen :: Int
schemaNameLen) ->
Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
tableName
( \ (p_tableName :: Ptr CChar
p_tableName, tableNameLen :: Int
tableNameLen) ->
Maybe String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Maybe String
tableType
( \ (p_tableType :: Ptr CChar
p_tableType, tableTypeLen :: Int
tableTypeLen) ->
SQLINTEGER
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> IO SQLSMALLINT
sqltables SQLINTEGER
hstmt
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_catalogName) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
catalogNameLen)
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_schemaName) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
schemaNameLen)
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_tableName) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tableNameLen)
(Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_tableType) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
tableTypeLen)))))
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Error calling Tables"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Tables failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Tables returned more info"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Invalid handle calling Tables"
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Tables failed"
| Bool
otherwise -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Tables returned unexpected result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Tables failed"
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "tables"
forAllRecords :: (MonadIO m, MonadFail m) => SQLHSTMT -> (a -> m a) -> a -> m a
forAllRecords :: SQLINTEGER -> (a -> m a) -> a -> m a
forAllRecords stmt :: SQLINTEGER
stmt f :: a -> m a
f = SQLINTEGER
-> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a
forAllRecordsWithEndAndFail SQLINTEGER
stmt a -> m a
f a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> m a) -> a -> String -> m a
forall a b. a -> b -> a
const String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail)
forAllRecordsWithEndAndFail :: (MonadIO m, MonadFail m) => SQLHSTMT -> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a
forAllRecordsWithEndAndFail :: SQLINTEGER
-> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a
forAllRecordsWithEndAndFail stmt :: SQLINTEGER
stmt onRecord :: a -> m a
onRecord onEnd :: a -> m a
onEnd onFail :: a -> String -> m a
onFail accum :: a
accum = SQLINTEGER -> m a -> m a -> (String -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER -> m a -> m a -> (String -> m a) -> m a
fetchAndRunWithFail SQLINTEGER
stmt (a -> m a
onRecord a
accum m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\ accum' :: a
accum' -> SQLINTEGER
-> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a
forAllRecordsWithEndAndFail SQLINTEGER
stmt a -> m a
onRecord a -> m a
onEnd a -> String -> m a
onFail a
accum')) (a -> m a
onEnd a
accum) (a -> String -> m a
onFail a
accum)
forAllData :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> (a -> m a) -> a -> m a
forAllData :: SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> (a -> m a)
-> a
-> m a
forAllData hstmt :: SQLINTEGER
hstmt colNum :: SQLSMALLINT
colNum targetType :: SQLSMALLINT
targetType p_buf :: SQLPOINTER
p_buf bufLen :: SQLINTEGER
bufLen p_lenOrInd :: Ptr SQLINTEGER
p_lenOrInd f :: a -> m a
f accum :: a
accum =
SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m a
-> m a
-> m a
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m a
-> m a
-> m a
getDataAndRun SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
targetType SQLPOINTER
p_buf SQLINTEGER
bufLen Ptr SQLINTEGER
p_lenOrInd
(a -> m a
f a
accum m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\ accum' :: a
accum' -> SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> (a -> m a)
-> a
-> m a
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> (a -> m a)
-> a
-> m a
forAllData SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
targetType SQLPOINTER
p_buf SQLINTEGER
bufLen Ptr SQLINTEGER
p_lenOrInd a -> m a
f a
accum'))
(a -> m a
f a
accum)
getData :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m Bool
getData :: SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m Bool
getData hstmt :: SQLINTEGER
hstmt colNum :: SQLSMALLINT
colNum targetType :: SQLSMALLINT
targetType p_buf :: SQLPOINTER
p_buf bufLen :: SQLINTEGER
bufLen p_lenOrInd :: Ptr SQLINTEGER
p_lenOrInd = SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m Bool
-> m Bool
-> m Bool
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m a
-> m a
-> m a
getDataAndRun SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
targetType SQLPOINTER
p_buf SQLINTEGER
bufLen Ptr SQLINTEGER
p_lenOrInd (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
getDataAndRun :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m a -> m a -> m a
getDataAndRun :: SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m a
-> m a
-> m a
getDataAndRun hstmt :: SQLINTEGER
hstmt colNum :: SQLSMALLINT
colNum targetType :: SQLSMALLINT
targetType p_buf :: SQLPOINTER
p_buf bufLen :: SQLINTEGER
bufLen p_lenOrInd :: Ptr SQLINTEGER
p_lenOrInd more :: m a
more end :: m a
end = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> IO SQLSMALLINT
sqlgetdata SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
targetType SQLPOINTER
p_buf SQLINTEGER
bufLen Ptr SQLINTEGER
p_lenOrInd
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> m a
end
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Invalid handle when calling GetData"
String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GetData failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Error calling GetData"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GetData failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "GetData -> no data available"
String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GetData failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
Bool
moreData <- m Bool
forall (m :: * -> *). (MonadIO m, MonadFail m) => m Bool
isMoreData
SQLINTEGER
lenOrInd <- IO SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLINTEGER -> m SQLINTEGER) -> IO SQLINTEGER -> m SQLINTEGER
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
p_lenOrInd
if Bool
moreData
then if SQLINTEGER
lenOrInd SQLINTEGER -> SQLINTEGER -> Bool
forall a. Eq a => a -> a -> Bool
== SQLINTEGER
forall a. Num a => a
sql_null_data Bool -> Bool -> Bool
|| SQLINTEGER
lenOrInd SQLINTEGER -> SQLINTEGER -> Bool
forall a. Ord a => a -> a -> Bool
<= SQLINTEGER
bufLen
then do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "GetData returned 01004, but no more data is available"
m a
end
else m a
more
else do
if SQLINTEGER
lenOrInd SQLINTEGER -> SQLINTEGER -> Bool
forall a. Eq a => a -> a -> Bool
== SQLINTEGER
forall a. Num a => a
sql_null_data Bool -> Bool -> Bool
|| SQLINTEGER
lenOrInd SQLINTEGER -> SQLINTEGER -> Bool
forall a. Ord a => a -> a -> Bool
<= SQLINTEGER
bufLen
then m a
end
else do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "More data but no 01004 diagnostic record found"
m a
more
| Bool
otherwise -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "GetData returned unexpected result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GetData failed"
where isMoreData :: (MonadIO m, MonadFail m) => m Bool
isMoreData :: m Bool
isMoreData = do
SQLINTEGER
recs <- SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
getCountOfDiagRecs SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
if SQLINTEGER
recs SQLINTEGER -> SQLINTEGER -> Bool
forall a. Ord a => a -> a -> Bool
< 0
then do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "GetData - wrong diag info records: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
recs)
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do let diags :: [MaybeT IO DiagRecord]
diags = [SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> MaybeT IO DiagRecord
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> m DiagRecord
getDiagRec SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt (SQLINTEGER -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral SQLINTEGER
i) | SQLINTEGER
i <- [1..SQLINTEGER
recs]]
Maybe Bool
isMoreData' <- IO (Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bool) -> m (Maybe Bool))
-> IO (Maybe Bool) -> m (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ MaybeT IO Bool -> IO (Maybe Bool)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO Bool -> IO (Maybe Bool))
-> MaybeT IO Bool -> IO (Maybe Bool)
forall a b. (a -> b) -> a -> b
$
let hasMoreDataRecord :: [m DiagRecord] -> m Bool
hasMoreDataRecord [] = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
hasMoreDataRecord (x :: m DiagRecord
x:xs :: [m DiagRecord]
xs) = do
DiagRecord
drec <- m DiagRecord
x
if DiagRecord -> String
sqlstate DiagRecord
drec String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "01004"
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else do IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "GetData warning: <" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (ShowS
forall a. Show a => a -> String
show ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ DiagRecord -> String
sqlstate DiagRecord
drec) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ">"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DiagRecord -> IO ()
displayDiagRec DiagRecord
drec
[m DiagRecord] -> m Bool
hasMoreDataRecord [m DiagRecord]
xs
in
[MaybeT IO DiagRecord] -> MaybeT IO Bool
forall (m :: * -> *). MonadIO m => [m DiagRecord] -> m Bool
hasMoreDataRecord [MaybeT IO DiagRecord]
diags
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
forall a. a -> a
id Maybe Bool
isMoreData'
logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "getDataAndRun"
fetch :: (MonadIO m, MonadFail m) => SQLHSTMT -> m Bool
fetch :: SQLINTEGER -> m Bool
fetch hstmt :: SQLINTEGER
hstmt = SQLINTEGER -> m Bool -> m Bool -> m Bool
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER -> m a -> m a -> m a
fetchAndRun SQLINTEGER
hstmt (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True) (Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
fetchAndRun :: (MonadIO m, MonadFail m) => SQLHSTMT -> m a -> m a -> m a
fetchAndRun :: SQLINTEGER -> m a -> m a -> m a
fetchAndRun hstmt :: SQLINTEGER
hstmt fetchaction :: m a
fetchaction endaction :: m a
endaction = SQLINTEGER -> m a -> m a -> (String -> m a) -> m a
forall (m :: * -> *) a.
(MonadIO m, MonadFail m) =>
SQLINTEGER -> m a -> m a -> (String -> m a) -> m a
fetchAndRunWithFail SQLINTEGER
hstmt m a
fetchaction m a
endaction String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
fetchAndRunWithFail :: (MonadIO m, MonadFail m) => SQLHSTMT -> m a -> m a -> (String -> m a) -> m a
fetchAndRunWithFail :: SQLINTEGER -> m a -> m a -> (String -> m a) -> m a
fetchAndRunWithFail hstmt :: SQLINTEGER
hstmt fetchedaction :: m a
fetchedaction endaction :: m a
endaction failaction :: String -> m a
failaction = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER -> IO SQLSMALLINT
sqlfetch SQLINTEGER
hstmt
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> m a
fetchedaction
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Error fetching record"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m a
failaction "Fetch failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Invalid handle when fetching record"
String -> m a
failaction "Fetch failed due to invalid handle"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "All records have been fetched"
m a
endaction
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "More diagnostic info returned for record"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
m a
fetchedaction
| Bool
otherwise -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Fetch returned unexepected result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m a
failaction "Fetch failed"
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "fetchAndRunWithFail"
bindSmallIntCol :: (MonadIO m, MonadFail m) =>
SQLHSTMT
-> SQLSMALLINT
-> Ptr SQLSMALLINT
-> Ptr SQLLEN
-> m ()
bindSmallIntCol :: SQLINTEGER
-> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLINTEGER -> m ()
bindSmallIntCol hstmt :: SQLINTEGER
hstmt colNum :: SQLSMALLINT
colNum p_buf :: Ptr SQLSMALLINT
p_buf p_ind :: Ptr SQLINTEGER
p_ind = SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
bindCol SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
forall a. Num a => a
sql_smallint (Ptr SQLSMALLINT -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr SQLSMALLINT
p_buf) (Int -> SQLINTEGER
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SQLINTEGER) -> Int -> SQLINTEGER
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> Int
forall a. Storable a => a -> Int
sizeOf (SQLSMALLINT
forall a. HasCallStack => a
undefined :: SQLSMALLINT)) Ptr SQLINTEGER
p_ind
bindIntegerCol :: (MonadIO m, MonadFail m) =>
SQLHSTMT
-> SQLSMALLINT
-> Ptr SQLINTEGER
-> Ptr SQLLEN
-> m ()
bindIntegerCol :: SQLINTEGER
-> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindIntegerCol hstmt :: SQLINTEGER
hstmt colNum :: SQLSMALLINT
colNum p_buf :: Ptr SQLINTEGER
p_buf p_ind :: Ptr SQLINTEGER
p_ind = SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
bindCol SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
forall a. Num a => a
sql_integer (Ptr SQLINTEGER -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr SQLINTEGER
p_buf) (Int -> SQLINTEGER
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> SQLINTEGER) -> Int -> SQLINTEGER
forall a b. (a -> b) -> a -> b
$ SQLINTEGER -> Int
forall a. Storable a => a -> Int
sizeOf (SQLINTEGER
forall a. HasCallStack => a
undefined :: SQLINTEGER)) Ptr SQLINTEGER
p_ind
bindVarcharCol :: (MonadIO m, MonadFail m) =>
SQLHSTMT
-> SQLSMALLINT
-> CString
-> SQLLEN
-> Ptr SQLLEN
-> m ()
bindVarcharCol :: SQLINTEGER
-> SQLSMALLINT -> Ptr CChar -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
bindVarcharCol hstmt :: SQLINTEGER
hstmt colNum :: SQLSMALLINT
colNum p_buf :: Ptr CChar
p_buf buflen :: SQLINTEGER
buflen p_ind :: Ptr SQLINTEGER
p_ind = SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
bindCol SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
forall a. Num a => a
sql_char (Ptr CChar -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_buf) SQLINTEGER
buflen Ptr SQLINTEGER
p_ind
bindCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m ()
bindCol :: SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> m ()
bindCol hstmt :: SQLINTEGER
hstmt colNum :: SQLSMALLINT
colNum colType :: SQLSMALLINT
colType p_buf :: SQLPOINTER
p_buf len_buf :: SQLINTEGER
len_buf p_ind :: Ptr SQLINTEGER
p_ind = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLINTEGER
-> Ptr SQLINTEGER
-> IO SQLSMALLINT
sqlbindcol SQLINTEGER
hstmt SQLSMALLINT
colNum SQLSMALLINT
colType SQLPOINTER
p_buf SQLINTEGER
len_buf Ptr SQLINTEGER
p_ind
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Error binding column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
colNum)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Binding column failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Binding col " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
colNum) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " returned warnings:"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Invalid handle when binding column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
colNum)
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Binding column failed"
| Bool
otherwise -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Invalid result when binding column " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
colNum)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Biniding column failed"
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "bindCol"
execDirect :: (MonadIO m, MonadFail m) => SQLHSTMT -> String -> m () -> m ()
execDirect :: SQLINTEGER -> String -> m () -> m ()
execDirect hstmt :: SQLINTEGER
hstmt sqlstr :: String
sqlstr feeddata :: m ()
feeddata = do
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
sqlstr
(\(sql :: Ptr CChar
sql, sqlLen :: Int
sqlLen) -> SQLINTEGER -> Ptr SQLCHAR -> SQLINTEGER -> IO SQLSMALLINT
sqlexecdirect SQLINTEGER
hstmt (Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
sql) (Int -> SQLINTEGER
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sqlLen))
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "sql statement executed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Execution of sql returned more info"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Execution of sql returned error"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "execute sql statement failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Invaild statement handle"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "execute statemnt failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_need_data -> m ()
feeddata
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Execution of statement returned no data"
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "execute statement failed"
| Bool
otherwise -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Execute statement returned unexpected result: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_stmt SQLINTEGER
hstmt
String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Execute statement failed"
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "execDirect"
connect :: (MonadIO m, MonadFail m) => SQLHENV -> String -> String -> String -> m SQLHDBC
connect :: SQLINTEGER -> String -> String -> String -> m SQLINTEGER
connect henv :: SQLINTEGER
henv server :: String
server user :: String
user pass :: String
pass = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "connect to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server
SQLINTEGER
hdbc <- SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
allocHandle SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
henv
SQLSMALLINT
result <- IO SQLSMALLINT -> m SQLSMALLINT
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SQLSMALLINT -> m SQLSMALLINT)
-> IO SQLSMALLINT -> m SQLSMALLINT
forall a b. (a -> b) -> a -> b
$ String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
server
(\(p_server :: Ptr CChar
p_server, serverLen :: Int
serverLen) -> String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
user
(\(p_user :: Ptr CChar
p_user, userLen :: Int
userLen) -> String -> (CStringLen -> IO SQLSMALLINT) -> IO SQLSMALLINT
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
pass
(\(p_pass :: Ptr CChar
p_pass, passLen :: Int
passLen) -> SQLINTEGER
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLCHAR
-> SQLSMALLINT
-> IO SQLSMALLINT
sqlconnect SQLINTEGER
hdbc (Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_server) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
serverLen) (Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_user) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
userLen) (Ptr CChar -> Ptr SQLCHAR
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
p_pass) (Int -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
passLen))))
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *) a. Monad m => a -> m a
return SQLINTEGER
hdbc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "connect to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server String -> ShowS
forall a. [a] -> [a] -> [a]
++ " returned warnings:"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *) a. Monad m => a -> m a
return SQLINTEGER
hdbc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "connection to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server String -> ShowS
forall a. [a] -> [a] -> [a]
++ " failed:"
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> IO ()
freeHandle SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
String -> m SQLINTEGER
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SQLINTEGER) -> String -> m SQLINTEGER
forall a b. (a -> b) -> a -> b
$ "connection to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server String -> ShowS
forall a. [a] -> [a] -> [a]
++ " failed"
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "connection to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server String -> ShowS
forall a. [a] -> [a] -> [a]
++ " failed because of invalid handle"
String -> m SQLINTEGER
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SQLINTEGER) -> String -> m SQLINTEGER
forall a b. (a -> b) -> a -> b
$ "connection to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server String -> ShowS
forall a. [a] -> [a] -> [a]
++ " failed because of invalid handle"
| Bool
otherwise -> do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Unexpected response code got from connecting to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Trying to extract diagnostic info:"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Try call disconnect on the connection handle, to make sure we release all resources"
SQLINTEGER -> IO ()
disconnect SQLINTEGER
hdbc
String -> m SQLINTEGER
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SQLINTEGER) -> String -> m SQLINTEGER
forall a b. (a -> b) -> a -> b
$ "Unexpected response code got from connecting to server " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
server String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "connect"
disconnect :: SQLHDBC -> IO ()
disconnect :: SQLINTEGER -> IO ()
disconnect hdbc :: SQLINTEGER
hdbc = do
SQLSMALLINT
result <- SQLINTEGER -> IO SQLSMALLINT
sqldisconnect SQLINTEGER
hdbc
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success_with_info -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "disconnect returned warnings:"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "disconnect failed:"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "disconnect failed because of invalid handle"
| Bool
otherwise -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Unexpected response code got from Disconnect function"
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Trying to extract diagnostic info:"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
SQLSMALLINT -> SQLINTEGER -> IO ()
freeHandle SQLSMALLINT
forall a. Num a => a
sql_handle_dbc SQLINTEGER
hdbc
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "disconnect"
allocHandle :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m SQLHANDLE
allocHandle :: SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
allocHandle handleType :: SQLSMALLINT
handleType handleParent :: SQLINTEGER
handleParent = do
Maybe SQLINTEGER
handle <- IO (Maybe SQLINTEGER) -> m (Maybe SQLINTEGER)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SQLINTEGER) -> m (Maybe SQLINTEGER))
-> IO (Maybe SQLINTEGER) -> m (Maybe SQLINTEGER)
forall a b. (a -> b) -> a -> b
$ (Ptr SQLINTEGER -> IO (Maybe SQLINTEGER)) -> IO (Maybe SQLINTEGER)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\p_handle :: Ptr SQLINTEGER
p_handle -> do
Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
p_handle SQLINTEGER
sql_null_handle
SQLSMALLINT
result <- SQLSMALLINT -> SQLINTEGER -> Ptr SQLINTEGER -> IO SQLSMALLINT
sqlallochandle SQLSMALLINT
handleType SQLINTEGER
handleParent Ptr SQLINTEGER
p_handle
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> SQLINTEGER -> Maybe SQLINTEGER
forall a. a -> Maybe a
Just (SQLINTEGER -> Maybe SQLINTEGER)
-> IO SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
p_handle
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "alloc handle failed because of invalid parent handle, for handle type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
IO ()
displayDiagnostic
Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
forall a. Maybe a
Nothing
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "alloc handle failed with error for handle type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
IO ()
displayDiagnostic
Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "alloc handle returned unexpected result for handle type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
IO ()
displayDiagnostic
Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
forall a. Maybe a
Nothing
where displayDiagnostic :: IO ()
displayDiagnostic = if SQLSMALLINT
handleType SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
forall a. Num a => a
sql_handle_env
then Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
p_handle IO SQLINTEGER -> (SQLINTEGER -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
forall a. Num a => a
sql_handle_env
else SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
handleParentType SQLINTEGER
handleParent
handleParentType :: SQLSMALLINT
handleParentType = case SQLSMALLINT
handleType of
h :: SQLSMALLINT
h | SQLSMALLINT
h SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
forall a. Num a => a
sql_handle_dbc -> SQLSMALLINT
forall a. Num a => a
sql_handle_env
| SQLSMALLINT
h SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
forall a. Num a => a
sql_handle_stmt -> SQLSMALLINT
forall a. Num a => a
sql_handle_dbc
| SQLSMALLINT
h SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
forall a. Num a => a
sql_handle_desc -> SQLSMALLINT
forall a. Num a => a
sql_handle_stmt
| Bool
otherwise -> 0)
m SQLINTEGER
-> (SQLINTEGER -> m SQLINTEGER) -> Maybe SQLINTEGER -> m SQLINTEGER
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m SQLINTEGER
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SQLINTEGER) -> String -> m SQLINTEGER
forall a b. (a -> b) -> a -> b
$ "AllocHandle failed for handle type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)) SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
handle
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "allocHandle"
freeHandle :: SQLSMALLINT -> SQLHANDLE -> IO ()
freeHandle :: SQLSMALLINT -> SQLINTEGER -> IO ()
freeHandle handleType :: SQLSMALLINT
handleType handle :: SQLINTEGER
handle = do
SQLSMALLINT
result <- SQLSMALLINT -> SQLINTEGER -> IO SQLSMALLINT
sqlfreehandle SQLSMALLINT
handleType SQLINTEGER
handle
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Error freeing handle of type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
handleType SQLINTEGER
handle
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "FreeHandle failed because of invalid handle"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
handleType SQLINTEGER
handle
| Bool
otherwise -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "FreeHandle returned unexpected result " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString "Trying to get diagnostic info on FreeHandle:"
SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo SQLSMALLINT
handleType SQLINTEGER
handle
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "freeHandle"
displayDiagInfo :: SQLSMALLINT -> SQLHANDLE -> IO ()
displayDiagInfo :: SQLSMALLINT -> SQLINTEGER -> IO ()
displayDiagInfo handleType :: SQLSMALLINT
handleType handle :: SQLINTEGER
handle = (MaybeT IO () -> IO (Maybe ())
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT IO () -> IO (Maybe ())) -> MaybeT IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> SQLINTEGER -> MaybeT IO ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> m ()
displayDiagInfo' SQLSMALLINT
handleType SQLINTEGER
handle) IO (Maybe ()) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
displayDiagInfo' :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m ()
displayDiagInfo' :: SQLSMALLINT -> SQLINTEGER -> m ()
displayDiagInfo' handleType :: SQLSMALLINT
handleType handle :: SQLINTEGER
handle = do
SQLINTEGER
recs <- SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
getCountOfDiagRecs SQLSMALLINT
handleType SQLINTEGER
handle
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "there "
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if SQLINTEGER
recs SQLINTEGER -> SQLINTEGER -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 then "are " else "is ")
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
recs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " diagnostic record"
String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if SQLINTEGER
recs SQLINTEGER -> SQLINTEGER -> Bool
forall a. Eq a => a -> a -> Bool
/= 1 then "s" else "")
let diags :: [m ()]
diags = [SQLSMALLINT -> m ()
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> m ()
showDiag (SQLSMALLINT -> m ()) -> SQLSMALLINT -> m ()
forall a b. (a -> b) -> a -> b
$ SQLINTEGER -> SQLSMALLINT
forall a b. (Integral a, Num b) => a -> b
fromIntegral SQLINTEGER
i | SQLINTEGER
i <- [1..SQLINTEGER
recs]]
showDiag :: SQLSMALLINT -> m ()
showDiag i :: SQLSMALLINT
i = do
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Diagnostic record " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
i)
DiagRecord
r <- SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> m DiagRecord
forall (m :: * -> *).
(MonadIO m, MonadFail m) =>
SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> m DiagRecord
getDiagRec SQLSMALLINT
handleType SQLINTEGER
handle SQLSMALLINT
i
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ DiagRecord -> IO ()
displayDiagRec DiagRecord
r
in [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [m ()]
diags
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "displayDiagInfo'"
displayDiagRec :: DiagRecord -> IO ()
displayDiagRec :: DiagRecord -> IO ()
displayDiagRec r :: DiagRecord
r = Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (SQLSMALLINT -> String
forall a. Show a => a -> String
show (SQLSMALLINT -> String) -> SQLSMALLINT -> String
forall a b. (a -> b) -> a -> b
$ DiagRecord -> SQLSMALLINT
diagrec_i DiagRecord
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (DiagRecord -> String
sqlstate DiagRecord
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show (SQLINTEGER -> String) -> SQLINTEGER -> String
forall a b. (a -> b) -> a -> b
$ DiagRecord -> SQLINTEGER
nativeError DiagRecord
r) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (DiagRecord -> String
messageText DiagRecord
r)
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "displayDiagRec"
getCountOfDiagRecs :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m SQLINTEGER
getCountOfDiagRecs :: SQLSMALLINT -> SQLINTEGER -> m SQLINTEGER
getCountOfDiagRecs handleType :: SQLSMALLINT
handleType handle :: SQLINTEGER
handle = do
Maybe SQLINTEGER
recs <- IO (Maybe SQLINTEGER) -> m (Maybe SQLINTEGER)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe SQLINTEGER) -> m (Maybe SQLINTEGER))
-> IO (Maybe SQLINTEGER) -> m (Maybe SQLINTEGER)
forall a b. (a -> b) -> a -> b
$ (Ptr SQLINTEGER -> IO (Maybe SQLINTEGER)) -> IO (Maybe SQLINTEGER)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\ptrRecs :: Ptr SQLINTEGER
ptrRecs -> do
IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr SQLINTEGER -> SQLINTEGER -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr SQLINTEGER
ptrRecs 0
SQLSMALLINT
result <- SQLSMALLINT
-> SQLINTEGER
-> SQLSMALLINT
-> SQLSMALLINT
-> SQLPOINTER
-> SQLSMALLINT
-> Ptr SQLSMALLINT
-> IO SQLSMALLINT
sqlgetdiagfield SQLSMALLINT
handleType SQLINTEGER
handle 0 SQLSMALLINT
forall a. Num a => a
sql_diag_number (Ptr SQLINTEGER -> SQLPOINTER
forall a b. Ptr a -> Ptr b
castPtr Ptr SQLINTEGER
ptrRecs) 0 Ptr SQLSMALLINT
forall a. Ptr a
nullPtr
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> SQLINTEGER -> Maybe SQLINTEGER
forall a. a -> Maybe a
Just (SQLINTEGER -> Maybe SQLINTEGER)
-> IO SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
ptrRecs
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Count of diagnostic records could not be retrieved due to an invalid handle, for handle type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
forall a. Maybe a
Nothing
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Count of diagnostic records could not be retrieved because wrong arguments were passed to GetDiagField function, for handle type" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
forall a. Maybe a
Nothing
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "No diagnostic data available for handle type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType)
Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SQLINTEGER -> IO (Maybe SQLINTEGER))
-> Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall a b. (a -> b) -> a -> b
$ SQLINTEGER -> Maybe SQLINTEGER
forall a. a -> Maybe a
Just 0
| Bool
otherwise -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "Getting the number of diagnostic records returned unexpected return code for handle type " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
handleType) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
Maybe SQLINTEGER -> IO (Maybe SQLINTEGER)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
forall a. Maybe a
Nothing)
m SQLINTEGER
-> (SQLINTEGER -> m SQLINTEGER) -> Maybe SQLINTEGER -> m SQLINTEGER
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m SQLINTEGER
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GetDiagField api call failed when reading number of diagnostic errors") SQLINTEGER -> m SQLINTEGER
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SQLINTEGER
recs
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "getCountOfDiagRecs"
data DiagRecord = DiagRecord {
DiagRecord -> SQLSMALLINT
diagrec_i :: SQLSMALLINT,
DiagRecord -> String
sqlstate :: String,
DiagRecord -> SQLINTEGER
nativeError :: SQLINTEGER,
DiagRecord -> String
messageText :: String
}
getDiagRec :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> m DiagRecord
getDiagRec :: SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> m DiagRecord
getDiagRec handleType :: SQLSMALLINT
handleType handle :: SQLINTEGER
handle recnum :: SQLSMALLINT
recnum = do
Maybe DiagRecord
diagrecord <- IO (Maybe DiagRecord) -> m (Maybe DiagRecord)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe DiagRecord) -> m (Maybe DiagRecord))
-> IO (Maybe DiagRecord) -> m (Maybe DiagRecord)
forall a b. (a -> b) -> a -> b
$ Int
-> (Ptr SQLCHAR -> IO (Maybe DiagRecord)) -> IO (Maybe DiagRecord)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes 5
(\p_sqlstate :: Ptr SQLCHAR
p_sqlstate -> (Ptr SQLINTEGER -> IO (Maybe DiagRecord)) -> IO (Maybe DiagRecord)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\p_nativeErr :: Ptr SQLINTEGER
p_nativeErr -> Int
-> (Ptr SQLCHAR -> IO (Maybe DiagRecord)) -> IO (Maybe DiagRecord)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
forall a. Num a => a
sql_max_message_length
(\p_messageText :: Ptr SQLCHAR
p_messageText -> (Ptr SQLSMALLINT -> IO (Maybe DiagRecord)) -> IO (Maybe DiagRecord)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
(\p_textLen :: Ptr SQLSMALLINT
p_textLen -> do
SQLSMALLINT
result <- SQLSMALLINT
-> SQLINTEGER
-> SQLSMALLINT
-> Ptr SQLCHAR
-> Ptr SQLINTEGER
-> Ptr SQLCHAR
-> SQLSMALLINT
-> Ptr SQLSMALLINT
-> IO SQLSMALLINT
sqlgetdiagrec SQLSMALLINT
handleType SQLINTEGER
handle SQLSMALLINT
recnum Ptr SQLCHAR
p_sqlstate Ptr SQLINTEGER
p_nativeErr Ptr SQLCHAR
p_messageText SQLSMALLINT
forall a. Num a => a
sql_max_message_length Ptr SQLSMALLINT
p_textLen
case SQLSMALLINT
result of
x :: SQLSMALLINT
x | SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_success -> do
String
l_sqlstate <- ((SQLCHAR -> Char) -> [SQLCHAR] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (SQLCHAR -> Int) -> SQLCHAR -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLCHAR -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)) ([SQLCHAR] -> String) -> IO [SQLCHAR] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([IO SQLCHAR] -> IO [SQLCHAR]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ptr SQLCHAR -> Int -> IO SQLCHAR
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr SQLCHAR
p_sqlstate Int
j | Int
j <- [0..4]])
SQLINTEGER
l_nativeErr <- Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
p_nativeErr
Int
textLen <- SQLSMALLINT -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SQLSMALLINT -> Int) -> IO SQLSMALLINT -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr SQLSMALLINT -> IO SQLSMALLINT
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLSMALLINT
p_textLen
String
l_messageText <- ((SQLCHAR -> Char) -> [SQLCHAR] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (SQLCHAR -> Int) -> SQLCHAR -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQLCHAR -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)) ([SQLCHAR] -> String) -> IO [SQLCHAR] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([IO SQLCHAR] -> IO [SQLCHAR]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [Ptr SQLCHAR -> Int -> IO SQLCHAR
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr SQLCHAR
p_messageText Int
j | Int
j <- [0..Int
textLen]])
Maybe DiagRecord -> IO (Maybe DiagRecord)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe DiagRecord -> IO (Maybe DiagRecord))
-> Maybe DiagRecord -> IO (Maybe DiagRecord)
forall a b. (a -> b) -> a -> b
$ DiagRecord -> Maybe DiagRecord
forall a. a -> Maybe a
Just (DiagRecord -> Maybe DiagRecord) -> DiagRecord -> Maybe DiagRecord
forall a b. (a -> b) -> a -> b
$ SQLSMALLINT -> String -> SQLINTEGER -> String -> DiagRecord
DiagRecord SQLSMALLINT
recnum String
l_sqlstate SQLINTEGER
l_nativeErr String
l_messageText
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_error -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recnum) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Diagnostic information could not be retrieved becuase wrong arguments passed to GetDagRec function"
Maybe DiagRecord -> IO (Maybe DiagRecord)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiagRecord
forall a. Maybe a
Nothing
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_invalid_handle -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recnum) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Diagnosic information could not be retrieved because of wrong handler"
Maybe DiagRecord -> IO (Maybe DiagRecord)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiagRecord
forall a. Maybe a
Nothing
| SQLSMALLINT
x SQLSMALLINT -> SQLSMALLINT -> Bool
forall a. Eq a => a -> a -> Bool
== SQLSMALLINT
sql_no_data -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recnum) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": No diagnostic data available"
Maybe DiagRecord -> IO (Maybe DiagRecord)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiagRecord
forall a. Maybe a
Nothing
| Bool
otherwise -> do
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
recnum) String -> ShowS
forall a. [a] -> [a] -> [a]
++ ": Getting diagnostic information returned unexpected error code " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLSMALLINT -> String
forall a. Show a => a -> String
show SQLSMALLINT
x)
Maybe DiagRecord -> IO (Maybe DiagRecord)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiagRecord
forall a. Maybe a
Nothing))))
m DiagRecord
-> (DiagRecord -> m DiagRecord) -> Maybe DiagRecord -> m DiagRecord
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m DiagRecord
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "GetDiagRec call failed") DiagRecord -> m DiagRecord
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DiagRecord
diagrecord
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "getDiagRec"
withMaybeCStringLen :: Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen :: Maybe String -> (CStringLen -> IO a) -> IO a
withMaybeCStringLen Nothing f :: CStringLen -> IO a
f = CStringLen -> IO a
f (Ptr CChar
forall a. Ptr a
nullPtr, 0)
withMaybeCStringLen (Just s :: String
s) f :: CStringLen -> IO a
f = String -> (CStringLen -> IO a) -> IO a
forall a. String -> (CStringLen -> IO a) -> IO a
withCStringLen String
s CStringLen -> IO a
f
peekMaybeCol :: (Storable a) => Ptr a -> Ptr SQLLEN -> IO (Maybe a)
peekMaybeCol :: Ptr a -> Ptr SQLINTEGER -> IO (Maybe a)
peekMaybeCol p_col :: Ptr a
p_col p_ind :: Ptr SQLINTEGER
p_ind = do
SQLINTEGER
ind <- Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
p_ind
if SQLINTEGER
ind SQLINTEGER -> SQLINTEGER -> Bool
forall a. Eq a => a -> a -> Bool
== SQLINTEGER
forall a. Num a => a
sql_null_data
then Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
else do a
col <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p_col
Text -> Text -> IO ()
debugS Text
logSrc' (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "reading value of len " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SQLINTEGER -> String
forall a. Show a => a -> String
show SQLINTEGER
ind) String -> ShowS
forall a. [a] -> [a] -> [a]
++ " from buffer with len " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Storable a => a -> Int
sizeOf a
col)
Maybe a -> IO (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> IO (Maybe a)) -> Maybe a -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
col
where logSrc' :: Text
logSrc' = Text
logSrc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "peekMaybeCol"
peekMaybeTextCol :: CString -> Ptr SQLLEN -> IO (Maybe String)
peekMaybeTextCol :: Ptr CChar -> Ptr SQLINTEGER -> IO (Maybe String)
peekMaybeTextCol p_col :: Ptr CChar
p_col p_ind :: Ptr SQLINTEGER
p_ind = do
SQLINTEGER
ind <- Ptr SQLINTEGER -> IO SQLINTEGER
forall a. Storable a => Ptr a -> IO a
peek Ptr SQLINTEGER
p_ind
if SQLINTEGER
ind SQLINTEGER -> SQLINTEGER -> Bool
forall a. Eq a => a -> a -> Bool
== SQLINTEGER
forall a. Num a => a
sql_null_data
then Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
else String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CChar -> IO String
peekCString Ptr CChar
p_col