packages feed

sednaDBXML 0.1.2.3 → 0.1.2.4

raw patch · 17 files changed

+984/−916 lines, 17 files

Files

sednaDBXML.cabal view
@@ -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
+ src/Database/Internal/SednaCBindings.hsc view
@@ -0,0 +1,105 @@+#include <bindings.dsl.h>+#include <libsedna.h>++--------------------------------------------------------------------------------+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 (<se_debug_info_type> -> 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                     , <conn_bulk_load>++#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                     , <msg_struct>+        +#field       debug_handler           , <debug_handler_t>+        +#field       boundary_space_preserve , CChar+#field       query_timeout           , CInt +#field       max_result_size         , CInt+#stoptype++--------------------------------------------------------------------------------+#ccall SEconnect,  Ptr <SednaConnection> -> CString -> CString -> CString -> CString -> IO CInt+#ccall SEclose,    Ptr <SednaConnection> -> IO CInt++--------------------------------------------------------------------------------+#ccall SEbegin,    Ptr <SednaConnection> -> IO CInt+#ccall SErollback, Ptr <SednaConnection> -> IO CInt+#ccall SEcommit,   Ptr <SednaConnection> -> IO CInt++--------------------------------------------------------------------------------+#ccall SEexecuteLong, Ptr <SednaConnection> -> CString -> IO CInt+#ccall SEexecute,     Ptr <SednaConnection> -> CString -> IO CInt++--------------------------------------------------------------------------------+#ccall SEgetData,     Ptr <SednaConnection> -> CString -> CInt -> IO CInt+#ccall SEloadData,    Ptr <SednaConnection> -> CString -> CInt ->  CString -> CString -> IO CInt+#ccall SEendLoadData, Ptr <SednaConnection>  -> IO CInt++--------------------------------------------------------------------------------+#ccall SEnext, Ptr <SednaConnection>  -> IO CInt++--------------------------------------------------------------------------------+#ccall SEgetLastErrorCode, Ptr <SednaConnection> -> IO CInt+#ccall SEgetLastErrorMsg,   Ptr <SednaConnection> -> IO CString++--------------------------------------------------------------------------------+#ccall SEconnectionStatus,  Ptr <SednaConnection>  -> IO CInt+#ccall SEtransactionStatus, Ptr <SednaConnection>  -> IO CInt++--------------------------------------------------------------------------------+#ccall SEshowTime , Ptr <SednaConnection>  -> IO CString++--------------------------------------------------------------------------------+#ccall SEsetConnectionAttr, Ptr <SednaConnection> -> CUInt -> Ptr () -> CInt -> IO CInt +#ccall SEgetConnectionAttr, Ptr <SednaConnection> -> CUInt -> Ptr () -> Ptr CInt -> IO CInt ++--------------------------------------------------------------------------------+#ccall SEresetAllConnectionAttr, Ptr <SednaConnection>  -> IO CInt++--------------------------------------------------------------------------------+#ccall SEsetDebugHandler, Ptr <SednaConnection>  -> <debug_handler_t> -> Ptr ()
+ src/Database/Internal/SednaConnectionAttributes.hsc view
@@ -0,0 +1,33 @@+module Database.Internal.SednaConnectionAttributes where++import Foreign.C.Types++#include <libsedna.h>+#include <sp_defs.h>++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+ }
+ src/Database/Internal/SednaResponseCodes.hsc view
@@ -0,0 +1,115 @@+module Database.Internal.SednaResponseCodes where++--------------------------------------------------------------------------------+import Foreign.C.Types++--------------------------------------------------------------------------------+#include <libsedna.h>++--------------------------------------------------------------------------------+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}
+ src/Database/Internal/SpDefs.hsc view
@@ -0,0 +1,33 @@+#include <bindings.dsl.h>+#include <sp_defs.h>++--------------------------------------------------------------------------------++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 , <sp_int32>+#field       length      , <sp_int32>+#array_field body        , CChar+#stoptype
+ src/Database/Sedna.hs view
@@ -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)+
+ src/Database/SednaBindings.hs view
@@ -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
− src/Database/SednaDB/Internal/SednaCBindings.hsc 
@@ -1,105 +0,0 @@-#include <bindings.dsl.h>-#include <libsedna.h>-----------------------------------------------------------------------------------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 (<se_debug_info_type> -> 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                     , <conn_bulk_load>--#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                     , <msg_struct>-        -#field       debug_handler           , <debug_handler_t>-        -#field       boundary_space_preserve , CChar-#field       query_timeout           , CInt -#field       max_result_size         , CInt-#stoptype-----------------------------------------------------------------------------------#ccall SEconnect,  Ptr <SednaConnection> -> CString -> CString -> CString -> CString -> IO CInt-#ccall SEclose,    Ptr <SednaConnection> -> IO CInt-----------------------------------------------------------------------------------#ccall SEbegin,    Ptr <SednaConnection> -> IO CInt-#ccall SErollback, Ptr <SednaConnection> -> IO CInt-#ccall SEcommit,   Ptr <SednaConnection> -> IO CInt-----------------------------------------------------------------------------------#ccall SEexecuteLong, Ptr <SednaConnection> -> CString -> IO CInt-#ccall SEexecute,     Ptr <SednaConnection> -> CString -> IO CInt-----------------------------------------------------------------------------------#ccall SEgetData,     Ptr <SednaConnection> -> CString -> CInt -> IO CInt-#ccall SEloadData,    Ptr <SednaConnection> -> CString -> CInt ->  CString -> CString -> IO CInt-#ccall SEendLoadData, Ptr <SednaConnection>  -> IO CInt-----------------------------------------------------------------------------------#ccall SEnext, Ptr <SednaConnection>  -> IO CInt-----------------------------------------------------------------------------------#ccall SEgetLastErrorCode, Ptr <SednaConnection> -> IO CInt-#ccall SEgetLastErrorMsg,   Ptr <SednaConnection> -> IO CString-----------------------------------------------------------------------------------#ccall SEconnectionStatus,  Ptr <SednaConnection>  -> IO CInt-#ccall SEtransactionStatus, Ptr <SednaConnection>  -> IO CInt-----------------------------------------------------------------------------------#ccall SEshowTime , Ptr <SednaConnection>  -> IO CString-----------------------------------------------------------------------------------#ccall SEsetConnectionAttr, Ptr <SednaConnection> -> CUInt -> Ptr () -> CInt -> IO CInt -#ccall SEgetConnectionAttr, Ptr <SednaConnection> -> CUInt -> Ptr () -> Ptr CInt -> IO CInt -----------------------------------------------------------------------------------#ccall SEresetAllConnectionAttr, Ptr <SednaConnection>  -> IO CInt-----------------------------------------------------------------------------------#ccall SEsetDebugHandler, Ptr <SednaConnection>  -> <debug_handler_t> -> Ptr ()
− src/Database/SednaDB/Internal/SednaConnectionAttributes.hsc 
@@ -1,33 +0,0 @@-module Database.SednaDB.Internal.SednaConnectionAttributes where--import Foreign.C.Types--#include <libsedna.h>-#include <sp_defs.h>--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- }
− src/Database/SednaDB/Internal/SednaResponseCodes.hsc 
@@ -1,115 +0,0 @@-module Database.SednaDB.Internal.SednaResponseCodes where-----------------------------------------------------------------------------------import Foreign.C.Types-----------------------------------------------------------------------------------#include <libsedna.h>-----------------------------------------------------------------------------------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}
− src/Database/SednaDB/Internal/SpDefs.hsc 
@@ -1,33 +0,0 @@-#include <bindings.dsl.h>-#include <sp_defs.h>------------------------------------------------------------------------------------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 , <sp_int32>-#field       length      , <sp_int32>-#array_field body        , CChar-#stoptype
− src/Database/SednaDB/SednaBindings.hs 
@@ -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
− src/Database/SednaDB/SednaExceptions.hs 
@@ -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
− src/Database/SednaDB/SednaTypes.hs 
@@ -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
+ src/Database/SednaExceptions.hs view
@@ -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
+ src/Database/SednaTypes.hs view
@@ -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
test/suite/Integration/SednaBindingTests.hs view
@@ -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