Takusen-0.8.2: Database library with left-fold interface, for PostgreSQL, Oracle, SQLite, ODBC.ContentsIndex
Database.Oracle.OCIFunctions
Portabilitynon-portable
Stabilityexperimental
Maintaineroleg@pobox.com, alistair@abayley.org
Description

Simple wrappers for OCI functions (FFI).

The functions in this file are simple wrappers for OCI functions. The wrappers add error detection and exceptions; functions in this module raise OCIException. The next layer up traps these and turns them into DBException.

Note that OCIException does not contain the error number and text returned by getOCIErrorMsg. It is the job of the next layer (module) up to catch the OCIException and then call getOCIErrorMsg to get the actual error details. The OCIException simply contains the error number returned by the OCI call, and some text identifying the wrapper function. See formatErrorCodeDesc for the set of possible values for the OCI error numbers.

Synopsis
data OCIStruct = OCIStruct
type OCIHandle = Ptr OCIStruct
data OCIBuffer = OCIBuffer
type BufferPtr = Ptr OCIBuffer
type BufferFPtr = ForeignPtr OCIBuffer
type ColumnResultBuffer = ForeignPtr OCIBuffer
type BindBuffer = (ForeignPtr CShort, ForeignPtr OCIBuffer, ForeignPtr CUShort)
data Context = Context
type ContextPtr = Ptr Context
data EnvStruct = EnvStruct
type EnvHandle = Ptr EnvStruct
data ErrorStruct = ErrorStruct
type ErrorHandle = Ptr ErrorStruct
data ServerStruct = ServerStruct
type ServerHandle = Ptr ServerStruct
data UserStruct = UserStruct
type UserHandle = Ptr UserStruct
data ConnStruct = ConnStruct
type ConnHandle = Ptr ConnStruct
data SessStruct = SessStruct
type SessHandle = Ptr SessStruct
data StmtStruct = StmtStruct
type StmtHandle = Ptr StmtStruct
data DefnStruct = DefnStruct
type DefnHandle = Ptr DefnStruct
data ParamStruct = ParamStruct
type ParamHandle = Ptr ParamStruct
data BindStruct = BindStruct
type BindHandle = Ptr BindStruct
type ColumnInfo = (DefnHandle, ColumnResultBuffer, ForeignPtr CShort, ForeignPtr CUShort)
data OCIException = OCIException CInt String
catchOCI :: IO a -> (OCIException -> IO a) -> IO a
throwOCI :: OCIException -> a
mkCInt :: Int -> CInt
mkCShort :: CInt -> CShort
mkCUShort :: CInt -> CUShort
cStrLen :: CStringLen -> CInt
cStr :: CStringLen -> CString
ociEnvCreate :: Ptr EnvHandle -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt
ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt
ociHandleFree :: OCIHandle -> CInt -> IO CInt
ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt
ociParamGet :: OCIHandle -> CInt -> ErrorHandle -> Ptr OCIHandle -> CInt -> IO CInt
ociAttrGet :: OCIHandle -> CInt -> BufferPtr -> Ptr CInt -> CInt -> ErrorHandle -> IO CInt
ociAttrSet :: OCIHandle -> CInt -> BufferPtr -> CInt -> CInt -> ErrorHandle -> IO CInt
ociLogon :: EnvHandle -> ErrorHandle -> Ptr ConnHandle -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt
ociLogoff :: ConnHandle -> ErrorHandle -> IO CInt
ociSessionBegin :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> CInt -> IO CInt
ociSessionEnd :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> IO CInt
ociServerAttach :: ServerHandle -> ErrorHandle -> CString -> CInt -> CInt -> IO CInt
ociServerDetach :: ServerHandle -> ErrorHandle -> CInt -> IO CInt
ociTerminate :: CInt -> IO CInt
ociTransStart :: ConnHandle -> ErrorHandle -> Word8 -> CInt -> IO CInt
ociTransCommit :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociTransRollback :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociStmtPrepare :: StmtHandle -> ErrorHandle -> CString -> CInt -> CInt -> CInt -> IO CInt
ociDefineByPos :: StmtHandle -> Ptr DefnHandle -> ErrorHandle -> CInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CInt -> IO CInt
ociStmtExecute :: ConnHandle -> StmtHandle -> ErrorHandle -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt
ociStmtFetch :: StmtHandle -> ErrorHandle -> CInt -> CShort -> CInt -> IO CInt
ociBindByPos :: StmtHandle -> Ptr BindHandle -> ErrorHandle -> CUInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CUInt -> Ptr CUInt -> CUInt -> IO CInt
ociBindDynamic :: BindHandle -> ErrorHandle -> ContextPtr -> FunPtr OCICallbackInBind -> ContextPtr -> FunPtr OCICallbackOutBind -> IO CInt
type OCICallbackInBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> CInt -> Ptr Word8 -> Ptr CShort -> IO CInt
type OCICallbackOutBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> Ptr CInt -> Ptr Word8 -> Ptr CShort -> Ptr (Ptr CShort) -> IO CInt
mkOCICallbackInBind :: OCICallbackInBind -> IO (FunPtr OCICallbackInBind)
mkOCICallbackOutBind :: OCICallbackOutBind -> IO (FunPtr OCICallbackOutBind)
getOCIErrorMsg2 :: OCIHandle -> CInt -> Ptr CInt -> CString -> CInt -> IO (CInt, String)
getOCIErrorMsg :: OCIHandle -> CInt -> IO (CInt, String)
fromEnumOCIErrorCode :: CInt -> String
formatErrorCodeDesc :: CInt -> String -> String
formatOCIMsg :: CInt -> String -> OCIHandle -> CInt -> IO (Int, String)
formatMsgCommon :: OCIException -> OCIHandle -> CInt -> IO (Int, String)
formatErrorMsg :: OCIException -> ErrorHandle -> IO (Int, String)
formatEnvMsg :: OCIException -> EnvHandle -> IO (Int, String)
testForError :: CInt -> String -> a -> IO a
testForErrorWithPtr :: Storable a => CInt -> String -> Ptr a -> IO a
envCreate :: IO EnvHandle
handleAlloc :: CInt -> OCIHandle -> IO OCIHandle
handleFree :: CInt -> OCIHandle -> IO ()
setHandleAttr :: ErrorHandle -> OCIHandle -> CInt -> Ptr a -> CInt -> IO ()
setHandleAttrString :: ErrorHandle -> OCIHandle -> CInt -> String -> CInt -> IO ()
getHandleAttr :: Storable a => ErrorHandle -> OCIHandle -> CInt -> CInt -> IO a
getParam :: ErrorHandle -> StmtHandle -> Int -> IO ParamHandle
dbLogon :: String -> String -> String -> EnvHandle -> ErrorHandle -> IO ConnHandle
dbLogoff :: ErrorHandle -> ConnHandle -> IO ()
terminate :: IO ()
serverDetach :: ErrorHandle -> ServerHandle -> IO ()
serverAttach :: ErrorHandle -> ServerHandle -> String -> IO ()
getSession :: ErrorHandle -> ConnHandle -> IO SessHandle
sessionBegin :: ErrorHandle -> ConnHandle -> SessHandle -> CInt -> IO ()
sessionEnd :: ErrorHandle -> ConnHandle -> SessHandle -> IO ()
beginTrans :: ErrorHandle -> ConnHandle -> CInt -> IO ()
commitTrans :: ErrorHandle -> ConnHandle -> IO ()
rollbackTrans :: ErrorHandle -> ConnHandle -> IO ()
stmtPrepare :: ErrorHandle -> StmtHandle -> String -> IO ()
stmtExecute :: ErrorHandle -> ConnHandle -> StmtHandle -> Int -> IO ()
defineByPos :: ErrorHandle -> StmtHandle -> Int -> Int -> CInt -> IO ColumnInfo
sbph :: String -> Int -> Bool -> String -> String
bindByPos :: ErrorHandle -> StmtHandle -> Int -> CShort -> BufferPtr -> Int -> CInt -> IO ()
bindOutputByPos :: ErrorHandle -> StmtHandle -> Int -> BindBuffer -> Int -> CInt -> IO BindHandle
stmtFetch :: ErrorHandle -> StmtHandle -> IO CInt
maybeBufferNull :: ForeignPtr CShort -> Maybe a -> IO a -> IO (Maybe a)
nullByte :: CChar
cShort2Int :: CShort -> Int
cUShort2Int :: CUShort -> Int
cuCharToInt :: CUChar -> Int
byteToInt :: Ptr CUChar -> Int -> IO Int
bufferToString :: ColumnInfo -> IO (Maybe String)
makeYear :: Int -> Int -> Int
makeYearByte :: Int -> Word8
makeCentByte :: Int -> Word8
dumpBuffer :: Ptr Word8 -> IO ()
bufferToCaltime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CalendarTime)
bufferToUTCTime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe UTCTime)
setBufferByte :: BufferPtr -> Int -> Word8 -> IO ()
calTimeToBuffer :: BufferPtr -> CalendarTime -> IO ()
utcTimeToBuffer :: BufferPtr -> UTCTime -> IO ()
bufferPeekValue :: Storable a => BufferFPtr -> IO a
bufferToA :: Storable a => ForeignPtr CShort -> BufferFPtr -> IO (Maybe a)
bufferToCInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CInt)
bufferToInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Int)
bufferToCDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CDouble)
bufferToDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Double)
bufferToStmtHandle :: BufferFPtr -> IO StmtHandle
Documentation
data OCIStruct
  • Each handle type has its own data type, to prevent stupid errors i.e. using the wrong handle at the wrong time.
  • In GHC you can simply say data OCIStruct i.e. there's no need for = OCIStruct. I've decided to be more portable, as it doesn't cost much.
  • Use castPtr if you need to convert handles (say OCIHandle to a more specific type, or vice versa).
