diff --git a/sednaDBXML.cabal b/sednaDBXML.cabal --- a/sednaDBXML.cabal +++ b/sednaDBXML.cabal @@ -1,5 +1,5 @@ Name: sednaDBXML -Version: 0.1.2.3 +Version: 0.1.2.4 License: GPL-3 Cabal-Version: >= 1.10.0 License-File: LICENSE @@ -16,14 +16,14 @@ Extra-Source-Files: include/libsedna.h include/sp_defs.h - LICENSE, + LICENSE, licenses/sedna_headers/LICENSE, test/fixtures/baseballleague.xml, test/runTests.sh, test/sedna-testsuite.cabal, test/suite/Integration/SednaBindingTests.hs, test/suite/TestSuite.hs, - README + README Library Hs-Source-Dirs: src @@ -35,17 +35,20 @@ iteratee >= 0.8, mtl - Exposed-Modules: Database.SednaDB.SednaBindings - Database.SednaDB.SednaExceptions - Database.SednaDB.SednaTypes - Database.SednaDB.Internal.SednaCBindings - Database.SednaDB.Internal.SednaConnectionAttributes - Database.SednaDB.Internal.SednaResponseCodes - Database.SednaDB.Internal.SpDefs + Exposed-Modules: Database.SednaBindings + Database.SednaExceptions + Database.SednaTypes + Database.Sedna + Database.Internal.SednaCBindings + Database.Internal.SednaConnectionAttributes + Database.Internal.SednaResponseCodes + Database.Internal.SpDefs Include-Dirs: include Includes: libsedna.h, sp_defs.h + + Extra-Libraries: sedna Ghc-Options: -Wall @@ -54,4 +57,4 @@ Source-Repository Head type: git - location: git@github.com:ExternalReality/SednaDBXML.git + location: git@github.com:ExternalReality/XML.git diff --git a/src/Database/Internal/SednaCBindings.hsc b/src/Database/Internal/SednaCBindings.hsc new file mode 100644 --- /dev/null +++ b/src/Database/Internal/SednaCBindings.hsc @@ -0,0 +1,105 @@ +#include +#include + +-------------------------------------------------------------------------------- +module Database.Internal.SednaCBindings where + +-------------------------------------------------------------------------------- +import Foreign +import Foreign.C.Types +import Foreign.C.String + +import Database.Internal.SpDefs + +-------------------------------------------------------------------------------- +#num QUERY_EXECUTION_TIME +#num BULK_LOAD_PORTION + +-------------------------------------------------------------------------------- +#starttype struct conn_bulk_load +#field bulk_load_started , CChar +#array_field doc_name , CChar +#array_field col_name , CChar +#stoptype + +-------------------------------------------------------------------------------- +#callback debug_handler_t, FunPtr ( -> CString -> IO ()) + +-------------------------------------------------------------------------------- +#starttype struct SednaConnection +#array_field url , CChar +#array_field db_name , CChar +#array_field login , CChar +#array_field password , CChar +#array_field session_directory , CChar +#field socket , CInt + +#field last_error , CInt +#array_field last_error_msg , CChar +#array_field query_time , CChar + +#field socket_keeps_data , CChar +#field first_next , CChar +#field result_end , CChar +#field in_query , CChar +#field cbl , + +#field isInTransaction , CInt +#field isConnectionOk , CInt + +#field autocommit , CInt + +#field local_data_length , CInt +#field local_data_offset , CInt +#array_field local_data_buf , CChar + +#field msg , + +#field debug_handler , + +#field boundary_space_preserve , CChar +#field query_timeout , CInt +#field max_result_size , CInt +#stoptype + +-------------------------------------------------------------------------------- +#ccall SEconnect, Ptr -> CString -> CString -> CString -> CString -> IO CInt +#ccall SEclose, Ptr -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEbegin, Ptr -> IO CInt +#ccall SErollback, Ptr -> IO CInt +#ccall SEcommit, Ptr -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEexecuteLong, Ptr -> CString -> IO CInt +#ccall SEexecute, Ptr -> CString -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEgetData, Ptr -> CString -> CInt -> IO CInt +#ccall SEloadData, Ptr -> CString -> CInt -> CString -> CString -> IO CInt +#ccall SEendLoadData, Ptr -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEnext, Ptr -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEgetLastErrorCode, Ptr -> IO CInt +#ccall SEgetLastErrorMsg, Ptr -> IO CString + +-------------------------------------------------------------------------------- +#ccall SEconnectionStatus, Ptr -> IO CInt +#ccall SEtransactionStatus, Ptr -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEshowTime , Ptr -> IO CString + +-------------------------------------------------------------------------------- +#ccall SEsetConnectionAttr, Ptr -> CUInt -> Ptr () -> CInt -> IO CInt +#ccall SEgetConnectionAttr, Ptr -> CUInt -> Ptr () -> Ptr CInt -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEresetAllConnectionAttr, Ptr -> IO CInt + +-------------------------------------------------------------------------------- +#ccall SEsetDebugHandler, Ptr -> -> Ptr () diff --git a/src/Database/Internal/SednaConnectionAttributes.hsc b/src/Database/Internal/SednaConnectionAttributes.hsc new file mode 100644 --- /dev/null +++ b/src/Database/Internal/SednaConnectionAttributes.hsc @@ -0,0 +1,33 @@ +module Database.Internal.SednaConnectionAttributes where + +import Foreign.C.Types + +#include +#include + +newtype SednaConnectionAttr = SednaConnectionAttr { sednaConnectionAttr :: CInt } deriving(Eq, Ord, Show) +newtype SednaConnAttrValue = SednaConnAttrValue { sednaConnAttrValue :: CInt } deriving(Eq, Ord, Show) + +#{enum SednaConnectionAttr, SednaConnectionAttr + , attrAutoCommit = SEDNA_ATTR_AUTOCOMMIT + , attrSessionDirectory = SEDNA_ATTR_SESSION_DIRECTORY + , attrDebug = SEDNA_ATTR_DEBUG + , attrBoundarySpacePreserveWhileLoad = SEDNA_ATTR_BOUNDARY_SPACE_PRESERVE_WHILE_LOAD + , attrConcurrencyType = SEDNA_ATTR_CONCURRENCY_TYPE + , attrQueryExecTimeOut = SEDNA_ATTR_QUERY_EXEC_TIMEOUT + , attrLogAmount = SEDNA_ATTR_LOG_AMOUNT + , attrMaxResultSize = SEDNA_ATTR_MAX_RESULT_SIZE + } + +#{enum SednaConnAttrValue, SednaConnAttrValue + , autoCommitOff = SEDNA_AUTOCOMMIT_OFF + , autoCommitOn = SEDNA_AUTOCOMMIT_ON + , readOnlyTransaction = SEDNA_READONLY_TRANSACTION + , updateTransaction = SEDNA_UPDATE_TRANSACTION + , debugOn = SEDNA_DEBUG_ON + , debugOff = SEDNA_DEBUG_OFF + , logLess = SEDNA_LOG_LESS + , logFull = SEDNA_LOG_FULL + , boundarySpacePreserveOn = SEDNA_BOUNDARY_SPACE_PRESERVE_ON + , boundarySpacePreserveOff = SEDNA_BOUNDARY_SPACE_PRESERVE_OFF + } diff --git a/src/Database/Internal/SednaResponseCodes.hsc b/src/Database/Internal/SednaResponseCodes.hsc new file mode 100644 --- /dev/null +++ b/src/Database/Internal/SednaResponseCodes.hsc @@ -0,0 +1,115 @@ +module Database.Internal.SednaResponseCodes where + +-------------------------------------------------------------------------------- +import Foreign.C.Types + +-------------------------------------------------------------------------------- +#include + +-------------------------------------------------------------------------------- +data SednaResponseCode = OperationSucceeded + | SessionOpen + | SessionClosed + | AuthenticationFailed + | OpenSessionFailed + | CloseSessionFailed + | QuerySucceeded + | QueryFailed + | UpdateSucceeded + | UpdateFailed + | BulkLoadSucceeded + | BulkLoadFailed + | BeginTransactionSucceeded + | BeginTransactionFailed + | RollBackTansactionSucceeded + | RollBackTransactionFailed + | CommitTransactionSucceeded + | CommitTransactionFailed + | NextItemSucceeded + | NextItemFailed + | NoItem + | ResultEnd + | DataChunkLoaded + | SednaError + | TransactionActive + | NoTransaction + | ConnectionOK + | ConnectionClosed + | ConnectionFailed + | SetAttributeSucceeded + | GetAttributeSucceeded + | ResetAttributeSucceeded + deriving ( Eq, Show ) + +-------------------------------------------------------------------------------- +fromCConstant :: CInt -> SednaResponseCode +fromCConstant x = case x of + #{const SEDNA_OPERATION_SUCCEEDED} -> OperationSucceeded + #{const SEDNA_SESSION_OPEN} -> SessionOpen + #{const SEDNA_SESSION_CLOSED} -> SessionClosed + #{const SEDNA_AUTHENTICATION_FAILED} -> AuthenticationFailed + #{const SEDNA_OPEN_SESSION_FAILED} -> OpenSessionFailed + #{const SEDNA_CLOSE_SESSION_FAILED} -> CloseSessionFailed + #{const SEDNA_QUERY_SUCCEEDED} -> QuerySucceeded + #{const SEDNA_QUERY_FAILED} -> QueryFailed + #{const SEDNA_UPDATE_SUCCEEDED} -> UpdateSucceeded + #{const SEDNA_UPDATE_FAILED} -> UpdateFailed + #{const SEDNA_BULK_LOAD_SUCCEEDED} -> BulkLoadSucceeded + #{const SEDNA_BULK_LOAD_FAILED} -> BulkLoadFailed + #{const SEDNA_BEGIN_TRANSACTION_SUCCEEDED} -> BeginTransactionSucceeded + #{const SEDNA_BEGIN_TRANSACTION_FAILED} -> BeginTransactionFailed + #{const SEDNA_ROLLBACK_TRANSACTION_SUCCEEDED} -> RollBackTansactionSucceeded + #{const SEDNA_ROLLBACK_TRANSACTION_FAILED} -> RollBackTransactionFailed + #{const SEDNA_COMMIT_TRANSACTION_SUCCEEDED} -> CommitTransactionSucceeded + #{const SEDNA_COMMIT_TRANSACTION_FAILED} -> CommitTransactionFailed + #{const SEDNA_NEXT_ITEM_SUCCEEDED} -> NextItemSucceeded + #{const SEDNA_NEXT_ITEM_FAILED} -> NextItemFailed + #{const SEDNA_NO_ITEM} -> NoItem + #{const SEDNA_RESULT_END} -> ResultEnd + #{const SEDNA_DATA_CHUNK_LOADED} -> DataChunkLoaded + #{const SEDNA_ERROR} -> SednaError + #{const SEDNA_TRANSACTION_ACTIVE} -> TransactionActive + #{const SEDNA_NO_TRANSACTION} -> NoTransaction + #{const SEDNA_CONNECTION_OK} -> ConnectionOK + #{const SEDNA_CONNECTION_CLOSED} -> ConnectionClosed + #{const SEDNA_CONNECTION_FAILED} -> ConnectionFailed + #{const SEDNA_SET_ATTRIBUTE_SUCCEEDED} -> SetAttributeSucceeded + #{const SEDNA_GET_ATTRIBUTE_SUCCEEDED} -> GetAttributeSucceeded + #{const SEDNA_RESET_ATTRIBUTES_SUCCEEDED} -> ResetAttributeSucceeded + _ -> error "Undefined Constant" + +-------------------------------------------------------------------------------- +toCConstant :: (Integral a) => SednaResponseCode -> a +toCConstant x = case x of + OperationSucceeded -> #{const SEDNA_OPERATION_SUCCEEDED} + SessionOpen -> #{const SEDNA_SESSION_OPEN} + SessionClosed -> #{const SEDNA_SESSION_CLOSED} + AuthenticationFailed -> #{const SEDNA_AUTHENTICATION_FAILED} + OpenSessionFailed -> #{const SEDNA_OPEN_SESSION_FAILED} + CloseSessionFailed -> #{const SEDNA_CLOSE_SESSION_FAILED} + QuerySucceeded -> #{const SEDNA_QUERY_SUCCEEDED} + QueryFailed -> #{const SEDNA_QUERY_FAILED} + UpdateSucceeded -> #{const SEDNA_UPDATE_SUCCEEDED} + UpdateFailed -> #{const SEDNA_UPDATE_FAILED} + BulkLoadSucceeded -> #{const SEDNA_BULK_LOAD_SUCCEEDED} + BulkLoadFailed -> #{const SEDNA_BULK_LOAD_FAILED} + BeginTransactionSucceeded -> #{const SEDNA_BEGIN_TRANSACTION_SUCCEEDED} + BeginTransactionFailed -> #{const SEDNA_BEGIN_TRANSACTION_FAILED} + RollBackTansactionSucceeded -> #{const SEDNA_ROLLBACK_TRANSACTION_SUCCEEDED} + RollBackTransactionFailed -> #{const SEDNA_ROLLBACK_TRANSACTION_FAILED} + CommitTransactionSucceeded -> #{const SEDNA_COMMIT_TRANSACTION_SUCCEEDED} + CommitTransactionFailed -> #{const SEDNA_COMMIT_TRANSACTION_FAILED} + NextItemSucceeded -> #{const SEDNA_NEXT_ITEM_SUCCEEDED} + NextItemFailed -> #{const SEDNA_NEXT_ITEM_FAILED} + NoItem -> #{const SEDNA_NO_ITEM} + ResultEnd -> #{const SEDNA_RESULT_END} + DataChunkLoaded -> #{const SEDNA_DATA_CHUNK_LOADED} + SednaError -> #{const SEDNA_ERROR} + TransactionActive -> #{const SEDNA_TRANSACTION_ACTIVE} + NoTransaction -> #{const SEDNA_NO_TRANSACTION} + ConnectionOK -> #{const SEDNA_CONNECTION_OK} + ConnectionClosed -> #{const SEDNA_CONNECTION_CLOSED} + ConnectionFailed -> #{const SEDNA_CONNECTION_FAILED} + SetAttributeSucceeded -> #{const SEDNA_SET_ATTRIBUTE_SUCCEEDED} + GetAttributeSucceeded -> #{const SEDNA_GET_ATTRIBUTE_SUCCEEDED} + ResetAttributeSucceeded -> #{const SEDNA_RESET_ATTRIBUTES_SUCCEEDED} diff --git a/src/Database/Internal/SpDefs.hsc b/src/Database/Internal/SpDefs.hsc new file mode 100644 --- /dev/null +++ b/src/Database/Internal/SpDefs.hsc @@ -0,0 +1,33 @@ +#include +#include + +-------------------------------------------------------------------------------- + +module Database.Internal.SpDefs where + +-------------------------------------------------------------------------------- + +import Foreign +import Foreign.C.Types + +-------------------------------------------------------------------------------- + +#num SEDNA_MAX_RESULT_SIZE + +-------------------------------------------------------------------------------- + +#integral_t enum se_debug_info_type +#num se_QueryTrace +#num se_QueryDebug + +-------------------------------------------------------------------------------- + +#integral_t sp_int32 + +-------------------------------------------------------------------------------- + +#starttype struct msg_struct +#field instruction , +#field length , +#array_field body , CChar +#stoptype diff --git a/src/Database/Sedna.hs b/src/Database/Sedna.hs new file mode 100644 --- /dev/null +++ b/src/Database/Sedna.hs @@ -0,0 +1,34 @@ +module Database.Sedna where + +import Database.SednaBindings +import Database.SednaTypes +import Control.Exception +import Data.ByteString.Char8 + +------------------------------------------------------------------------------- +withTransaction :: SednaConnection -> (SednaConnection -> IO a) -> IO a +withTransaction conn func = + do + sednaBegin conn + r <- onException (func conn) doRollback + sednaCommit conn + return r + where doRollback = + Control.Exception.catch (sednaRollBack conn) doRollbackHandler + + -- Discard any exception from (sednaRollBack conn) so original + -- exception can be re-raised + doRollbackHandler :: SomeException -> IO () + doRollbackHandler _ = return () + + +------------------------------------------------------------------------------- +loadXMLFile :: SednaConnection -> FilePath -> Document -> Collection -> IO () +loadXMLFile conn path doc coll = withTransaction conn $ + (\conn' -> sednaLoadFile conn' path doc coll) + + +------------------------------------------------------------------------------- +loadString conn str doc coll = + withTransaction conn $ (\conn' -> sednaLoadData conn' (pack str) doc coll) + diff --git a/src/Database/SednaBindings.hs b/src/Database/SednaBindings.hs new file mode 100644 --- /dev/null +++ b/src/Database/SednaBindings.hs @@ -0,0 +1,364 @@ +module Database.SednaBindings + ( sednaBegin + , sednaCloseConnection + , sednaCommit + , sednaConnect + , sednaEndLoadData + , sednaExecute + , sednaExecuteLong + , sednaGetConnectionAttr + , sednaGetData + , sednaGetLastErrorCode + , sednaGetLastErrorMsg + , sednaGetResultString + , sednaNext + , sednaResetAllConnectionAttr + , sednaRollBack + , sednaSetConnectionAttr + , sednaShowTime + , sednaTransactionStatus + , sednaLoadFile + , sednaLoadData + ) where + + +-------------------------------------------------------------------------------- +import Control.Exception +import Control.Monad.Trans +import Data.ByteString as BS +import Data.ByteString.Char8 as C +import Data.Iteratee as I hiding (mapM_, peek) +import Data.Iteratee.IO +import Data.Maybe +import Foreign +import Foreign.C.String +import Foreign.C.Types +import Prelude hiding (replicate,concat) +import qualified Data.Map as DM (fromList, lookup) + +import Database.Internal.SednaCBindings +import Database.Internal.SednaConnectionAttributes +import Database.Internal.SednaResponseCodes +import Database.SednaExceptions +import Database.SednaTypes + + +-------------------------------------------------------------------------------- +sednaConnect :: URL + -> DBName + -> UserName + -> Password + -> IO SednaConnection +sednaConnect url dbname login password = + do + conn <- malloc + cUrl <- newCString url + cDbname <- newCString dbname + cLogin <- newCString login + cPassword <- newCString password + status <- c'SEconnect conn + cUrl + cDbname + cLogin + cPassword + + mapM_ free [cUrl,cDbname,cLogin,cPassword] + + case fromCConstant status of + SessionOpen -> return $ conn + OpenSessionFailed -> free conn >> throw SednaOpenSessionFailedException + AuthenticationFailed -> free conn >> throw SednaAuthenticationFailedException + _ -> free conn >> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaCloseConnection :: SednaConnection -> IO () +sednaCloseConnection conn = do + resultCode <- c'SEclose conn + free conn + case fromCConstant resultCode of + SessionClosed -> return () + CloseSessionFailed -> throw SednaCloseSessionFailedException + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaBegin :: SednaConnection -> IO () +sednaBegin conn = do + resultCode <- c'SEbegin conn + case fromCConstant resultCode of + BeginTransactionSucceeded -> return () + BeginTransactionFailed -> throw SednaBeginTransactionFailedException + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaRollBack :: SednaConnection -> IO () +sednaRollBack conn = do + resultCode <- c'SErollback conn + case fromCConstant resultCode of + RollBackTansactionSucceeded -> return () + RollBackTransactionFailed -> throw SednaRollBackTransactionFailedException + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaCommit :: SednaConnection -> IO () +sednaCommit conn = do + resultCode <- c'SEcommit conn + case fromCConstant resultCode of + CommitTransactionSucceeded -> return () + CommitTransactionFailed -> throw SednaCommitTransactionFailedException + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaExecuteAction :: (SednaConnection -> CString -> IO CInt) + -> SednaConnection + -> Query + -> IO () +sednaExecuteAction sednaQueryAction conn query = do + resultCode <- withCString query $ sednaQueryAction conn + case fromCConstant resultCode of + QuerySucceeded -> return () + QueryFailed -> throw SednaQueryFailedException + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaExecuteLong :: SednaConnection -> Query -> IO () +sednaExecuteLong = sednaExecuteAction c'SEexecuteLong + + +-------------------------------------------------------------------------------- +sednaExecute :: SednaConnection -> Query -> IO () +sednaExecute = sednaExecuteAction c'SEexecute + + +-------------------------------------------------------------------------------- +sednaGetData :: SednaConnection -> Int -> IO (SednaResponseCode, ByteString) +sednaGetData conn size = useAsCStringLen (BS.replicate size 0) loadData + where + loadData bufferLengthPair = do + let buff = fst bufferLengthPair + let size' = fromIntegral (snd bufferLengthPair) + + numOfBytesRead <- c'SEgetData conn buff size' + response <- return $ getResponse numOfBytesRead size' + bytes <- packCStringLen (buff, fromIntegral numOfBytesRead) + + return $ (response, bytes) + where + getResponse num buffSize | num > buffSize = SednaError + | num < 0 = fromCConstant num + | num == 0 = ResultEnd + | num > 0 = OperationSucceeded + | otherwise = SednaError + + +-------------------------------------------------------------------------------- +sednaLoadData :: SednaConnection + -> ByteString + -> Document + -> Collection + -> IO () +sednaLoadData conn buff docName colName = do + useAsCStringLen buff loadData + where + loadData s = do + let buff' = fst s + let bytes = fromIntegral $ snd s + cDocName <- newCString docName + cColName <- newCString colName + response <- c'SEloadData conn buff' bytes cDocName cColName + mapM_ free [cDocName, cColName] + case fromCConstant response of + DataChunkLoaded -> return () + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaEndLoadData :: SednaConnection -> IO () +sednaEndLoadData conn = do + resultCode <- c'SEendLoadData conn + + case fromCConstant resultCode of + BulkLoadSucceeded -> return () + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaNext :: SednaConnection -> IO SednaResponseCode +sednaNext conn = do + resultCode <- c'SEnext conn + return $ fromCConstant resultCode + + +-------------------------------------------------------------------------------- +sednaGetLastErrorCode :: SednaConnection -> IO SednaResponseCode +sednaGetLastErrorCode conn = do + resultCode <- c'SEgetLastErrorCode conn + return $ fromCConstant resultCode + + +-------------------------------------------------------------------------------- +sednaGetLastErrorMsg :: SednaConnection -> IO String +sednaGetLastErrorMsg conn = peekCAString =<< c'SEgetLastErrorMsg conn + + +-------------------------------------------------------------------------------- +sednaTransactionStatus :: SednaConnection -> IO SednaResponseCode +sednaTransactionStatus conn = do resultCode <- c'SEtransactionStatus conn + return $ fromCConstant resultCode + + +-------------------------------------------------------------------------------- +sednaShowTime :: SednaConnection -> IO String +sednaShowTime conn = peekCAString =<< c'SEshowTime conn + + +-------------------------------------------------------------------------------- +sednaConnectionAttributeMap :: SednaConnAttrValue -> Maybe SednaConnectionAttr +sednaConnectionAttributeMap attr = DM.lookup attr attrValToAttrMap + where + attrValToAttrMap = + DM.fromList [ (autoCommitOff , attrAutoCommit) + , (autoCommitOn , attrAutoCommit) + , (readOnlyTransaction , attrConcurrencyType) + , (updateTransaction , attrConcurrencyType) + , (debugOn , attrDebug) + , (debugOff , attrDebug) + , (logLess , attrLogAmount) + , (logFull , attrLogAmount) + , (boundarySpacePreserveOn , attrBoundarySpacePreserveWhileLoad) + , (boundarySpacePreserveOff , attrBoundarySpacePreserveWhileLoad) + ] + + +-------------------------------------------------------------------------------- +sednaSetConnectionAttr :: SednaConnection + -> SednaConnAttrValue + -> IO () +sednaSetConnectionAttr conn attrVal = + alloca (\ptrAttrVal -> do + let connAttr = fromIntegral $ + sednaConnectionAttr $ + fromJust (sednaConnectionAttributeMap attrVal) + let attr = sednaConnAttrValue attrVal + let size = fromIntegral $ sizeOf attr + poke ptrAttrVal attr + response <- c'SEsetConnectionAttr + conn + connAttr + (castPtr ptrAttrVal) + size + case fromCConstant response of + SetAttributeSucceeded -> return () + _ -> throw SednaFailedException) + + +-------------------------------------------------------------------------------- +sednaGetConnectionAttr :: SednaConnection + -> SednaConnectionAttr + -> IO SednaConnAttrValue +sednaGetConnectionAttr conn connAttr = + alloca (\sizePtr -> do + let attr = fromIntegral $ sednaConnectionAttr connAttr + responsePtr <- malloc :: IO (Ptr CInt) + resultCode <- c'SEgetConnectionAttr conn + attr + (castPtr responsePtr) + sizePtr + response <- peek (castPtr responsePtr) + + case fromCConstant resultCode of + GetAttributeSucceeded -> return (SednaConnAttrValue response) + _ -> throw SednaFailedException) + + +-------------------------------------------------------------------------------- +sednaResetAllConnectionAttr :: SednaConnection -> IO () +sednaResetAllConnectionAttr conn = do + resultCode <- c'SEresetAllConnectionAttr conn + case fromCConstant resultCode of + ResetAttributeSucceeded -> return () + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaGetResultString :: SednaConnection -> IO QueryResult +sednaGetResultString conn = procItemStream conn 8 getXMLData + + +-------------------------------------------------------------------------------- +getXMLData :: (Monad m) => Iteratee [ByteString] m QueryResult +getXMLData = icont (step C.empty) Nothing + where + step acc (Chunk bs) + | bs == [] = icont (step acc) Nothing + | otherwise = icont (step $ C.append acc (C.concat $ bs)) Nothing + step acc (EOF _) = idone (C.unpack acc) (EOF Nothing) + + +-------------------------------------------------------------------------------- +procItemStream :: SednaConnection -> Int -> Iteratee [ByteString] IO a -> IO a +procItemStream conn size iter = step iter + where step iter' = do + iter'' <- enumItemChunked conn size iter' >>= run + res <- sednaNext conn + case res of + NextItemSucceeded -> step iter'' + ResultEnd -> run iter'' + NextItemFailed -> throw SednaNextItemFailedException + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +enumItemChunked :: SednaConnection + -> Int + -> Iteratee [ByteString] IO a + -> IO (Iteratee ByteString IO (Iteratee [ByteString] IO a)) +enumItemChunked conn size = (enumItem conn size) . I.group size + + +-------------------------------------------------------------------------------- +enumItem :: SednaConnection -> Int -> Enumerator ByteString IO a +enumItem conn size = enumFromCallback cb () + where + cb () = do + (code, result) <- sednaGetData conn size + case code of + OperationSucceeded -> return $ Right ((True, ()), result) + ResultEnd -> return $ Right ((False, ()), result) + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +loadXMLBytes:: MonadIO m => SednaConnection + -> String + -> String + -> Iteratee ByteString m () +loadXMLBytes conn doc coll = liftIO (sednaBegin conn) >> liftI step + where + step (I.Chunk xs) + | xs == (C.pack "") = liftI step + | otherwise = do + liftIO $ sednaLoadData conn xs doc coll + liftI step + + step stream = do + response <- liftIO $ c'SEendLoadData conn + case fromCConstant response of + BulkLoadSucceeded -> liftIO (sednaCommit conn) >> idone () stream + BulkLoadFailed -> throw SednaBulkLoadFailedException + _ -> throw SednaFailedException + + +-------------------------------------------------------------------------------- +sednaLoadFile :: SednaConnection -> FilePath -> Document -> Collection -> IO () +sednaLoadFile conn file doc coll = do + iteratee <- enumFile 8 file $ loadXMLBytes + conn + doc + coll + run iteratee diff --git a/src/Database/SednaDB/Internal/SednaCBindings.hsc b/src/Database/SednaDB/Internal/SednaCBindings.hsc deleted file mode 100644 --- a/src/Database/SednaDB/Internal/SednaCBindings.hsc +++ /dev/null @@ -1,105 +0,0 @@ -#include -#include - --------------------------------------------------------------------------------- -module Database.SednaDB.Internal.SednaCBindings where - --------------------------------------------------------------------------------- -import Foreign -import Foreign.C.Types -import Foreign.C.String - -import Database.SednaDB.Internal.SpDefs - --------------------------------------------------------------------------------- -#num QUERY_EXECUTION_TIME -#num BULK_LOAD_PORTION - --------------------------------------------------------------------------------- -#starttype struct conn_bulk_load -#field bulk_load_started , CChar -#array_field doc_name , CChar -#array_field col_name , CChar -#stoptype - --------------------------------------------------------------------------------- -#callback debug_handler_t, FunPtr ( -> CString -> IO ()) - --------------------------------------------------------------------------------- -#starttype struct SednaConnection -#array_field url , CChar -#array_field db_name , CChar -#array_field login , CChar -#array_field password , CChar -#array_field session_directory , CChar -#field socket , CInt - -#field last_error , CInt -#array_field last_error_msg , CChar -#array_field query_time , CChar - -#field socket_keeps_data , CChar -#field first_next , CChar -#field result_end , CChar -#field in_query , CChar -#field cbl , - -#field isInTransaction , CInt -#field isConnectionOk , CInt - -#field autocommit , CInt - -#field local_data_length , CInt -#field local_data_offset , CInt -#array_field local_data_buf , CChar - -#field msg , - -#field debug_handler , - -#field boundary_space_preserve , CChar -#field query_timeout , CInt -#field max_result_size , CInt -#stoptype - --------------------------------------------------------------------------------- -#ccall SEconnect, Ptr -> CString -> CString -> CString -> CString -> IO CInt -#ccall SEclose, Ptr -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEbegin, Ptr -> IO CInt -#ccall SErollback, Ptr -> IO CInt -#ccall SEcommit, Ptr -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEexecuteLong, Ptr -> CString -> IO CInt -#ccall SEexecute, Ptr -> CString -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEgetData, Ptr -> CString -> CInt -> IO CInt -#ccall SEloadData, Ptr -> CString -> CInt -> CString -> CString -> IO CInt -#ccall SEendLoadData, Ptr -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEnext, Ptr -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEgetLastErrorCode, Ptr -> IO CInt -#ccall SEgetLastErrorMsg, Ptr -> IO CString - --------------------------------------------------------------------------------- -#ccall SEconnectionStatus, Ptr -> IO CInt -#ccall SEtransactionStatus, Ptr -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEshowTime , Ptr -> IO CString - --------------------------------------------------------------------------------- -#ccall SEsetConnectionAttr, Ptr -> CUInt -> Ptr () -> CInt -> IO CInt -#ccall SEgetConnectionAttr, Ptr -> CUInt -> Ptr () -> Ptr CInt -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEresetAllConnectionAttr, Ptr -> IO CInt - --------------------------------------------------------------------------------- -#ccall SEsetDebugHandler, Ptr -> -> Ptr () diff --git a/src/Database/SednaDB/Internal/SednaConnectionAttributes.hsc b/src/Database/SednaDB/Internal/SednaConnectionAttributes.hsc deleted file mode 100644 --- a/src/Database/SednaDB/Internal/SednaConnectionAttributes.hsc +++ /dev/null @@ -1,33 +0,0 @@ -module Database.SednaDB.Internal.SednaConnectionAttributes where - -import Foreign.C.Types - -#include -#include - -newtype SednaConnectionAttr = SednaConnectionAttr { sednaConnectionAttr :: CInt } deriving(Eq, Ord, Show) -newtype SednaConnAttrValue = SednaConnAttrValue { sednaConnAttrValue :: CInt } deriving(Eq, Ord, Show) - -#{enum SednaConnectionAttr, SednaConnectionAttr - , attrAutoCommit = SEDNA_ATTR_AUTOCOMMIT - , attrSessionDirectory = SEDNA_ATTR_SESSION_DIRECTORY - , attrDebug = SEDNA_ATTR_DEBUG - , attrBoundarySpacePreserveWhileLoad = SEDNA_ATTR_BOUNDARY_SPACE_PRESERVE_WHILE_LOAD - , attrConcurrencyType = SEDNA_ATTR_CONCURRENCY_TYPE - , attrQueryExecTimeOut = SEDNA_ATTR_QUERY_EXEC_TIMEOUT - , attrLogAmount = SEDNA_ATTR_LOG_AMOUNT - , attrMaxResultSize = SEDNA_ATTR_MAX_RESULT_SIZE - } - -#{enum SednaConnAttrValue, SednaConnAttrValue - , autoCommitOff = SEDNA_AUTOCOMMIT_OFF - , autoCommitOn = SEDNA_AUTOCOMMIT_ON - , readOnlyTransaction = SEDNA_READONLY_TRANSACTION - , updateTransaction = SEDNA_UPDATE_TRANSACTION - , debugOn = SEDNA_DEBUG_ON - , debugOff = SEDNA_DEBUG_OFF - , logLess = SEDNA_LOG_LESS - , logFull = SEDNA_LOG_FULL - , boundarySpacePreserveOn = SEDNA_BOUNDARY_SPACE_PRESERVE_ON - , boundarySpacePreserveOff = SEDNA_BOUNDARY_SPACE_PRESERVE_OFF - } diff --git a/src/Database/SednaDB/Internal/SednaResponseCodes.hsc b/src/Database/SednaDB/Internal/SednaResponseCodes.hsc deleted file mode 100644 --- a/src/Database/SednaDB/Internal/SednaResponseCodes.hsc +++ /dev/null @@ -1,115 +0,0 @@ -module Database.SednaDB.Internal.SednaResponseCodes where - --------------------------------------------------------------------------------- -import Foreign.C.Types - --------------------------------------------------------------------------------- -#include - --------------------------------------------------------------------------------- -data SednaResponseCode = OperationSucceeded - | SessionOpen - | SessionClosed - | AuthenticationFailed - | OpenSessionFailed - | CloseSessionFailed - | QuerySucceeded - | QueryFailed - | UpdateSucceeded - | UpdateFailed - | BulkLoadSucceeded - | BulkLoadFailed - | BeginTransactionSucceeded - | BeginTransactionFailed - | RollBackTansactionSucceeded - | RollBackTransactionFailed - | CommitTransactionSucceeded - | CommitTransactionFailed - | NextItemSucceeded - | NextItemFailed - | NoItem - | ResultEnd - | DataChunkLoaded - | SednaError - | TransactionActive - | NoTransaction - | ConnectionOK - | ConnectionClosed - | ConnectionFailed - | SetAttributeSucceeded - | GetAttributeSucceeded - | ResetAttributeSucceeded - deriving ( Eq, Show ) - --------------------------------------------------------------------------------- -fromCConstant :: CInt -> SednaResponseCode -fromCConstant x = case x of - #{const SEDNA_OPERATION_SUCCEEDED} -> OperationSucceeded - #{const SEDNA_SESSION_OPEN} -> SessionOpen - #{const SEDNA_SESSION_CLOSED} -> SessionClosed - #{const SEDNA_AUTHENTICATION_FAILED} -> AuthenticationFailed - #{const SEDNA_OPEN_SESSION_FAILED} -> OpenSessionFailed - #{const SEDNA_CLOSE_SESSION_FAILED} -> CloseSessionFailed - #{const SEDNA_QUERY_SUCCEEDED} -> QuerySucceeded - #{const SEDNA_QUERY_FAILED} -> QueryFailed - #{const SEDNA_UPDATE_SUCCEEDED} -> UpdateSucceeded - #{const SEDNA_UPDATE_FAILED} -> UpdateFailed - #{const SEDNA_BULK_LOAD_SUCCEEDED} -> BulkLoadSucceeded - #{const SEDNA_BULK_LOAD_FAILED} -> BulkLoadFailed - #{const SEDNA_BEGIN_TRANSACTION_SUCCEEDED} -> BeginTransactionSucceeded - #{const SEDNA_BEGIN_TRANSACTION_FAILED} -> BeginTransactionFailed - #{const SEDNA_ROLLBACK_TRANSACTION_SUCCEEDED} -> RollBackTansactionSucceeded - #{const SEDNA_ROLLBACK_TRANSACTION_FAILED} -> RollBackTransactionFailed - #{const SEDNA_COMMIT_TRANSACTION_SUCCEEDED} -> CommitTransactionSucceeded - #{const SEDNA_COMMIT_TRANSACTION_FAILED} -> CommitTransactionFailed - #{const SEDNA_NEXT_ITEM_SUCCEEDED} -> NextItemSucceeded - #{const SEDNA_NEXT_ITEM_FAILED} -> NextItemFailed - #{const SEDNA_NO_ITEM} -> NoItem - #{const SEDNA_RESULT_END} -> ResultEnd - #{const SEDNA_DATA_CHUNK_LOADED} -> DataChunkLoaded - #{const SEDNA_ERROR} -> SednaError - #{const SEDNA_TRANSACTION_ACTIVE} -> TransactionActive - #{const SEDNA_NO_TRANSACTION} -> NoTransaction - #{const SEDNA_CONNECTION_OK} -> ConnectionOK - #{const SEDNA_CONNECTION_CLOSED} -> ConnectionClosed - #{const SEDNA_CONNECTION_FAILED} -> ConnectionFailed - #{const SEDNA_SET_ATTRIBUTE_SUCCEEDED} -> SetAttributeSucceeded - #{const SEDNA_GET_ATTRIBUTE_SUCCEEDED} -> GetAttributeSucceeded - #{const SEDNA_RESET_ATTRIBUTES_SUCCEEDED} -> ResetAttributeSucceeded - _ -> error "Undefined Constant" - --------------------------------------------------------------------------------- -toCConstant :: (Integral a) => SednaResponseCode -> a -toCConstant x = case x of - OperationSucceeded -> #{const SEDNA_OPERATION_SUCCEEDED} - SessionOpen -> #{const SEDNA_SESSION_OPEN} - SessionClosed -> #{const SEDNA_SESSION_CLOSED} - AuthenticationFailed -> #{const SEDNA_AUTHENTICATION_FAILED} - OpenSessionFailed -> #{const SEDNA_OPEN_SESSION_FAILED} - CloseSessionFailed -> #{const SEDNA_CLOSE_SESSION_FAILED} - QuerySucceeded -> #{const SEDNA_QUERY_SUCCEEDED} - QueryFailed -> #{const SEDNA_QUERY_FAILED} - UpdateSucceeded -> #{const SEDNA_UPDATE_SUCCEEDED} - UpdateFailed -> #{const SEDNA_UPDATE_FAILED} - BulkLoadSucceeded -> #{const SEDNA_BULK_LOAD_SUCCEEDED} - BulkLoadFailed -> #{const SEDNA_BULK_LOAD_FAILED} - BeginTransactionSucceeded -> #{const SEDNA_BEGIN_TRANSACTION_SUCCEEDED} - BeginTransactionFailed -> #{const SEDNA_BEGIN_TRANSACTION_FAILED} - RollBackTansactionSucceeded -> #{const SEDNA_ROLLBACK_TRANSACTION_SUCCEEDED} - RollBackTransactionFailed -> #{const SEDNA_ROLLBACK_TRANSACTION_FAILED} - CommitTransactionSucceeded -> #{const SEDNA_COMMIT_TRANSACTION_SUCCEEDED} - CommitTransactionFailed -> #{const SEDNA_COMMIT_TRANSACTION_FAILED} - NextItemSucceeded -> #{const SEDNA_NEXT_ITEM_SUCCEEDED} - NextItemFailed -> #{const SEDNA_NEXT_ITEM_FAILED} - NoItem -> #{const SEDNA_NO_ITEM} - ResultEnd -> #{const SEDNA_RESULT_END} - DataChunkLoaded -> #{const SEDNA_DATA_CHUNK_LOADED} - SednaError -> #{const SEDNA_ERROR} - TransactionActive -> #{const SEDNA_TRANSACTION_ACTIVE} - NoTransaction -> #{const SEDNA_NO_TRANSACTION} - ConnectionOK -> #{const SEDNA_CONNECTION_OK} - ConnectionClosed -> #{const SEDNA_CONNECTION_CLOSED} - ConnectionFailed -> #{const SEDNA_CONNECTION_FAILED} - SetAttributeSucceeded -> #{const SEDNA_SET_ATTRIBUTE_SUCCEEDED} - GetAttributeSucceeded -> #{const SEDNA_GET_ATTRIBUTE_SUCCEEDED} - ResetAttributeSucceeded -> #{const SEDNA_RESET_ATTRIBUTES_SUCCEEDED} diff --git a/src/Database/SednaDB/Internal/SpDefs.hsc b/src/Database/SednaDB/Internal/SpDefs.hsc deleted file mode 100644 --- a/src/Database/SednaDB/Internal/SpDefs.hsc +++ /dev/null @@ -1,33 +0,0 @@ -#include -#include - --------------------------------------------------------------------------------- - -module Database.SednaDB.Internal.SpDefs where - --------------------------------------------------------------------------------- - -import Foreign -import Foreign.C.Types - --------------------------------------------------------------------------------- - -#num SEDNA_MAX_RESULT_SIZE - --------------------------------------------------------------------------------- - -#integral_t enum se_debug_info_type -#num se_QueryTrace -#num se_QueryDebug - --------------------------------------------------------------------------------- - -#integral_t sp_int32 - --------------------------------------------------------------------------------- - -#starttype struct msg_struct -#field instruction , -#field length , -#array_field body , CChar -#stoptype diff --git a/src/Database/SednaDB/SednaBindings.hs b/src/Database/SednaDB/SednaBindings.hs deleted file mode 100644 --- a/src/Database/SednaDB/SednaBindings.hs +++ /dev/null @@ -1,338 +0,0 @@ - - -module Database.SednaDB.SednaBindings - ( sednaBegin - , sednaCloseConnection - , sednaCommit - , sednaConnect - , sednaEndLoadData - , sednaExecute - , sednaExecuteLong - , sednaGetConnectionAttr - , sednaGetData - , sednaGetLastErrorCode - , sednaGetLastErrorMsg - , sednaGetResultString - , sednaNext - , sednaResetAllConnectionAttr - , sednaRollBack - , sednaSetConnectionAttr - , sednaShowTime - , sednaTransactionStatus - , sednaLoadFile - , sednaLoadData - ) where - --------------------------------------------------------------------------------- -import Data.ByteString as BS -import Data.Maybe -import Foreign -import Foreign.C.String -import Foreign.C.Types -import Prelude hiding (replicate,concat) -import qualified Data.Map as DM (fromList, lookup) -import Data.Iteratee as I hiding (mapM_, peek) -import Data.Iteratee.IO -import Control.Monad.Trans -import Data.ByteString.Char8 as C -import Control.Exception - -import Database.SednaDB.SednaTypes -import Database.SednaDB.Internal.SednaCBindings -import Database.SednaDB.Internal.SednaConnectionAttributes -import Database.SednaDB.Internal.SednaResponseCodes -import Database.SednaDB.SednaExceptions - --------------------------------------------------------------------------------- -sednaConnect :: URL - -> DBName - -> UserName - -> Password - -> IO SednaConnection -sednaConnect url dbname login password = - do - conn <- malloc - cUrl <- newCString url - cDbname <- newCString dbname - cLogin <- newCString login - cPassword <- newCString password - status <- c'SEconnect conn - cUrl - cDbname - cLogin - cPassword - - mapM_ free [cUrl,cDbname,cLogin,cPassword] - - case fromCConstant status of - SessionOpen -> return $ conn - OpenSessionFailed -> free conn >> throw SednaOpenSessionFailedException - AuthenticationFailed -> free conn >> throw SednaAuthenticationFailedException - _ -> free conn >> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaCloseConnection :: SednaConnection -> IO () -sednaCloseConnection conn = do - resultCode <- c'SEclose conn - free conn - case fromCConstant resultCode of - SessionClosed -> return () - CloseSessionFailed -> throw SednaCloseSessionFailedException - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaBegin :: SednaConnection -> IO () -sednaBegin conn = do - resultCode <- c'SEbegin conn - case fromCConstant resultCode of - BeginTransactionSucceeded -> return () - BeginTransactionFailed -> throw SednaBeginTransactionFailedException - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaRollBack :: SednaConnection -> IO () -sednaRollBack conn = do - resultCode <- c'SErollback conn - case fromCConstant resultCode of - RollBackTansactionSucceeded -> return () - RollBackTransactionFailed -> throw SednaRollBackTransactionFailedException - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaCommit :: SednaConnection -> IO () -sednaCommit conn = do - resultCode <- c'SEcommit conn - case fromCConstant resultCode of - CommitTransactionSucceeded -> return () - CommitTransactionFailed -> throw SednaCommitTransactionFailedException - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaExecuteAction :: (SednaConnection -> CString -> IO CInt) - -> SednaConnection - -> Query - -> IO () -sednaExecuteAction sednaQueryAction conn query = do - resultCode <- withCString query $ sednaQueryAction conn - case fromCConstant resultCode of - QuerySucceeded -> return () - QueryFailed -> throw SednaQueryFailedException - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaExecuteLong :: SednaConnection -> Query -> IO () -sednaExecuteLong = sednaExecuteAction c'SEexecuteLong - --------------------------------------------------------------------------------- -sednaExecute :: SednaConnection -> Query -> IO () -sednaExecute = sednaExecuteAction c'SEexecute - --------------------------------------------------------------------------------- -sednaGetData :: SednaConnection -> Int -> IO (SednaResponseCode, ByteString) -sednaGetData conn size = useAsCStringLen (BS.replicate size 0) loadData - where - loadData bufferLengthPair = do - let buff = fst bufferLengthPair - let size' = fromIntegral (snd bufferLengthPair) - - numOfBytesRead <- c'SEgetData conn buff size' - response <- return $ getResponse numOfBytesRead size' - bytes <- packCStringLen (buff, fromIntegral numOfBytesRead) - - return $ (response, bytes) - where - getResponse num buffSize | num > buffSize = SednaError - | num < 0 = fromCConstant num - | num == 0 = ResultEnd - | num > 0 = OperationSucceeded - | otherwise = SednaError - --------------------------------------------------------------------------------- -sednaLoadData :: SednaConnection - -> ByteString - -> Document - -> Collection - -> IO () -sednaLoadData conn buff docName colName = do - useAsCStringLen buff loadData - where - loadData s = do - let buff' = fst s - let bytes = fromIntegral $ snd s - cDocName <- newCString docName - cColName <- newCString colName - response <- c'SEloadData conn buff' bytes cDocName cColName - mapM_ free [cDocName, cColName] - case fromCConstant response of - DataChunkLoaded -> return () - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaEndLoadData :: SednaConnection -> IO () -sednaEndLoadData conn = do - resultCode <- c'SEendLoadData conn - - case fromCConstant resultCode of - BulkLoadSucceeded -> return () - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaNext :: SednaConnection -> IO SednaResponseCode -sednaNext conn = do - resultCode <- c'SEnext conn - return $ fromCConstant resultCode - --------------------------------------------------------------------------------- -sednaGetLastErrorCode :: SednaConnection -> IO SednaResponseCode -sednaGetLastErrorCode conn = do - resultCode <- c'SEgetLastErrorCode conn - return $ fromCConstant resultCode - --------------------------------------------------------------------------------- -sednaGetLastErrorMsg :: SednaConnection -> IO String -sednaGetLastErrorMsg conn = peekCAString =<< c'SEgetLastErrorMsg conn - --------------------------------------------------------------------------------- -sednaTransactionStatus :: SednaConnection -> IO SednaResponseCode -sednaTransactionStatus conn = do resultCode <- c'SEtransactionStatus conn - return $ fromCConstant resultCode - --------------------------------------------------------------------------------- -sednaShowTime :: SednaConnection -> IO String -sednaShowTime conn = peekCAString =<< c'SEshowTime conn - --------------------------------------------------------------------------------- -sednaConnectionAttributeMap :: SednaConnAttrValue -> Maybe SednaConnectionAttr -sednaConnectionAttributeMap attr = DM.lookup attr attrValToAttrMap - where - attrValToAttrMap = - DM.fromList [ (autoCommitOff , attrAutoCommit) - , (autoCommitOn , attrAutoCommit) - , (readOnlyTransaction , attrConcurrencyType) - , (updateTransaction , attrConcurrencyType) - , (debugOn , attrDebug) - , (debugOff , attrDebug) - , (logLess , attrLogAmount) - , (logFull , attrLogAmount) - , (boundarySpacePreserveOn , attrBoundarySpacePreserveWhileLoad) - , (boundarySpacePreserveOff , attrBoundarySpacePreserveWhileLoad) - ] - --------------------------------------------------------------------------------- -sednaSetConnectionAttr :: SednaConnection - -> SednaConnAttrValue - -> IO () -sednaSetConnectionAttr conn attrVal = - alloca (\ptrAttrVal -> do - let connAttr = fromIntegral $ - sednaConnectionAttr $ - fromJust (sednaConnectionAttributeMap attrVal) - let attr = sednaConnAttrValue attrVal - let size = fromIntegral $ sizeOf attr - poke ptrAttrVal attr - response <- c'SEsetConnectionAttr - conn - connAttr - (castPtr ptrAttrVal) - size - case fromCConstant response of - SetAttributeSucceeded -> return () - _ -> throw SednaFailedException) - --------------------------------------------------------------------------------- -sednaGetConnectionAttr :: SednaConnection - -> SednaConnectionAttr - -> IO SednaConnAttrValue -sednaGetConnectionAttr conn connAttr = - alloca (\sizePtr -> do - let attr = fromIntegral $ sednaConnectionAttr connAttr - responsePtr <- malloc :: IO (Ptr CInt) - resultCode <- c'SEgetConnectionAttr conn - attr - (castPtr responsePtr) - sizePtr - response <- peek (castPtr responsePtr) - - case fromCConstant resultCode of - GetAttributeSucceeded -> return (SednaConnAttrValue response) - _ -> throw SednaFailedException) - --------------------------------------------------------------------------------- -sednaResetAllConnectionAttr :: SednaConnection -> IO () -sednaResetAllConnectionAttr conn = do - resultCode <- c'SEresetAllConnectionAttr conn - case fromCConstant resultCode of - ResetAttributeSucceeded -> return () - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaGetResultString :: SednaConnection -> IO QueryResult -sednaGetResultString conn = procItemStream conn 8 getXMLData - --------------------------------------------------------------------------------- -getXMLData :: (Monad m) => Iteratee [ByteString] m QueryResult -getXMLData = icont (step C.empty) Nothing - where - step acc (Chunk bs) - | bs == [] = icont (step acc) Nothing - | otherwise = icont (step $ C.append acc (C.concat $ bs)) Nothing - step acc (EOF _) = idone (C.unpack acc) (EOF Nothing) - --------------------------------------------------------------------------------- -procItemStream :: SednaConnection -> Int -> Iteratee [ByteString] IO a -> IO a -procItemStream conn size iter = step iter - where step iter' = do - iter'' <- enumItemChunked conn size iter' >>= run - res <- sednaNext conn - case res of - NextItemSucceeded -> step iter'' - ResultEnd -> run iter'' - NextItemFailed -> throw SednaNextItemFailedException - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -enumItemChunked :: SednaConnection - -> Int - -> Iteratee [ByteString] IO a - -> IO (Iteratee ByteString IO (Iteratee [ByteString] IO a)) -enumItemChunked conn size = (enumItem conn size) . I.group size - --------------------------------------------------------------------------------- -enumItem :: SednaConnection -> Int -> Enumerator ByteString IO a -enumItem conn size = enumFromCallback cb () - where - cb () = do - (code, result) <- sednaGetData conn size - case code of - OperationSucceeded -> return $ Right ((True, ()), result) - ResultEnd -> return $ Right ((False, ()), result) - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -loadXMLBytes:: MonadIO m => SednaConnection - -> String - -> String - -> Iteratee ByteString m () -loadXMLBytes conn doc coll = liftIO (sednaBegin conn) >> liftI step - where - step (I.Chunk xs) - | xs == (C.pack "") = liftI step - | otherwise = do - liftIO $ sednaLoadData conn xs doc coll - liftI step - - step stream = do - response <- liftIO $ c'SEendLoadData conn - case fromCConstant response of - BulkLoadSucceeded -> liftIO (sednaCommit conn) >> idone () stream - BulkLoadFailed -> throw SednaBulkLoadFailedException - _ -> throw SednaFailedException - --------------------------------------------------------------------------------- -sednaLoadFile :: FilePath -> SednaConnection -> Document -> Collection -> IO () -sednaLoadFile file conn doc coll = do - iteratee <- enumFile 8 file $ loadXMLBytes - conn - doc - coll - run iteratee diff --git a/src/Database/SednaDB/SednaExceptions.hs b/src/Database/SednaDB/SednaExceptions.hs deleted file mode 100644 --- a/src/Database/SednaDB/SednaExceptions.hs +++ /dev/null @@ -1,211 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE ExistentialQuantification #-} - --------------------------------------------------------------------------------- -module Database.SednaDB.SednaExceptions - ( SednaAuthenticationFailedException (SednaAuthenticationFailedException) - , SednaBulkLoadFailedException (SednaBulkLoadFailedException) - , SednaOpenSessionFailedException (SednaOpenSessionFailedException) - , SednaCloseSessionFailedException (SednaCloseSessionFailedException) - , SednaCommitTransactionFailedException (SednaCommitTransactionFailedException) - , SednaFailedException (SednaFailedException) - , SednaNextItemFailedException (SednaNextItemFailedException) - , SednaRollBackTransactionFailedException (SednaRollBackTransactionFailedException) - , SednaTransactionException (SednaTransactionException) - , SednaBeginTransactionFailedException (SednaBeginTransactionFailedException) - , SednaException (SednaException) - , SednaQueryException (SednaQueryException) - , SednaQueryFailedException (SednaQueryFailedException) - , SednaUpdateFailedException (SednaUpdateFailedException) - ) where - --------------------------------------------------------------------------------- -import Control.Exception -import Data.Typeable - --------------------------------------------------------------------------------- -data SednaException = - forall e . Exception e => SednaException e - deriving Typeable - -instance Show SednaException where - show (SednaException e) = show e - -instance Exception SednaException where - -sednaExceptionToException :: Exception e => e -> SomeException -sednaExceptionToException = toException . SednaException - -sednaExceptionFromException :: Exception e => SomeException -> Maybe e -sednaExceptionFromException x = do - SednaException a <- fromException x - cast a - --------------------------------------------------------------------------------- -data SednaFailedException = - SednaFailedException - deriving (Typeable, Show) - -instance Exception SednaFailedException where - toException = sednaExceptionToException - fromException = sednaExceptionFromException - --------------------------------------------------------------------------------- -data SednaBulkLoadFailedException = - SednaBulkLoadFailedException - deriving (Typeable, Show) - -instance Exception SednaBulkLoadFailedException where - toException = sednaExceptionToException - fromException = sednaExceptionFromException - --------------------------------------------------------------------------------- -data SednaNextItemFailedException = - SednaNextItemFailedException - deriving (Typeable, Show) - -instance Exception SednaNextItemFailedException where - toException = sednaExceptionToException - fromException = sednaExceptionFromException - --------------------------------------------------------------------------------- -data SednaConnectionException = - forall e . Exception e => SednaConnectionException e - deriving Typeable - -instance Show SednaConnectionException where - show (SednaConnectionException e) = show e - -instance Exception SednaConnectionException where - toException = sednaExceptionToException - fromException = sednaExceptionFromException - -sednaConnectionExceptionToException :: Exception e => e -> SomeException -sednaConnectionExceptionToException = toException . SednaConnectionException - -sednaConnectionExceptionFromException :: Exception e => SomeException -> Maybe e -sednaConnectionExceptionFromException x = do - SednaConnectionException a <- fromException x - cast a - --------------------------------------------------------------------------------- -data SednaOpenSessionFailedException = - SednaOpenSessionFailedException - deriving (Typeable, Show) - -instance Exception SednaOpenSessionFailedException where - toException = sednaConnectionExceptionToException - fromException = sednaConnectionExceptionFromException - --------------------------------------------------------------------------------- -data SednaCloseSessionFailedException = - SednaCloseSessionFailedException - deriving (Typeable, Show) - -instance Exception SednaCloseSessionFailedException where - toException = sednaConnectionExceptionToException - fromException = sednaConnectionExceptionFromException - --------------------------------------------------------------------------------- -data SednaAuthenticationFailedException = - SednaAuthenticationFailedException - deriving (Typeable, Show) - -instance Exception SednaAuthenticationFailedException where - toException = sednaConnectionExceptionToException - fromException = sednaConnectionExceptionFromException - --------------------------------------------------------------------------------- -data SednaconnectionFailedException = - SednaconnectionFailedException - deriving (Typeable, Show) - -instance Exception SednaconnectionFailedException where - toException = sednaConnectionExceptionToException - fromException = sednaConnectionExceptionFromException - --------------------------------------------------------------------------------- -data SednaTransactionException = - forall e . Exception e => SednaTransactionException e - deriving Typeable - -instance Show SednaTransactionException where - show (SednaTransactionException e) = show e - -instance Exception SednaTransactionException where - toException = sednaExceptionToException - fromException = sednaExceptionFromException - -sednaTransactionExceptionToException :: Exception e => e -> SomeException -sednaTransactionExceptionToException = toException . SednaTransactionException - -sednaTransactionExceptionFromException :: Exception e => SomeException -> Maybe e -sednaTransactionExceptionFromException x = do - SednaTransactionException a <- fromException x - cast a - --------------------------------------------------------------------------------- -data SednaBeginTransactionFailedException = - SednaBeginTransactionFailedException - deriving (Typeable, Show) - -instance Exception SednaBeginTransactionFailedException where - toException = sednaTransactionExceptionToException - fromException = sednaTransactionExceptionFromException - --------------------------------------------------------------------------------- - -data SednaCommitTransactionFailedException = - SednaCommitTransactionFailedException - deriving (Typeable, Show) - -instance Exception SednaCommitTransactionFailedException where - toException = sednaTransactionExceptionToException - fromException = sednaTransactionExceptionFromException - --------------------------------------------------------------------------------- -data SednaRollBackTransactionFailedException = - SednaRollBackTransactionFailedException - deriving (Typeable, Show) - -instance Exception SednaRollBackTransactionFailedException where - toException = sednaTransactionExceptionToException - fromException = sednaTransactionExceptionFromException - --------------------------------------------------------------------------------- -data SednaQueryException = - forall e . Exception e => SednaQueryException e - deriving Typeable - -instance Show SednaQueryException where - show (SednaQueryException e) = show e - -instance Exception SednaQueryException where - toException = sednaExceptionToException - fromException = sednaExceptionFromException - -sednaQueryExceptionToException :: Exception e => e -> SomeException -sednaQueryExceptionToException = toException . SednaQueryException - -sednaQueryExceptionFromException :: Exception e => SomeException -> Maybe e -sednaQueryExceptionFromException x = do - SednaQueryException a <- fromException x - cast a - --------------------------------------------------------------------------------- -data SednaQueryFailedException = - SednaQueryFailedException - deriving (Typeable, Show) - -instance Exception SednaQueryFailedException where - toException = sednaQueryExceptionToException - fromException = sednaQueryExceptionFromException - --------------------------------------------------------------------------------- -data SednaUpdateFailedException = - SednaUpdateFailedException - deriving (Typeable, Show) - -instance Exception SednaUpdateFailedException where - toException = sednaQueryExceptionToException - fromException = sednaQueryExceptionFromException diff --git a/src/Database/SednaDB/SednaTypes.hs b/src/Database/SednaDB/SednaTypes.hs deleted file mode 100644 --- a/src/Database/SednaDB/SednaTypes.hs +++ /dev/null @@ -1,66 +0,0 @@ -module Database.SednaDB.SednaTypes - ( SednaConnection - , Transaction - , QueryResult - , Query - , getTransactionEnv - , TransactionEnv (TransactionEnv) - , Document - , Collection - , runTransaction - , URL - , Password - , DBName - , UserName - ) where - --------------------------------------------------------------------------------- -import Control.Monad.Error -import Control.Monad.Reader -import Foreign (Ptr) - -import Database.SednaDB.Internal.SednaCBindings (C'SednaConnection) - --------------------------------------------------------------------------------- -type URL = String - --------------------------------------------------------------------------------- -type DBName = String - --------------------------------------------------------------------------------- -type UserName = String -type Password = String - --------------------------------------------------------------------------------- -type Collection = String -type Document = String - --------------------------------------------------------------------------------- -type SednaConnection = Ptr C'SednaConnection - --------------------------------------------------------------------------------- -type Query = String -type QueryResult = String - --------------------------------------------------------------------------------- -type ErrorMsg = String - --------------------------------------------------------------------------------- -data TransactionEnv = TransactionEnv SednaConnection Collection Document - deriving (Show) - --------------------------------------------------------------------------------- -type Transaction a = ReaderT TransactionEnv (ErrorT ErrorMsg IO) a - --------------------------------------------------------------------------------- -getTransactionEnv :: Transaction TransactionEnv -getTransactionEnv = ask - --------------------------------------------------------------------------------- -runTransaction :: SednaConnection - -> Document - -> Collection - -> Transaction QueryResult - -> IO (Either ErrorMsg QueryResult) -runTransaction conn doc coll trans = runErrorT (runReaderT trans env) - where env = TransactionEnv conn coll doc diff --git a/src/Database/SednaExceptions.hs b/src/Database/SednaExceptions.hs new file mode 100644 --- /dev/null +++ b/src/Database/SednaExceptions.hs @@ -0,0 +1,211 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE ExistentialQuantification #-} + +-------------------------------------------------------------------------------- +module Database.SednaExceptions + ( SednaAuthenticationFailedException (SednaAuthenticationFailedException) + , SednaBulkLoadFailedException (SednaBulkLoadFailedException) + , SednaOpenSessionFailedException (SednaOpenSessionFailedException) + , SednaCloseSessionFailedException (SednaCloseSessionFailedException) + , SednaCommitTransactionFailedException (SednaCommitTransactionFailedException) + , SednaFailedException (SednaFailedException) + , SednaNextItemFailedException (SednaNextItemFailedException) + , SednaRollBackTransactionFailedException (SednaRollBackTransactionFailedException) + , SednaTransactionException (SednaTransactionException) + , SednaBeginTransactionFailedException (SednaBeginTransactionFailedException) + , SednaException (SednaException) + , SednaQueryException (SednaQueryException) + , SednaQueryFailedException (SednaQueryFailedException) + , SednaUpdateFailedException (SednaUpdateFailedException) + ) where + +-------------------------------------------------------------------------------- +import Control.Exception +import Data.Typeable + +-------------------------------------------------------------------------------- +data SednaException = + forall e . Exception e => SednaException e + deriving Typeable + +instance Show SednaException where + show (SednaException e) = show e + +instance Exception SednaException where + +sednaExceptionToException :: Exception e => e -> SomeException +sednaExceptionToException = toException . SednaException + +sednaExceptionFromException :: Exception e => SomeException -> Maybe e +sednaExceptionFromException x = do + SednaException a <- fromException x + cast a + +-------------------------------------------------------------------------------- +data SednaFailedException = + SednaFailedException + deriving (Typeable, Show) + +instance Exception SednaFailedException where + toException = sednaExceptionToException + fromException = sednaExceptionFromException + +-------------------------------------------------------------------------------- +data SednaBulkLoadFailedException = + SednaBulkLoadFailedException + deriving (Typeable, Show) + +instance Exception SednaBulkLoadFailedException where + toException = sednaExceptionToException + fromException = sednaExceptionFromException + +-------------------------------------------------------------------------------- +data SednaNextItemFailedException = + SednaNextItemFailedException + deriving (Typeable, Show) + +instance Exception SednaNextItemFailedException where + toException = sednaExceptionToException + fromException = sednaExceptionFromException + +-------------------------------------------------------------------------------- +data SednaConnectionException = + forall e . Exception e => SednaConnectionException e + deriving Typeable + +instance Show SednaConnectionException where + show (SednaConnectionException e) = show e + +instance Exception SednaConnectionException where + toException = sednaExceptionToException + fromException = sednaExceptionFromException + +sednaConnectionExceptionToException :: Exception e => e -> SomeException +sednaConnectionExceptionToException = toException . SednaConnectionException + +sednaConnectionExceptionFromException :: Exception e => SomeException -> Maybe e +sednaConnectionExceptionFromException x = do + SednaConnectionException a <- fromException x + cast a + +-------------------------------------------------------------------------------- +data SednaOpenSessionFailedException = + SednaOpenSessionFailedException + deriving (Typeable, Show) + +instance Exception SednaOpenSessionFailedException where + toException = sednaConnectionExceptionToException + fromException = sednaConnectionExceptionFromException + +-------------------------------------------------------------------------------- +data SednaCloseSessionFailedException = + SednaCloseSessionFailedException + deriving (Typeable, Show) + +instance Exception SednaCloseSessionFailedException where + toException = sednaConnectionExceptionToException + fromException = sednaConnectionExceptionFromException + +-------------------------------------------------------------------------------- +data SednaAuthenticationFailedException = + SednaAuthenticationFailedException + deriving (Typeable, Show) + +instance Exception SednaAuthenticationFailedException where + toException = sednaConnectionExceptionToException + fromException = sednaConnectionExceptionFromException + +-------------------------------------------------------------------------------- +data SednaconnectionFailedException = + SednaconnectionFailedException + deriving (Typeable, Show) + +instance Exception SednaconnectionFailedException where + toException = sednaConnectionExceptionToException + fromException = sednaConnectionExceptionFromException + +-------------------------------------------------------------------------------- +data SednaTransactionException = + forall e . Exception e => SednaTransactionException e + deriving Typeable + +instance Show SednaTransactionException where + show (SednaTransactionException e) = show e + +instance Exception SednaTransactionException where + toException = sednaExceptionToException + fromException = sednaExceptionFromException + +sednaTransactionExceptionToException :: Exception e => e -> SomeException +sednaTransactionExceptionToException = toException . SednaTransactionException + +sednaTransactionExceptionFromException :: Exception e => SomeException -> Maybe e +sednaTransactionExceptionFromException x = do + SednaTransactionException a <- fromException x + cast a + +-------------------------------------------------------------------------------- +data SednaBeginTransactionFailedException = + SednaBeginTransactionFailedException + deriving (Typeable, Show) + +instance Exception SednaBeginTransactionFailedException where + toException = sednaTransactionExceptionToException + fromException = sednaTransactionExceptionFromException + +-------------------------------------------------------------------------------- + +data SednaCommitTransactionFailedException = + SednaCommitTransactionFailedException + deriving (Typeable, Show) + +instance Exception SednaCommitTransactionFailedException where + toException = sednaTransactionExceptionToException + fromException = sednaTransactionExceptionFromException + +-------------------------------------------------------------------------------- +data SednaRollBackTransactionFailedException = + SednaRollBackTransactionFailedException + deriving (Typeable, Show) + +instance Exception SednaRollBackTransactionFailedException where + toException = sednaTransactionExceptionToException + fromException = sednaTransactionExceptionFromException + +-------------------------------------------------------------------------------- +data SednaQueryException = + forall e . Exception e => SednaQueryException e + deriving Typeable + +instance Show SednaQueryException where + show (SednaQueryException e) = show e + +instance Exception SednaQueryException where + toException = sednaExceptionToException + fromException = sednaExceptionFromException + +sednaQueryExceptionToException :: Exception e => e -> SomeException +sednaQueryExceptionToException = toException . SednaQueryException + +sednaQueryExceptionFromException :: Exception e => SomeException -> Maybe e +sednaQueryExceptionFromException x = do + SednaQueryException a <- fromException x + cast a + +-------------------------------------------------------------------------------- +data SednaQueryFailedException = + SednaQueryFailedException + deriving (Typeable, Show) + +instance Exception SednaQueryFailedException where + toException = sednaQueryExceptionToException + fromException = sednaQueryExceptionFromException + +-------------------------------------------------------------------------------- +data SednaUpdateFailedException = + SednaUpdateFailedException + deriving (Typeable, Show) + +instance Exception SednaUpdateFailedException where + toException = sednaQueryExceptionToException + fromException = sednaQueryExceptionFromException diff --git a/src/Database/SednaTypes.hs b/src/Database/SednaTypes.hs new file mode 100644 --- /dev/null +++ b/src/Database/SednaTypes.hs @@ -0,0 +1,47 @@ +module Database.SednaTypes + ( SednaConnection + , QueryResult + , Query + , Document + , Collection + , URL + , Password + , DBName + , UserName + ) where + + +-------------------------------------------------------------------------------- +import Foreign (Ptr) +import Database.Internal.SednaCBindings (C'SednaConnection) + + +-------------------------------------------------------------------------------- +type URL = String + + +-------------------------------------------------------------------------------- +type DBName = String + + +-------------------------------------------------------------------------------- +type UserName = String +type Password = String + + +-------------------------------------------------------------------------------- +type Collection = String +type Document = String + + +-------------------------------------------------------------------------------- +type SednaConnection = Ptr C'SednaConnection + + +-------------------------------------------------------------------------------- +type Query = String +type QueryResult = String + + +-------------------------------------------------------------------------------- +type ErrorMsg = String diff --git a/test/suite/Integration/SednaBindingTests.hs b/test/suite/Integration/SednaBindingTests.hs --- a/test/suite/Integration/SednaBindingTests.hs +++ b/test/suite/Integration/SednaBindingTests.hs @@ -15,20 +15,23 @@ import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit -import Database.SednaDB.SednaTypes -import Database.SednaDB.SednaBindings -import Database.SednaDB.Internal.SednaConnectionAttributes -import Database.SednaDB.SednaExceptions +import Database.SednaTypes +import Database.SednaBindings +import Database.Internal.SednaConnectionAttributes +import Database.SednaExceptions + -------------------------------------------------------------------------------- type TestMsg = String + -------------------------------------------------------------------------------- testDBName :: [Char] testDBName = "SednaDBXMLTestDB" testCollName = "'testCollection'" + -------------------------------------------------------------------------------- bringUpDB :: IO String bringUpDB = do readProcess "se_cdb"[testDBName] "/dev/null" @@ -39,11 +42,13 @@ ] "/dev/null" + -------------------------------------------------------------------------------- bringDownDB :: IO String bringDownDB = do readProcess "se_smsd" [testDBName] "/dev/null" readProcess "se_ddb" [testDBName] "/dev/null" + -------------------------------------------------------------------------------- setup :: IO SednaConnection setup = do @@ -62,18 +67,22 @@ sednaCloseConnection conn bringDownDB + -------------------------------------------------------------------------------- formatMsg :: String -> String formatMsg rawMsg = printf "%-60s" rawMsg + -------------------------------------------------------------------------------- testCaseFMsg :: String -> Assertion -> Test testCaseFMsg = testCase . formatMsg + -------------------------------------------------------------------------------- sednaDBTest :: (SednaConnection -> IO c) -> IO c sednaDBTest = bracket setup tearDown + ---------------------------------------------------------------------------------- connectionTest :: (SednaConnection -> IO ()) -> String -> Test connectionTest connFun msg = @@ -81,10 +90,13 @@ catch (sednaDBTest connFun) (\(e :: SednaException) -> assertFailure $ show e) + -------------------------------------------------------------------------------- testOpenConnection :: Test testOpenConnection = testCaseFMsg "Testing connection initialization" openTest + +-------------------------------------------------------------------------------- openTest :: IO () openTest = do bracketOnError (bringUpDB) @@ -93,22 +105,26 @@ bringDownDB return () + -------------------------------------------------------------------------------- --testCloseConnection :: Test --testCloseConnection = connectionTest sednaCloseConnection -- "Test connection termination" + -------------------------------------------------------------------------------- testBeginTransaction :: Test testBeginTransaction = connectionTest sednaBegin "Test transaction initialization" + --------------------------------------------------------------------------------- testSetConnectionAttr :: Test testSetConnectionAttr = connectionTest (\conn -> sednaSetConnectionAttr conn autoCommitOff) "Testing modification of connection attributes" + --------------------------------------------------------------------------------- testGetConnectionAttr :: Test testGetConnectionAttr = @@ -119,6 +135,7 @@ result) "Testing inspection of connection attributes" + --------------------------------------------------------------------------------- testLoadData :: Test testLoadData = @@ -132,6 +149,7 @@ sednaCommit conn) "Testing proper loading of chunk data" + -------------------------------------------------------------------------------- testLoadFile :: Test testLoadFile = @@ -143,6 +161,7 @@ "testCollection") "Test loading of XML file" + -------------------------------------------------------------------------------- testExecuteQuery :: Test testExecuteQuery = @@ -152,6 +171,7 @@ sednaCommit conn) "Testing Proper Execution of valid query" + -------------------------------------------------------------------------------- testLoadRetrieveData :: Test testLoadRetrieveData = @@ -169,17 +189,20 @@ sednaCommit conn) "Test loading and retrieval of data." + ----------------------------------------------------------------------------------- connectionTests :: Test connectionTests = testGroup "Connection Tests" [ testOpenConnection ] + -------------------------------------------------------------------------------- controlTests :: Test controlTests = testGroup "Control Tests" [ testGetConnectionAttr , testSetConnectionAttr ] + -- -------------------------------------------------------------------------------- transactionTests :: Test transactionTests = testGroup "Transaction Tests" [ testBeginTransaction @@ -188,6 +211,7 @@ , testExecuteQuery , testLoadRetrieveData ] + -------------------------------------------------------------------------------- integrationTests :: Test