-- Provides a more convenient way to use SQLCLI API from Haskell

{-# 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."

-- | convert an implementation type to a SQL/CLI known type; checks if the type

-- identifier is a SQL/CLI type; if not returns sql_varchar

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

-- | configuration values dependent on the actual CLI implementation

data SQLConfig = SQLConfig {
  SQLConfig -> SQLSMALLINT
sql_cli_flds_table_cat        :: SQLSMALLINT, -- ^ position of TABLE_CAT column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_table_schem      :: SQLSMALLINT, -- ^ position of TABLE_SCHEM column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_table_name       :: SQLSMALLINT, -- ^ position of TABLE_NAME column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_column_name      :: SQLSMALLINT, -- ^ position of COLUMN_NAME column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_data_type        :: SQLSMALLINT, -- ^ position of DATA_TYPE column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_type_name        :: SQLSMALLINT, -- ^ position of TYPE_NAME column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_column_size      :: SQLSMALLINT, -- ^ position of COLUMN_SIZE column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_buffer_length    :: SQLSMALLINT, -- ^ position of BUFFER_LENGTH column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_decimal_digits   :: SQLSMALLINT, -- ^ position of DECIMAL_DIGITS column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_num_prec_radix   :: SQLSMALLINT, -- ^ position of NUM_PREC_RADIX column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_nullable         :: SQLSMALLINT, -- ^ position of NULLABLE column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_remarks          :: SQLSMALLINT, -- ^ position of REMARKS column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_column_def       :: SQLSMALLINT, -- ^ position of COLUMN_DEF column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_datetime_code    :: SQLSMALLINT, -- ^ position of DATETIME_CODE column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_char_octet_length :: SQLSMALLINT, -- ^ position of CHAR_OCTET_LENGTH column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_ordinal_position :: SQLSMALLINT, -- ^ position of ORDINAL_POSITION column in the resultset returned by Columns API call

  SQLConfig -> SQLSMALLINT
sql_cli_flds_is_nullable      :: SQLSMALLINT  -- ^ position of IS_NULLABLE column in the resultset returned by Columns API call

  }


-- | information about column in the database; the meaning of fields is detailed

-- in the SQL CLI specification in the documenation of Columns API call

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,
  ColumnInfo -> Maybe String
ci_Remarks            :: 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)

-- | Read columns information for a given table on a database connection. It returns a 'ReaderT' value

-- that will get implementation dependent fieled numbers in the result set returned by Columns API call

-- from a 'SQLConfig' value.

collectColumnsInfo :: (MonadIO m, MonadFail m) => SQLHDBC       -- ^ connection handle

  -> String                                                     -- ^ schema name

  -> String                                                     -- ^ table name

  -> 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

-- | Implements the logic of 'collectColumnsInfo' getting the handle to the statement that

-- was used to call 'sqlcolumns' on

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)


-- | Checks if a table exists on the current connection.

tableExists :: (MonadIO m, MonadFail m) => SQLHDBC      -- ^ connection handle

  -> String                                             -- ^ schema name

  -> String                                             -- ^ table name

  -> 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


-- SQLCLI wrappers


-- | wrapper to SQL/CLI function EndTran; it creates a monadic action to call

-- the foreign API function and to log diagnostics on the standard output; it

-- fails if the API call fails

endTran :: (MonadIO m, MonadFail m) =>
  SQLSMALLINT           -- ^ handle type

  -> SQLHANDLE          -- ^ handle

  -> SQLSMALLINT        -- ^ completion type; either sql_commit or sql_rollback

  -> 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"

-- | wrapper for SQL/CLI function SetConnectAttr; it creates a monadic action

-- that calls the foreign API function and logs diagnostics on standard error;

-- it fails if the API call fails

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"

-- | wrapper for SQL/CLI function SetDescField; it creates a monadic action

-- that calls the API function, logs diagnostic on standard output and fails

-- if the API call fails

setDescField :: (MonadIO m, MonadFail m) => SQLHDESC    -- ^ descriptor handle

  -> SQLSMALLINT                                        -- ^ record number

  -> SQLSMALLINT                                        -- ^ field identifier

  -> Ptr a                                              -- ^ pointer to the buffer holding the value

  -> SQLINTEGER                                         -- ^ length in octets of the value; if the field is not a string,

                                                        -- the field is ignored

  -> 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"