Constructors
OCIStruct
type OCIHandle = Ptr OCIStruct
data OCIBuffer
Constructors
OCIBuffer
type BufferPtr = Ptr OCIBuffer
type BufferFPtr = ForeignPtr OCIBuffer
type ColumnResultBuffer = ForeignPtr OCIBuffer
type BindBuffer = (ForeignPtr CShort, ForeignPtr OCIBuffer, ForeignPtr CUShort)
data Context
Constructors
Context
type ContextPtr = Ptr Context
data EnvStruct
Constructors
EnvStruct
type EnvHandle = Ptr EnvStruct
data ErrorStruct
Constructors
ErrorStruct
type ErrorHandle = Ptr ErrorStruct
data ServerStruct
Constructors
ServerStruct
type ServerHandle = Ptr ServerStruct
data UserStruct
Constructors
UserStruct
type UserHandle = Ptr UserStruct
data ConnStruct
Constructors
ConnStruct
type ConnHandle = Ptr ConnStruct
data SessStruct
Constructors
SessStruct
type SessHandle = Ptr SessStruct
data StmtStruct
Constructors
StmtStruct
type StmtHandle = Ptr StmtStruct
data DefnStruct
Constructors
DefnStruct
type DefnHandle = Ptr DefnStruct
data ParamStruct
Constructors
ParamStruct
type ParamHandle = Ptr ParamStruct
data BindStruct
Constructors
BindStruct
type BindHandle = Ptr BindStruct
type ColumnInfo = (DefnHandle, ColumnResultBuffer, ForeignPtr CShort, ForeignPtr CUShort)
data OCIException
Low-level, OCI library errors.
Constructors
OCIException CInt String
show/hide Instances
catchOCI :: IO a -> (OCIException -> IO a) -> IO a
throwOCI :: OCIException -> a
mkCInt :: Int -> CInt
mkCShort :: CInt -> CShort
mkCUShort :: CInt -> CUShort
cStrLen :: CStringLen -> CInt
cStr :: CStringLen -> CString
ociEnvCreate :: Ptr EnvHandle -> CInt -> Ptr a -> FunPtr a -> FunPtr a -> FunPtr a -> CInt -> Ptr (Ptr a) -> IO CInt
ociHandleAlloc :: OCIHandle -> Ptr OCIHandle -> CInt -> CInt -> Ptr a -> IO CInt
ociHandleFree :: OCIHandle -> CInt -> IO CInt
ociErrorGet :: OCIHandle -> CInt -> CString -> Ptr CInt -> CString -> CInt -> CInt -> IO CInt
ociParamGet :: OCIHandle -> CInt -> ErrorHandle -> Ptr OCIHandle -> CInt -> IO CInt
ociAttrGet :: OCIHandle -> CInt -> BufferPtr -> Ptr CInt -> CInt -> ErrorHandle -> IO CInt
ociAttrSet :: OCIHandle -> CInt -> BufferPtr -> CInt -> CInt -> ErrorHandle -> IO CInt
ociLogon :: EnvHandle -> ErrorHandle -> Ptr ConnHandle -> CString -> CInt -> CString -> CInt -> CString -> CInt -> IO CInt
ociLogoff :: ConnHandle -> ErrorHandle -> IO CInt
ociSessionBegin :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> CInt -> IO CInt
ociSessionEnd :: ConnHandle -> ErrorHandle -> SessHandle -> CInt -> IO CInt
ociServerAttach :: ServerHandle -> ErrorHandle -> CString -> CInt -> CInt -> IO CInt
ociServerDetach :: ServerHandle -> ErrorHandle -> CInt -> IO CInt
ociTerminate :: CInt -> IO CInt
ociTransStart :: ConnHandle -> ErrorHandle -> Word8 -> CInt -> IO CInt
ociTransCommit :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociTransRollback :: ConnHandle -> ErrorHandle -> CInt -> IO CInt
ociStmtPrepare :: StmtHandle -> ErrorHandle -> CString -> CInt -> CInt -> CInt -> IO CInt
ociDefineByPos :: StmtHandle -> Ptr DefnHandle -> ErrorHandle -> CInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CInt -> IO CInt
ociStmtExecute :: ConnHandle -> StmtHandle -> ErrorHandle -> CInt -> CInt -> OCIHandle -> OCIHandle -> CInt -> IO CInt
ociStmtFetch :: StmtHandle -> ErrorHandle -> CInt -> CShort -> CInt -> IO CInt
ociBindByPos :: StmtHandle -> Ptr BindHandle -> ErrorHandle -> CUInt -> BufferPtr -> CInt -> CUShort -> Ptr CShort -> Ptr CUShort -> Ptr CUShort -> CUInt -> Ptr CUInt -> CUInt -> IO CInt
ociBindDynamic :: BindHandle -> ErrorHandle -> ContextPtr -> FunPtr OCICallbackInBind -> ContextPtr -> FunPtr OCICallbackOutBind -> IO CInt
type OCICallbackInBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> CInt -> Ptr Word8 -> Ptr CShort -> IO CInt
type OCICallbackOutBind = ContextPtr -> BindHandle -> CInt -> CInt -> Ptr BufferPtr -> Ptr CInt -> Ptr Word8 -> Ptr CShort -> Ptr (Ptr CShort) -> IO CInt
mkOCICallbackInBind :: OCICallbackInBind -> IO (FunPtr OCICallbackInBind)
mkOCICallbackOutBind :: OCICallbackOutBind -> IO (FunPtr OCICallbackOutBind)
getOCIErrorMsg2 :: OCIHandle -> CInt -> Ptr CInt -> CString -> CInt -> IO (CInt, String)
This is just an auxiliary function for getOCIErrorMsg.
getOCIErrorMsg :: OCIHandle -> CInt -> IO (CInt, String)
fromEnumOCIErrorCode :: CInt -> String
formatErrorCodeDesc :: CInt -> String -> String
formatOCIMsg :: CInt -> String -> OCIHandle -> CInt -> IO (Int, String)
Given the two parts of an OCIException (the error number and text) get the actual error message from the DBMS and construct an error message from all of these pieces.
formatMsgCommon :: OCIException -> OCIHandle -> CInt -> IO (Int, String)
We have two format functions: formatEnvMsg takes the EnvHandle, formatErrorMsg takes the ErrorHandle. They're just type-safe wrappers for formatMsgCommon.
formatErrorMsg :: OCIException -> ErrorHandle -> IO (Int, String)
formatEnvMsg :: OCIException -> EnvHandle -> IO (Int, String)
testForError :: CInt -> String -> a -> IO a

