Safe Haskell | None |
---|---|
Language | Haskell2010 |
- logsrc :: Text
- toCLIType :: SQLSMALLINT -> SQLSMALLINT
- data SQLConfig = SQLConfig {
- sql_cli_flds_table_cat :: SQLSMALLINT
- sql_cli_flds_table_schem :: SQLSMALLINT
- sql_cli_flds_table_name :: SQLSMALLINT
- sql_cli_flds_column_name :: SQLSMALLINT
- sql_cli_flds_data_type :: SQLSMALLINT
- sql_cli_flds_type_name :: SQLSMALLINT
- sql_cli_flds_column_size :: SQLSMALLINT
- sql_cli_flds_buffer_length :: SQLSMALLINT
- sql_cli_flds_decimal_digits :: SQLSMALLINT
- sql_cli_flds_num_prec_radix :: SQLSMALLINT
- sql_cli_flds_nullable :: SQLSMALLINT
- sql_cli_flds_remarks :: SQLSMALLINT
- sql_cli_flds_column_def :: SQLSMALLINT
- sql_cli_flds_datetime_code :: SQLSMALLINT
- sql_cli_flds_char_octet_length :: SQLSMALLINT
- sql_cli_flds_ordinal_position :: SQLSMALLINT
- sql_cli_flds_is_nullable :: SQLSMALLINT
- data ColumnInfo = ColumnInfo {
- ci_TableCat :: Maybe String
- ci_TableSchem :: String
- ci_TableName :: String
- ci_ColumnName :: String
- ci_DataType :: SQLSMALLINT
- ci_TypeName :: String
- ci_ColumnSize :: Maybe SQLINTEGER
- ci_BufferLength :: Maybe SQLINTEGER
- ci_DecimalDigits :: Maybe SQLSMALLINT
- ci_NumPrecRadix :: Maybe SQLSMALLINT
- ci_Nullable :: SQLSMALLINT
- ci_Remarks :: Maybe String
- ci_ColumnDef :: Maybe String
- ci_DatetimeCode :: Maybe SQLINTEGER
- ci_CharOctetLength :: Maybe SQLINTEGER
- ci_OrdinalPosition :: SQLINTEGER
- ci_IsNullable :: Maybe String
- collectColumnsInfo :: (MonadIO m, MonadFail m) => SQLHDBC -> String -> String -> ReaderT SQLConfig m [ColumnInfo]
- collectColumnsInfo' :: (MonadIO m, MonadFail m) => SQLHSTMT -> ReaderT SQLConfig m [ColumnInfo]
- tableExists :: (MonadIO m, MonadFail m) => SQLHDBC -> String -> String -> m Bool
- endTran :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> m ()
- setConnectAttr :: (MonadIO m, MonadFail m) => SQLHDBC -> SQLINTEGER -> SQLPOINTER -> SQLINTEGER -> m ()
- setDescField :: (MonadIO m, MonadFail m) => SQLHDESC -> SQLSMALLINT -> SQLSMALLINT -> Ptr a -> SQLINTEGER -> m ()
- getDescField :: (MonadIO m, MonadFail m) => SQLHDESC -> SQLSMALLINT -> SQLSMALLINT -> Ptr a -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
- setDescRec :: (MonadIO m, MonadFail m) => SQLHDESC -> SQLSMALLINT -> SQLSMALLINT -> SQLSMALLINT -> SQLINTEGER -> SQLSMALLINT -> SQLSMALLINT -> Ptr a -> Ptr SQLLEN -> Ptr SQLLEN -> m ()
- getDescRec :: (MonadIO m, MonadFail m) => SQLHDESC -> SQLSMALLINT -> Ptr SQLCHAR -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLLEN -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLSMALLINT -> m ()
- numResultCols :: (MonadIO m, MonadFail m) => SQLHSTMT -> m SQLSMALLINT
- getStorableStmtAttr :: (MonadIO m, MonadFail m, Storable a) => SQLHSTMT -> SQLINTEGER -> m a
- getStmtAttr :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLINTEGER -> Ptr a -> SQLINTEGER -> Ptr SQLINTEGER -> m ()
- bindParam :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLSMALLINT -> SQLULEN -> SQLSMALLINT -> Ptr a -> Ptr SQLLEN -> m ()
- putData :: (MonadIO m, MonadFail m) => SQLHSTMT -> Ptr a -> SQLLEN -> m ()
- paramData :: (MonadIO m, MonadFail m) => SQLHSTMT -> (SQLPOINTER -> m ()) -> m ()
- prepare :: (MonadIO m, MonadFail m) => SQLHSTMT -> String -> m ()
- execute :: (MonadIO m, MonadFail m) => SQLHSTMT -> m () -> m ()
- data ConciseColInfo = ConciseColInfo {}
- describeCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> m ConciseColInfo
- columns :: (MonadIO m, MonadFail m) => SQLHSTMT -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> m ()
- tables :: (MonadIO m, MonadFail m) => SQLHSTMT -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> m ()
- forAllRecords :: (MonadIO m, MonadFail m) => SQLHSTMT -> (a -> m a) -> a -> m a
- forAllRecordsWithEndAndFail :: (MonadIO m, MonadFail m) => SQLHSTMT -> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a
- forAllData :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> (a -> m a) -> a -> m a
- getData :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m Bool
- getDataAndRun :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m a -> m a -> m a
- fetch :: (MonadIO m, MonadFail m) => SQLHSTMT -> m Bool
- fetchAndRun :: (MonadIO m, MonadFail m) => SQLHSTMT -> m a -> m a -> m a
- fetchAndRunWithFail :: (MonadIO m, MonadFail m) => SQLHSTMT -> m a -> m a -> (String -> m a) -> m a
- bindSmallIntCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> Ptr SQLSMALLINT -> Ptr SQLLEN -> m ()
- bindIntegerCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> Ptr SQLINTEGER -> Ptr SQLLEN -> m ()
- bindVarcharCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> CString -> SQLLEN -> Ptr SQLLEN -> m ()
- bindCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m ()
- execDirect :: (MonadIO m, MonadFail m) => SQLHSTMT -> String -> m () -> m ()
- connect :: (MonadIO m, MonadFail m) => SQLHENV -> String -> String -> String -> m SQLHDBC
- disconnect :: SQLHDBC -> IO ()
- allocHandle :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m SQLHANDLE
- freeHandle :: SQLSMALLINT -> SQLHANDLE -> IO ()
- displayDiagInfo :: SQLSMALLINT -> SQLHANDLE -> IO ()
- displayDiagInfo' :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m ()
- displayDiagRec :: DiagRecord -> IO ()
- getCountOfDiagRecs :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m SQLINTEGER
- data DiagRecord = DiagRecord {}
- getDiagRec :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> m DiagRecord
- withMaybeCStringLen :: Maybe String -> (CStringLen -> IO a) -> IO a
- peekMaybeCol :: Storable a => Ptr a -> Ptr SQLLEN -> IO (Maybe a)
- peekMaybeTextCol :: CString -> Ptr SQLLEN -> IO (Maybe String)
Documentation
toCLIType :: SQLSMALLINT -> SQLSMALLINT Source #
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
configuration values dependent on the actual CLI implementation
SQLConfig | |
|
data ColumnInfo Source #
information about column in the database; the meaning of fields is detailed in the SQL CLI specification in the documenation of Columns API call
collectColumnsInfo' :: (MonadIO m, MonadFail m) => SQLHSTMT -> ReaderT SQLConfig m [ColumnInfo] Source #
Implements the logic of collectColumnsInfo
getting the handle to the statement that
was used to call sqlcolumns
on
:: (MonadIO m, MonadFail m) | |
=> SQLHDBC | connection handle |
-> String | schema name |
-> String | table name |
-> m Bool |
Checks if a table exists on the current connection.
:: (MonadIO m, MonadFail m) | |
=> SQLSMALLINT | handle type |
-> SQLHANDLE | handle |
-> SQLSMALLINT | completion type; either sql_commit or sql_rollback |
-> m () |
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
setConnectAttr :: (MonadIO m, MonadFail m) => SQLHDBC -> SQLINTEGER -> SQLPOINTER -> SQLINTEGER -> m () Source #
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
:: (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 () |
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
:: (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 () |
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
:: (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 () |
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
:: (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 () |
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
numResultCols :: (MonadIO m, MonadFail m) => SQLHSTMT -> m SQLSMALLINT Source #
wrapper for SQL/CLI function NumResultCols; it fails if the API call fails and it displays diagnostic information on the standard error
getStorableStmtAttr :: (MonadIO m, MonadFail m, Storable a) => SQLHSTMT -> SQLINTEGER -> m a Source #
helper function to get the value of a Storable
statement attribute
:: (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 () |
wrapper for SQL/CLI function GetStmtAttr; it displays diagnostic info on the standard error and it fails if the call SQL/CLI call fails
:: (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 () |
wrapper for SQL/CLI function, BindParam; it displayes diagnostics on standard error
putData :: (MonadIO m, MonadFail m) => SQLHSTMT -> Ptr a -> SQLLEN -> m () Source #
wrapper for PutData SQL/CLI api call; it displays diagnostics on standard error
paramData :: (MonadIO m, MonadFail m) => SQLHSTMT -> (SQLPOINTER -> m ()) -> m () Source #
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.
prepare :: (MonadIO m, MonadFail m) => SQLHSTMT -> String -> m () Source #
wrapper for Prepare SQL/CLI API call
execute :: (MonadIO m, MonadFail m) => SQLHSTMT -> m () -> m () Source #
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
data ConciseColInfo Source #
concise information about a column of a result set, mapping the result of SQL CLI API call DescribeCol
describeCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> m ConciseColInfo Source #
wrapper for DescribeCol SQL CLI API call
columns :: (MonadIO m, MonadFail m) => SQLHSTMT -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> m () Source #
wrapper for SQL CLI Columns API call
tables :: (MonadIO m, MonadFail m) => SQLHSTMT -> Maybe String -> Maybe String -> Maybe String -> Maybe String -> m () Source #
wrapper for SQL CLI Tables API call
forAllRecords :: (MonadIO m, MonadFail m) => SQLHSTMT -> (a -> m a) -> a -> m a Source #
applies a function through all the records in a statment, passing an accumulator value and combining the actions returned by the function
forAllRecordsWithEndAndFail :: (MonadIO m, MonadFail m) => SQLHSTMT -> (a -> m a) -> (a -> m a) -> (a -> String -> m a) -> a -> m a Source #
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
forAllData :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> (a -> m a) -> a -> m a Source #
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
getData :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m Bool Source #
getDataAndRun :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m a -> m a -> m a Source #
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.
fetchAndRun :: (MonadIO m, MonadFail m) => SQLHSTMT -> m a -> m a -> m a Source #
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.
fetchAndRunWithFail :: (MonadIO m, MonadFail m) => SQLHSTMT -> m a -> m a -> (String -> m a) -> m a Source #
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.
:: (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 () |
helper function to bind a SMALLINT column
:: (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 () |
helper function to bind an INTEGER column
:: (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 () |
helper function to bind a VARCHAR column. The buffer length parameter must include the
NULL terminating character of the CString
.
bindCol :: (MonadIO m, MonadFail m) => SQLHSTMT -> SQLSMALLINT -> SQLSMALLINT -> SQLPOINTER -> SQLLEN -> Ptr SQLLEN -> m () Source #
wrapper for BindCol SQL CLI API call; if an error occurs the computation is stopped and diagnostics are displayed on the standard error
execDirect :: (MonadIO m, MonadFail m) => SQLHSTMT -> String -> m () -> m () Source #
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.
connect :: (MonadIO m, MonadFail m) => SQLHENV -> String -> String -> String -> m SQLHDBC Source #
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.
disconnect :: SQLHDBC -> IO () Source #
wrapper for SQL CLI Disconnect API call; displays diagnostics on the standard error.
allocHandle :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m SQLHANDLE Source #
wrapper to SQL CLI AllocHandle API call; it displays diagnostics info on the standard error and fails if the handle could not be allocated
freeHandle :: SQLSMALLINT -> SQLHANDLE -> IO () Source #
wrapper for SQL CLI FreeHandle API call; it displays diagnostics on the standard error; it does not fail
displayDiagInfo :: SQLSMALLINT -> SQLHANDLE -> IO () Source #
create an IO
action that displays diagnostic records for a given handle on the
standard error; this action will not fail
displayDiagInfo' :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m () Source #
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.
displayDiagRec :: DiagRecord -> IO () Source #
display a diagnostic record on standard error
getCountOfDiagRecs :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> m SQLINTEGER Source #
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
data DiagRecord Source #
information in a diagnostic record
getDiagRec :: (MonadIO m, MonadFail m) => SQLSMALLINT -> SQLHANDLE -> SQLSMALLINT -> m DiagRecord Source #
wrapper for SQL CLI GetDiagRec API call; the computation fails if an error occurs and it displays diagnostics on standard error
withMaybeCStringLen :: Maybe String -> (CStringLen -> IO a) -> IO a Source #
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
)