module Database.PostgreSQL.PQTypes.Internal.Utils (
mread
, safePeekCString
, safePeekCString'
, cStringLenToBytea
, byteaToCStringLen
, bsToCString
, verifyPQTRes
, withPGparam
, throwQueryError
, throwLibPQError
, throwLibPQTypesError
, rethrowWithArrayError
, hpqTypesError
, unexpectedNULL
) where
import Control.Applicative
import Control.Monad
import Data.ByteString (ByteString)
import Data.ByteString.Unsafe
import Foreign.C
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import Foreign.Ptr
import Foreign.Storable
import qualified Control.Exception as E
import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Error
import Database.PostgreSQL.PQTypes.Internal.Error.Code
mread :: Read a => String -> Maybe a
mread s = do
[(a, "")] <- Just (reads s)
Just a
safePeekCString :: CString -> IO (Maybe String)
safePeekCString cs
| cs == nullPtr = return Nothing
| otherwise = Just <$> peekCString cs
safePeekCString' :: CString -> IO String
safePeekCString' cs = maybe "" id <$> safePeekCString cs
cStringLenToBytea :: CStringLen -> PGbytea
cStringLenToBytea (cs, len) = PGbytea {
pgByteaLen = fromIntegral len
, pgByteaData = cs
}
byteaToCStringLen :: PGbytea -> CStringLen
byteaToCStringLen PGbytea{..} = (pgByteaData, fromIntegral pgByteaLen)
bsToCString :: ByteString -> IO (ForeignPtr CChar)
bsToCString bs = unsafeUseAsCStringLen bs $ \(cs, len) -> do
fptr <- mallocForeignPtrBytes (len + 1)
withForeignPtr fptr $ \ptr -> do
copyBytes ptr cs len
pokeByteOff ptr len (0::CChar)
return fptr
verifyPQTRes :: Ptr PGerror -> String -> CInt -> IO ()
verifyPQTRes err ctx 0 = throwLibPQTypesError err ctx
verifyPQTRes _ _ _ = return ()
withPGparam :: Ptr PGconn -> (Ptr PGparam -> IO r) -> IO r
withPGparam conn = E.bracket create c_PQparamClear
where
create = alloca $ \err -> do
param <- c_PQparamCreate conn err
when (param == nullPtr) $
throwLibPQTypesError err "withPGparam.create"
return param
throwQueryError :: Ptr PGconn -> Ptr PGresult -> IO a
throwQueryError conn res = if res == nullPtr
then E.throwIO . QueryError =<< safePeekCString' =<< c_PQerrorMessage conn
else E.throwIO =<< DetailedQueryError
<$> field c_PG_DIAG_SEVERITY
<*> (stringToErrorCode <$> field c_PG_DIAG_SQLSTATE)
<*> field c_PG_DIAG_MESSAGE_PRIMARY
<*> mfield c_PG_DIAG_MESSAGE_DETAIL
<*> mfield c_PG_DIAG_MESSAGE_HINT
<*> ((mread =<<) <$> mfield c_PG_DIAG_STATEMENT_POSITION)
<*> ((mread =<<) <$> mfield c_PG_DIAG_INTERNAL_POSITION)
<*> mfield c_PG_DIAG_INTERNAL_QUERY
<*> mfield c_PG_DIAG_CONTEXT
<*> mfield c_PG_DIAG_SOURCE_FILE
<*> ((mread =<<) <$> mfield c_PG_DIAG_SOURCE_LINE)
<*> mfield c_PG_DIAG_SOURCE_FUNCTION
where
field f = maybe "" id <$> mfield f
mfield f = safePeekCString =<< c_PQresultErrorField res f
throwLibPQError :: Ptr PGconn -> String -> IO a
throwLibPQError conn ctx = do
msg <- safePeekCString' =<< c_PQerrorMessage conn
E.throwIO . LibPQError
$ if null ctx then msg else ctx ++ ": " ++ msg
throwLibPQTypesError :: Ptr PGerror -> String -> IO a
throwLibPQTypesError err ctx = do
msg <- pgErrorMsg <$> peek err
E.throwIO . LibPQError
$ if null ctx then msg else ctx ++ ": " ++ msg
rethrowWithArrayError :: CInt -> E.SomeException -> IO a
rethrowWithArrayError i (E.SomeException e) =
E.throwIO ArrayItemError {
arrItemIndex = fromIntegral i + 1
, arrItemError = e
}
hpqTypesError :: String -> IO a
hpqTypesError = E.throwIO . HPQTypesError
unexpectedNULL :: IO a
unexpectedNULL = hpqTypesError "unexpected NULL"