The testForError functions are the only places where OCIException is thrown, so if you want to change or embellish it, your changes will be localised here. These functions factor out common error handling code from the OCI wrapper functions that follow.

Typically an OCI wrapper function would look like:

 handleAlloc handleType env = alloca ptr -> do
   rc <- ociHandleAlloc env ptr handleType 0 nullPtr
   if rc < 0
     then throwOCI (OCIException rc msg)
     else return ()

where the code from if rc < 0 onwards was identical. testForError replaces the code from if rc < 0 ... onwards.

testForErrorWithPtr :: Storable a => CInt -> String -> Ptr a -> IO a
Like testForError but when the value you want to return is at the end of a pointer. Either there was an error, in which case the pointer probably isn't valid, or there is something at the end of the pointer to return. See dbLogon and getHandleAttr for example usage.
envCreate :: IO EnvHandle
handleAlloc :: CInt -> OCIHandle -> IO OCIHandle
handleFree :: CInt -> OCIHandle -> IO ()
setHandleAttr :: ErrorHandle -> OCIHandle -> CInt -> Ptr a -> CInt -> IO ()
setHandleAttrString :: ErrorHandle -> OCIHandle -> CInt -> String -> CInt -> IO ()
getHandleAttr :: Storable a => ErrorHandle -> OCIHandle -> CInt -> CInt -> IO a
getParam :: ErrorHandle -> StmtHandle -> Int -> IO ParamHandle
dbLogon :: String -> String -> String -> EnvHandle -> ErrorHandle -> IO ConnHandle
The OCI Logon function doesn't behave as you'd expect when the password is due to expire. ociLogon returns oci_SUCCESS_WITH_INFO, but the ConnHandle returned is not valid. In this case we have to change oci_SUCCESS_WITH_INFO to oci_ERROR, so that the error handling code will catch it and abort. I don't know why the handle returned isn't valid, as the logon process should be able to complete successfully in this case.
dbLogoff :: ErrorHandle -> ConnHandle -> IO ()
terminate :: IO ()
serverDetach :: ErrorHandle -> ServerHandle -> IO ()
serverAttach :: ErrorHandle -> ServerHandle -> String -> IO ()
getSession :: ErrorHandle -> ConnHandle -> IO SessHandle
Having established a connection (Service Context), now get the Session. You can have more than one session per connection, but I haven't implemented it yet.
sessionBegin :: ErrorHandle -> ConnHandle -> SessHandle -> CInt -> IO ()
sessionEnd :: ErrorHandle -> ConnHandle -> SessHandle -> IO ()
beginTrans :: ErrorHandle -> ConnHandle -> CInt -> IO ()
commitTrans :: ErrorHandle -> ConnHandle -> IO ()
rollbackTrans :: ErrorHandle -> ConnHandle -> IO ()
stmtPrepare :: ErrorHandle -> StmtHandle -> String -> IO ()