-- | wrapper for SQL/CLI function GetDescField; it creates a monadic action

-- that calls the API function, logs disgnostic on standard output and

-- fails if the API call fails

getDescField :: (MonadIO m, MonadFail m) => SQLHDESC    -- ^ descriptor handle

  -> SQLSMALLINT                                        -- ^ record number, starts with 1; when getting header fields it must be 0

  -> SQLSMALLINT                                        -- ^ field identifier

  -> Ptr a                                              -- ^ pointer to buffer to receive the value of the field

  -> SQLINTEGER                                         -- ^ the length in bytes of the value's buffer

  -> Ptr SQLINTEGER                                     -- ^ pointer to a buffer to receive the length in octets of the value, if the

                                                        -- value si a character string; otherwise, unused

  -> 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"

-- | wrapper for SQL/CLI function SetDescRec; it gets the same parameters as the

-- function described in the API and creates a monadic action that fails if the

-- API call fails and logs the diagnostics to standard error

setDescRec :: (MonadIO m, MonadFail m) => SQLHDESC      -- ^ (input)  descriptor handle

  -> SQLSMALLINT                                        -- ^ (input)  record number; it starts from 1

  -> SQLSMALLINT                                        -- ^ (input)  the TYPE field for record

  -> SQLSMALLINT                                        -- ^ (input)  the DATETIME_INTERVAL_CODE field, for records whose TYPE is SQL_DATETIME

  -> SQLINTEGER                                         -- ^ (input)  the OCTET_LENGTH field for the record

  -> SQLSMALLINT                                        -- ^ (input)  the PRECISION field for the record

  -> SQLSMALLINT                                        -- ^ (input)  the SCALE field for the record

  -> Ptr a                                              -- ^ (input)  DATA_PTR field for the record

  -> Ptr SQLLEN                                         -- ^ (input)  OCTET_LENGTH_PTR field for the record

  -> Ptr SQLLEN                                         -- ^ (input)  INDICATOR_PTR field for the record

  -> 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"

-- | wrapper for SQL/CLI function GetDescRec; it gets the same parameters as the

-- function described in the API and creates a monadic action that fails if the

-- API call fails and logs the diagnostics to standard error

getDescRec :: (MonadIO m, MonadFail m) => SQLHDESC      -- ^ (input)  descriptor handle

  -> SQLSMALLINT                                        -- ^ (input)  record number, starts from 1

  -> Ptr SQLCHAR                                        -- ^ (output) buffer to receive the column name

  -> SQLSMALLINT                                        -- ^ (input)  name buffer length

  -> Ptr SQLSMALLINT                                    -- ^ (output) buffer to receive the actual length of the name

  -> Ptr SQLSMALLINT                                    -- ^ (output) the TYPE field of the record

  -> Ptr SQLSMALLINT                                    -- ^ (output) the DATETIME_INTERVAL_CODE field, for records whose TYPE is SQL_DATETIME

  -> Ptr SQLLEN                                         -- ^ (output) the OCTET_LENGTH field of the recorrd

  -> Ptr SQLSMALLINT                                    -- ^ (output) the PRECISION field of the record

  -> Ptr SQLSMALLINT                                    -- ^ (output) the SCALE field of the record

  -> Ptr SQLSMALLINT                                    -- ^ (output) the NULLABLE field of the record

  -> 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"

-- | wrapper for SQL/CLI function NumResultCols; it fails if the API call fails and

-- it displays diagnostic information on the standard error

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"

-- | helper function to get the value of a `Storable` statement attribute

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

-- | wrapper for SQL/CLI function GetStmtAttr; it displays diagnostic info on the

-- standard error and it fails if the call SQL/CLI call fails

getStmtAttr :: (MonadIO m, MonadFail m) => SQLHSTMT     -- ^ statement handle

  -> SQLINTEGER                                         -- ^ the attribute identifier

  -> Ptr a                                              -- ^ buffer to receive the attribute's value

  -> SQLINTEGER                                         -- ^ the length of the buffer in octets, if the attribute's value

                                                        -- is string, otherwise it is unused

  -> Ptr SQLINTEGER                                     -- ^ pointer to buffer to receive the actual length of the attribute's

                                                        -- value, if it is a string value, otherwise it is unused

  -> 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"

