BerkeleyDBXML 0.6 → 0.6.1
raw patch · 2 files changed
+96/−125 lines, 2 files
Files
- BerkeleyDBXML.cabal +2/−2
- Database/Berkeley/DbXml.hs +94/−123
BerkeleyDBXML.cabal view
@@ -1,5 +1,5 @@ name: BerkeleyDBXML-version: 0.6+version: 0.6.1 license: BSD3 license-file: LICENSE cabal-version: >= 1.4@@ -7,7 +7,7 @@ author: Stephen Blackheath maintainer: http://blacksapphire.com/antispam/ stability: beta-synopsis: Berkeley DB and Berkeley DB XML binding+synopsis: Berkeley DB XML binding description: Berkeley DB XML is a powerful, fully transactional, XML-based database that uses XQuery as its query language. Berkeley DB XML is built on top of Berkeley DB.
Database/Berkeley/DbXml.hs view
@@ -311,8 +311,7 @@ xmlTransaction_commit :: XmlTransaction -> IO () xmlTransaction_commit trans = do- ret <- _xmlTransaction_commit (unsafeForeignPtrToPtr trans)- touchForeignPtr trans+ ret <- withForeignPtr trans $ _xmlTransaction_commit if ret /= 0 then throwDBXML "xmlTransaction_commit" ret "" else return ()@@ -322,8 +321,7 @@ xmlTransaction_abort :: XmlTransaction -> IO () xmlTransaction_abort trans = do- ret <- _xmlTransaction_abort (unsafeForeignPtrToPtr trans)- touchForeignPtr trans+ ret <- withForeignPtr trans $ _xmlTransaction_abort if ret /= 0 then throwDBXML "xmlTransaction_abort" ret "" else return ()@@ -340,15 +338,13 @@ xmlContainer_getDocument cont mTrans key flags = alloca $ \ptr -> withCAString (toUtf8 key) $ \c_key -> do- let cont_ = unsafeForeignPtrToPtr cont- ret <- case mTrans of- Just trans -> do- ret_ <- _xmlContainer_getDocument cont_ (unsafeForeignPtrToPtr trans) c_key (dbOrFlags flags) ptr- touchForeignPtr trans- return ret_- Nothing -> do- _xmlContainer_getDocument cont_ nullPtr c_key (dbOrFlags flags) ptr- touchForeignPtr cont+ ret <- withForeignPtr cont $ \c_cont ->+ case mTrans of+ Just trans -> do+ withForeignPtr trans $ \c_trans ->+ _xmlContainer_getDocument c_cont c_trans c_key (dbOrFlags flags) ptr+ Nothing -> do+ _xmlContainer_getDocument c_cont nullPtr c_key (dbOrFlags flags) ptr if ret /= 0 then throwDBXML "xmlContainer_getDocument" ret "" else do@@ -366,9 +362,7 @@ xmlContainer_getName :: XmlContainer -> String xmlContainer_getName cont = unsafePerformIO$ do- let cont_ = unsafeForeignPtrToPtr cont- cstr <- _xmlContainer_getName cont_- touchForeignPtr cont+ cstr <- withForeignPtr cont $ _xmlContainer_getName str <- peekCAString cstr _deleteString cstr return str@@ -378,8 +372,8 @@ xmlDocument_getContent :: XmlDocument -> IO ByteString xmlDocument_getContent doc = alloca $ \ptr -> alloca $ \pLength -> do- ret <- _xmlDocument_getContent (unsafeForeignPtrToPtr doc) ptr pLength- touchForeignPtr doc+ ret <- withForeignPtr doc $ \c_doc ->+ _xmlDocument_getContent c_doc ptr pLength if ret /= 0 then throwDBXML "xmlDocument_getContent" ret "" else do@@ -424,8 +418,8 @@ xmlResults_hasNext :: XmlResults -> IO Bool xmlResults_hasNext res = alloca $ \ptr -> do- ret <- _xmlResults_hasNext (unsafeForeignPtrToPtr res) ptr- touchForeignPtr res+ ret <- withForeignPtr res $ \c_res ->+ _xmlResults_hasNext c_res ptr if ret /= 0 then throwDBXML "xmlResults_hasNext" ret "" else do@@ -447,8 +441,8 @@ xmlResults_nextDocument :: XmlResults -> IO (Maybe XmlDocument) xmlResults_nextDocument res = alloca $ \ptr -> do- ret <- _xmlResults_nextDocument (unsafeForeignPtrToPtr res) ptr- touchForeignPtr res+ ret <- withForeignPtr res $ \c_res ->+ _xmlResults_nextDocument c_res ptr if ret /= 0 then throwDBXML "xmlResults_next" ret "XmlDocument" else do@@ -465,8 +459,8 @@ xmlResults_nextValue :: XmlResults -> IO (Maybe XmlValue) xmlResults_nextValue res = alloca $ \ptr -> do- ret <- _xmlResults_nextValue (unsafeForeignPtrToPtr res) ptr- touchForeignPtr res+ ret <- withForeignPtr res $ \c_res ->+ _xmlResults_nextValue c_res ptr if ret /= 0 then throwDBXML "xmlResults_next" ret "XmlValue" else do@@ -490,16 +484,14 @@ -> IO XmlResults xmlManager_query mgr mTrans query ctx flags = alloca $ \ptr ->- withCAString (toUtf8 query) $ \c_query -> do+ withCAString (toUtf8 query) $ \c_query ->+ withForeignPtr ctx $ \c_ctx -> do ret <- case mTrans of Just trans -> do- ret_ <- _xmlManager_query mgr (unsafeForeignPtrToPtr trans) c_query- (unsafeForeignPtrToPtr ctx) (dbxmlOrFlags flags) ptr- touchForeignPtr trans- return ret_+ withForeignPtr trans $ \c_trans ->+ _xmlManager_query mgr c_trans c_query c_ctx (dbxmlOrFlags flags) ptr Nothing -> do- _xmlManager_query mgr nullPtr c_query- (unsafeForeignPtrToPtr ctx) (dbxmlOrFlags flags) ptr+ _xmlManager_query mgr nullPtr c_query c_ctx (dbxmlOrFlags flags) ptr if ret /= 0 then throwDBXML "xmlManager_query" ret (" query="++query) else do@@ -518,16 +510,14 @@ xmlManager_prepare :: XmlManager -> Maybe XmlTransaction -> String -> XmlQueryContext -> IO XmlQueryExpression xmlManager_prepare mgr mTrans query ctx = alloca $ \ptr ->- withCAString (toUtf8 query) $ \c_query -> do+ withCAString (toUtf8 query) $ \c_query ->+ withForeignPtr ctx $ \c_ctx -> do ret <- case mTrans of Just trans -> do- ret_ <- _xmlManager_prepare mgr (unsafeForeignPtrToPtr trans) c_query- (unsafeForeignPtrToPtr ctx) ptr- touchForeignPtr trans- return ret_+ withForeignPtr trans $ \c_trans ->+ _xmlManager_prepare mgr c_trans c_query c_ctx ptr Nothing -> do- _xmlManager_prepare mgr nullPtr c_query- (unsafeForeignPtrToPtr ctx) ptr+ _xmlManager_prepare mgr nullPtr c_query c_ctx ptr if ret /= 0 then throwDBXML "xmlManager_prepare" ret (" query="++query) else do@@ -540,8 +530,8 @@ xmlQueryContext_setDefaultCollection :: XmlQueryContext -> String -> IO () xmlQueryContext_setDefaultCollection ctx coll = withCAString coll $ \c_coll -> do- ret <- _xmlQueryContext_setDefaultCollection (unsafeForeignPtrToPtr ctx) c_coll- touchForeignPtr ctx+ ret <- withForeignPtr ctx $ \c_ctx ->+ _xmlQueryContext_setDefaultCollection c_ctx c_coll if ret /= 0 then throwDBXML "xmlQueryContext_setDefaultCollection" ret (" arg="++coll) else return ()@@ -573,7 +563,7 @@ xmlBool :: Bool -> XmlValue xmlBool b = unsafePerformIO $ do- xv <- _xmlBool$ if b then 1 else 0+ xv <- _xmlBool $ if b then 1 else 0 newForeignPtr _xmlValue_delete xv foreign import ccall safe "dbxml_helper.h _xmlDouble" _xmlDouble@@ -581,7 +571,7 @@ xmlDouble :: Double -> XmlValue xmlDouble value = unsafePerformIO $ do- xv <- _xmlDouble$ realToFrac value+ xv <- _xmlDouble $ realToFrac value newForeignPtr _xmlValue_delete xv foreign import ccall safe "dbxml_helper.h _xmlValue_asString" _xmlValue_asString@@ -591,8 +581,8 @@ -- a Unicode string. xmlValue_asString :: XmlValue -> String xmlValue_asString value = unsafePerformIO $ alloca $ \ptr -> do- ret <- _xmlValue_asString (unsafeForeignPtrToPtr value) ptr- touchForeignPtr value+ ret <- withForeignPtr value $ \c_value ->+ _xmlValue_asString c_value ptr if ret /= 0 then throwDBXML "xmlValue_asString" ret "" else do@@ -606,8 +596,8 @@ -- parser. xmlValue_asString8Bit :: XmlValue -> String xmlValue_asString8Bit value = unsafePerformIO $ alloca $ \ptr -> do- ret <- _xmlValue_asString (unsafeForeignPtrToPtr value) ptr- touchForeignPtr value+ ret <- withForeignPtr value $ \c_value ->+ _xmlValue_asString c_value ptr cstr <- peek ptr str <- peekCAString cstr _deleteString cstr@@ -619,9 +609,9 @@ xmlQueryContext_setVariableValue :: XmlQueryContext -> String -> XmlValue -> IO () xmlQueryContext_setVariableValue ctx name value = withCAString (toUtf8 name) $ \c_name -> do- ret <- _xmlQueryContext_setVariableValue (unsafeForeignPtrToPtr ctx) c_name (unsafeForeignPtrToPtr value)- touchForeignPtr ctx- touchForeignPtr value+ ret <- withForeignPtr ctx $ \c_ctx ->+ withForeignPtr value $ \c_value ->+ _xmlQueryContext_setVariableValue c_ctx c_name c_value if ret /= 0 then throwDBXML "xmlQueryContext_setVariableValue" ret (" name="++name++" value="++(show value)) else return ()@@ -637,35 +627,28 @@ -> XmlQueryContext -> [DbXmlFlag] -> IO XmlResults-xmlQueryExpression_execute exp mTrans mContextItem qctx flags =- alloca $ \ptr -> do- let p2p = unsafeForeignPtrToPtr- let exp_ = p2p exp- let qctx_ = p2p qctx+xmlQueryExpression_execute exp mTrans mContextItem qctx flags = alloca $ \ptr -> do+ ret <- withForeignPtr exp $ \c_exp ->+ withForeignPtr qctx $ \c_qctx -> do let flags_ = (dbxmlOrFlags flags)- ret <- case (mTrans, mContextItem) of+ case (mTrans, mContextItem) of (Just trans, Just contextItem) -> do- ret <- _xmlQueryExpression_execute exp_ (p2p trans) (p2p contextItem) qctx_ flags_ ptr- touchForeignPtr trans- touchForeignPtr contextItem- return ret+ withForeignPtr trans $ \c_trans ->+ withForeignPtr contextItem $ \c_contextItem ->+ _xmlQueryExpression_execute c_exp c_trans c_contextItem c_qctx flags_ ptr (Just trans, Nothing) -> do- ret <- _xmlQueryExpression_execute exp_ (p2p trans) nullPtr qctx_ flags_ ptr- touchForeignPtr trans- return ret+ withForeignPtr trans $ \c_trans ->+ _xmlQueryExpression_execute c_exp c_trans nullPtr c_qctx flags_ ptr (Nothing, Just contextItem) -> do- ret <- _xmlQueryExpression_execute exp_ nullPtr (p2p contextItem) qctx_ flags_ ptr- touchForeignPtr contextItem- return ret+ withForeignPtr contextItem $ \c_contextItem ->+ _xmlQueryExpression_execute c_exp nullPtr c_contextItem c_qctx flags_ ptr (Nothing, Nothing) -> do- _xmlQueryExpression_execute exp_ nullPtr nullPtr qctx_ flags_ ptr- touchForeignPtr exp- touchForeignPtr qctx- if ret /= 0- then throwDBXML "xmlQueryExpression_execute" ret ""- else do- p <- peek ptr- newForeignPtr _xmlResults_delete p+ _xmlQueryExpression_execute c_exp nullPtr nullPtr c_qctx flags_ ptr+ if ret /= 0+ then throwDBXML "xmlQueryExpression_execute" ret ""+ else do+ p <- peek ptr+ newForeignPtr _xmlResults_delete p foreign import ccall safe "dbxml_helper.h _xmlManager_createDocument" _xmlManager_createDocument :: Ptr XmlManager_struct -> Ptr (Ptr XmlDocument_struct) -> IO CInt@@ -685,8 +668,8 @@ xmlDocument_getName :: XmlDocument -> IO String xmlDocument_getName doc = alloca $ \ptr -> do- ret <- _xmlDocument_getName (unsafeForeignPtrToPtr doc) ptr- touchForeignPtr doc+ ret <- withForeignPtr doc $ \c_doc ->+ _xmlDocument_getName c_doc ptr if ret /= 0 then throwDBXML "xmlDocument_getName" ret "" else do@@ -700,8 +683,8 @@ xmlDocument_setName :: XmlDocument -> String -> IO () xmlDocument_setName doc name = withCAString name $ \c_name -> do- ret <- _xmlDocument_setName (unsafeForeignPtrToPtr doc) c_name- touchForeignPtr doc+ ret <- withForeignPtr doc $ \c_doc ->+ _xmlDocument_setName c_doc c_name if ret /= 0 then throwDBXML "xmlDocument_setName" ret "" else return ()@@ -729,9 +712,9 @@ xmlDocument_setContent :: XmlDocument -> ByteString -> IO () xmlDocument_setContent doc text =- withByteString text$ \c_text text_length -> do- ret <- _xmlDocument_setContent (unsafeForeignPtrToPtr doc) c_text (fromIntegral text_length)- touchForeignPtr doc+ withByteString text $ \c_text text_length -> do+ ret <- withForeignPtr doc $ \c_doc ->+ _xmlDocument_setContent c_doc c_text (fromIntegral text_length) if ret /= 0 then throwDBXML "xmlDocument_setContent" ret "" else return ()@@ -748,20 +731,16 @@ xmlContainer_updateDocument :: XmlContainer -> Maybe XmlTransaction -> XmlDocument -> XmlUpdateContext -> IO () xmlContainer_updateDocument cont mTrans doc uctx = do- let cont_ = unsafeForeignPtrToPtr cont- let doc_ = unsafeForeignPtrToPtr doc- let uctx_ = unsafeForeignPtrToPtr uctx- ret <- case mTrans of- Just trans -> do- let trans_ = unsafeForeignPtrToPtr trans- ret <- _xmlContainer_updateDocument cont_ trans_ doc_ uctx_- touchForeignPtr trans- return ret- Nothing -> do- _xmlContainer_updateDocument cont_ nullPtr doc_ uctx_- touchForeignPtr cont- touchForeignPtr doc- touchForeignPtr uctx+ ret <- withForeignPtr cont $ \c_cont ->+ withForeignPtr doc $ \c_doc ->+ withForeignPtr uctx $ \c_uctx -> do+ case mTrans of+ Just trans -> do+ ret <- withForeignPtr trans $ \c_trans ->+ _xmlContainer_updateDocument c_cont c_trans c_doc c_uctx+ return ret+ Nothing -> do+ _xmlContainer_updateDocument c_cont nullPtr c_doc c_uctx if ret /= 0 then throwDBXML "xmlContainer_updateDocument" ret "" else return ()@@ -773,20 +752,16 @@ xmlContainer_putDocument :: XmlContainer -> Maybe XmlTransaction -> XmlDocument -> XmlUpdateContext -> [DbXmlFlag] -> IO () xmlContainer_putDocument cont mTrans doc uctx flags = do- let cont_ = unsafeForeignPtrToPtr cont- let doc_ = unsafeForeignPtrToPtr doc- let uctx_ = unsafeForeignPtrToPtr uctx- ret <- case mTrans of- Just trans -> do- let trans_ = unsafeForeignPtrToPtr trans- ret <- _xmlContainer_putDocument cont_ trans_ doc_ uctx_ (dbxmlOrFlags flags)- touchForeignPtr trans- return ret- Nothing -> do- _xmlContainer_putDocument cont_ nullPtr doc_ uctx_ (dbxmlOrFlags flags)- touchForeignPtr cont- touchForeignPtr doc- touchForeignPtr uctx+ ret <- withForeignPtr cont $ \c_cont ->+ withForeignPtr doc $ \c_doc ->+ withForeignPtr uctx $ \c_uctx -> do+ case mTrans of+ Just trans -> do+ ret <- withForeignPtr trans $ \c_trans ->+ _xmlContainer_putDocument c_cont c_trans c_doc c_uctx (dbxmlOrFlags flags)+ return ret+ Nothing -> do+ _xmlContainer_putDocument c_cont nullPtr c_doc c_uctx (dbxmlOrFlags flags) if ret /= 0 then throwDBXML "xmlContainer_updateDocument" ret "" else return ()@@ -797,20 +772,16 @@ xmlContainer_deleteDocument :: XmlContainer -> Maybe XmlTransaction -> XmlDocument -> XmlUpdateContext -> IO () xmlContainer_deleteDocument cont mTrans doc uctx = do- let cont_ = unsafeForeignPtrToPtr cont- let doc_ = unsafeForeignPtrToPtr doc- let uctx_ = unsafeForeignPtrToPtr uctx- ret <- case mTrans of- Just trans -> do- let trans_ = unsafeForeignPtrToPtr trans- ret <- _xmlContainer_deleteDocument cont_ trans_ doc_ uctx_- touchForeignPtr trans- return ret- Nothing -> do- _xmlContainer_deleteDocument cont_ nullPtr doc_ uctx_- touchForeignPtr cont- touchForeignPtr doc- touchForeignPtr uctx+ ret <- withForeignPtr cont $ \c_cont ->+ withForeignPtr doc $ \c_doc ->+ withForeignPtr uctx $ \c_uctx -> do+ case mTrans of+ Just trans -> do+ ret <- withForeignPtr trans $ \c_trans ->+ _xmlContainer_deleteDocument c_cont c_trans c_doc c_uctx+ return ret+ Nothing -> do+ _xmlContainer_deleteDocument c_cont nullPtr c_doc c_uctx if ret /= 0 then throwDBXML "xmlContainer_deleteDocument" ret "" else return ()@@ -821,7 +792,7 @@ -- | Closes a container. Equivalent to destructing the XmlContainer object in C++. xmlContainer_close :: XmlContainer -> IO () xmlContainer_close cont =- withForeignPtr cont$ \cont_ ->+ withForeignPtr cont $ \cont_ -> _xmlContainer_close cont_ foreign import ccall safe "dbxml_helper.h _xmlManager_close" _xmlManager_close