With the OCI you do queries with these steps:

  • prepare your statement (it's just a String) - no communication with DBMS
  • execute it (this sends it to the DBMS for parsing etc)
  • allocate result set buffers by calling defineByPos for each column
  • call fetch for each row.
  • call handleFree for the StmtHandle (I assume this is the approved way of terminating the query; the OCI docs aren't explicit about this.)
stmtExecute :: ErrorHandle -> ConnHandle -> StmtHandle -> Int -> IO ()
defineByPos
:: ErrorHandle
-> StmtHandle
-> IntPosition
-> IntBuffer size in bytes
-> CIntSQL Datatype (from Database.Oracle.OCIConstants)
-> IO ColumnInfotuple: (DefnHandle, Ptr to buffer, Ptr to null indicator, Ptr to size of value in buffer)

defineByPos allocates memory for a single column value. The allocated components are:

  • the result (i.e. value) - you have to say how big with bufsize.
  • the null indicator (int16)
  • the size of the returned data (int16)

Previously it was the caller's responsibility to free the memory after they're done with it. Now we use mallocForeignPtr, so manual memory management is hopefully a thing of the past. The caller will also have to cast the data in bufferptr to the expected type (using castPtr).

sbph :: String -> Int -> Bool -> String -> String
bindByPos
:: ErrorHandle
-> StmtHandle
-> IntPosition
-> CShortNull ind: 0 == not null, -1 == null
-> BufferPtrpayload
-> Intpayload size in bytes
-> CIntSQL Datatype (from Database.Oracle.OCIConstants)
-> IO ()
bindOutputByPos
:: ErrorHandle
-> StmtHandle
-> IntPosition
-> BindBuffertriple of (null-ind, payload, output-size)
-> Intpayload input size in bytes
-> CIntSQL Datatype (from Database.Oracle.OCIConstants)
-> IO BindHandle
stmtFetch :: ErrorHandle -> StmtHandle -> IO CInt
Fetch a single row into the buffers. If you have specified a prefetch count > 1 then the row might already be cached by the OCI library.
maybeBufferNull :: ForeignPtr CShort -> Maybe a -> IO a -> IO (Maybe a)
Short-circuit null test: if the buffer contains a null then return Nothing. Otherwise, run the IO action to extract a value from the buffer and return Just it.
nullByte :: CChar
cShort2Int :: CShort -> Int
cUShort2Int :: CUShort -> Int
cuCharToInt :: CUChar -> Int
byteToInt :: Ptr CUChar -> Int -> IO Int
bufferToString :: ColumnInfo -> IO (Maybe String)
makeYear :: Int -> Int -> Int

Oracle's excess-something-or-other encoding for years: year = 100*(c - 100) + (y - 100), c = (year div 100) + 100, y = (year mod 100) + 100.

+1999 -> 119, 199 +0100 -> 101, 100 +0001 -> 100, 101 -0001 -> 100, 99 -0100 -> 99, 100 -1999 -> 81, 1

makeYearByte :: Int -> Word8
makeCentByte :: Int -> Word8
dumpBuffer :: Ptr Word8 -> IO ()
bufferToCaltime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CalendarTime)
bufferToUTCTime :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe UTCTime)
setBufferByte :: BufferPtr -> Int -> Word8 -> IO ()
calTimeToBuffer :: BufferPtr -> CalendarTime -> IO ()
utcTimeToBuffer :: BufferPtr -> UTCTime -> IO ()
bufferPeekValue :: Storable a => BufferFPtr -> IO a
bufferToA :: Storable a => ForeignPtr CShort -> BufferFPtr -> IO (Maybe a)
bufferToCInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CInt)
bufferToInt :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Int)
bufferToCDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe CDouble)
bufferToDouble :: ForeignPtr CShort -> BufferFPtr -> IO (Maybe Double)
bufferToStmtHandle :: BufferFPtr -> IO StmtHandle
Produced by Haddock version 0.7