-- | wrapper for SQL/CLI function, BindParam; it displayes diagnostics on standard error

bindParam :: (MonadIO m, MonadFail m) => SQLHSTMT       -- ^ statement handle

  -> SQLSMALLINT                                        -- ^ parameter number

  -> SQLSMALLINT                                        -- ^ value type

  -> SQLSMALLINT                                        -- ^ parameter type

  -> SQLULEN                                            -- ^ length precision

  -> SQLSMALLINT                                        -- ^ parameter scale

  -> Ptr a                                              -- ^ parameter value

  -> Ptr SQLLEN                                         -- ^ string length or indicator

  -> 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"

-- | wrapper for PutData SQL/CLI api call; it displays diagnostics on standard error

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"

-- | wrapper for ParamData SQL/CLI API call; it gets a statement handle and a function that

-- knows how to supply parameter data; this function gets the value DATA_PTR field of the

-- record in the application parameter descriptor that relates to the dynamic parameter for

-- which the implementation requires information.

--

-- The successful return of this call means that all parameter data has been supplied and the

-- sql statement has been executed.

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"

-- | wrapper for Prepare SQL/CLI API call

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"

-- | wrapper for Execute SQL/CLI API call; it receives ab handle to

-- a prepared statement and a monadic action that should provide

-- dynamic arguments data using calls to 'sqlputdata' and 'sqlparamdata';

-- this action will be used in the case 'sqlexecute' returns 'sql_need_data',

-- that is, if the prepared statement specifies some dynamic parameters that

-- are not described in the application parameter descriptor (for example, by

-- calling 'sqlbindparam' for that parameter); the action must provide the

-- data for parameters in the order the parameters appear in the sql statement

-- and call 'sqlparamdata' after each parameter data has been provided

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"

-- | concise information about a column of a result set, mapping

-- the result of SQL CLI API call DescribeCol

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 }

-- | wrapper for DescribeCol SQL CLI API call

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"

-- | wrapper for SQL CLI Columns API call

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"

-- | wrapper for SQL CLI Tables API call

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"

-- | applies a function through all the records in a statment, passing an accumulator value and

-- combining the actions returned by the function

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)

-- | applies a function through all the records in a statment, passing an accumulator value and

-- combining the actions returned by the function; if all records have been successfully fetched,

-- the second function is called; if an error occures, the third function is called, with the error

-- message

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)

-- | exhaust all data of a column extracting all data chunks with GetData SQL/CLI call, and calling a function after extraction

-- of each chunk passing it an accumulator value; the function should construct a monadic action that will deal with the extracted

-- data chunk; in the end, these actions are combined in the monadic value returned by the 'forAllData'

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)

-- | Read data from a column and checks the diagnostics, returning a 'True' or 'False' value inside a monadic action.

-- It returns 'True' if more data is available for read, and 'False' otherwise. It fails in 'MaybeT' 'IO' monad if

-- an error occured. It displays the diagnostics on the error on the standard error.

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)

-- | Read data available in a column of a fetched database record inside a monadic action. It fails if

-- an error occurs, displaying the diagnostics on the standard error. It receives 2 monadic actions

-- parameters:

--

-- *   more

-- *   end

--

-- It executes the more action if there is more data available and it executes the end action if all

-- data in the column has been read.

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"

-- | Create a monadic action to fetch the next record in an executed statement producing

-- 'True' if there are more records available or 'False' if all the records have been read.

--

-- If an error occurs, the monadic action fails, displaying the error diagnostics on

-- the standard error.

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)

-- | Create a monadic action to fetch the next record in an excecuted statement. It, then,

-- executes one of the 2 actions received as parameters. If 'sqlfetch' returns a success code,

-- it executes the first action, else, if 'sql_no_data' is received as result (there were no more

-- records to fetch), it executes the second action.

--

-- If an error occrus, the monadic action fails, displaying error diagnostics on the standard

-- error.

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

-- | Create a monadic action to fetch the next record in an excecuted statement. It, then,

-- executes one of the 3 actions received as parameters depending on the result of calling

-- 'sqlfetch' function.

--

-- If 'sqlfetch' call returns a success code, then the first action is called, that should process

-- the fetched record.

--

-- If 'sqlfetch' returns 'sql_no_data', meaning there are no more records to fetch, the second action

-- is called that should terminate the data fetching on this statement.

--

-- If 'sqlfetch' returns an error, the third action is executed that should process the error condition,

-- passing it the fail error message.

--

-- If an error occrus, the monadic action fails, displaying error diagnostics on the standard

-- error.

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"

-- | helper function to bind a SMALLINT column

bindSmallIntCol :: (MonadIO m, MonadFail m) =>
  SQLHSTMT                      -- ^ statement handle

  -> SQLSMALLINT                -- ^ column number (starting with 1)

  -> Ptr SQLSMALLINT            -- ^ buffer to receive the value

  -> Ptr SQLLEN                 -- ^ buffer to receive the indicator or length; it can be null

  -> 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

-- | helper function to bind an INTEGER column

bindIntegerCol :: (MonadIO m, MonadFail m) =>
  SQLHSTMT                      -- ^ statement handle

  ->  SQLSMALLINT               -- ^ column number (starting with 1)

  -> Ptr SQLINTEGER             -- ^ buffer to receive the value

  -> Ptr SQLLEN                 -- ^ buffer to receive the indicator or length; it can be null

  -> 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

-- | helper function to bind a VARCHAR column. The buffer length parameter must include the

-- NULL terminating character of the 'CString'.

bindVarcharCol :: (MonadIO m, MonadFail m) =>
  SQLHSTMT                      -- ^ statement handle

  -> SQLSMALLINT                -- ^ column number (starting with 1)

  -> CString                    -- ^ buffer to receive the null terminated text data

  -> SQLLEN                     -- ^ buffer length in bytes, including the null terminating character

  -> Ptr SQLLEN                 -- ^ pointer to indicator or length; it can be null

  -> 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

-- | wrapper for BindCol SQL CLI API call; if an error occurs

-- the computation is stopped and diagnostics are displayed on the standard error

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"

-- | wrapper for SQL CLI ExecDirect API call; if an error occurs, the

-- computation exits displaying diagnostics on the standard error.

--

-- It gets 3 parameters: a handle statement, a sql string and a feed data

-- action; if 'sqlexecdirect' returns 'sql_need_data', it executes the feed

-- data action.

--

-- The feed data action is responsible with supplying the needed data for

-- dynamic parameters by calling 'sqlputdata' and 'sqlparamdata'. See more

-- details on SQL/CLI specification for ExecDirect, PutData and ParamData API

-- calls.

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"

-- | utility function that allocates a database connection handle and connects to

-- the database.

--

-- On success, the computation returns the handle to the database conncection.

--

-- On error, the computation exits, displaying diagnostics on the standard error.

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"

-- | wrapper for SQL CLI Disconnect API call; displays diagnostics

-- on the standard error.

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"

-- | wrapper to SQL CLI AllocHandle API call; it displays diagnostics info

-- on the standard error and fails if the handle could not be allocated

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"

-- | wrapper for SQL CLI FreeHandle API call; it displays diagnostics

-- on the standard error; it does not fail

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"

-- | create an 'IO' action that displays diagnostic records for a given handle on the

-- standard error; this action will not fail

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

-- | create a monadic action to display the diagnostic records for a given handle on the

-- standard error; it fails if an error occurs while reading diagnostic records.

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'"

-- | display a diagnostic record on standard error

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"

-- | create a monadic action to read the number of the diagnostic records for a given handle;

-- it fails if an error occurs and it displays diagnostics on standard error

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"

-- | information in a diagnostic record

data DiagRecord = DiagRecord {
  DiagRecord -> SQLSMALLINT
diagrec_i     :: SQLSMALLINT,
  DiagRecord -> String
sqlstate      :: String,
  DiagRecord -> SQLINTEGER
nativeError   :: SQLINTEGER,
  DiagRecord -> String
messageText   :: String
  }

-- | wrapper for SQL CLI GetDiagRec API call; the computation fails if an error

-- occurs and it displays diagnostics on standard error

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"

-- | helper function to allocate a 'CStringLen'; it calls the function

-- received as parameter with the address of the allocated string or

-- with a null pointer if no string was received as input (i.e. 'Nothing')

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

-- | helper function to read a nullable column; returns Nothing if the

-- column is null

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"

-- | helper function to read a nullable text column; returns Nothing if the

-- column is null

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