sednaDBXML 0.1.2.4 → 0.1.2.5
raw patch · 6 files changed
+57/−47 lines, 6 filesdep +text
Dependencies added: text
Files
- sednaDBXML.cabal +3/−2
- src/Database/Sedna.hs +12/−4
- src/Database/SednaBindings.hs +9/−6
- src/Database/SednaTypes.hs +0/−3
- test/sedna-testsuite.cabal +2/−1
- test/suite/Integration/SednaBindingTests.hs +31/−31
sednaDBXML.cabal view
@@ -1,5 +1,5 @@ Name: sednaDBXML-Version: 0.1.2.4+Version: 0.1.2.5 License: GPL-3 Cabal-Version: >= 1.10.0 License-File: LICENSE@@ -33,7 +33,8 @@ bytestring, containers, iteratee >= 0.8,- mtl+ mtl,+ text Exposed-Modules: Database.SednaBindings Database.SednaExceptions
src/Database/Sedna.hs view
@@ -1,9 +1,11 @@ module Database.Sedna where -import Database.SednaBindings-import Database.SednaTypes-import Control.Exception-import Data.ByteString.Char8+import Database.SednaBindings+import Database.SednaTypes+import Control.Exception+import Data.ByteString.Char8+import Data.Text (Text)+import qualified Data.Text as Text ------------------------------------------------------------------------------- withTransaction :: SednaConnection -> (SednaConnection -> IO a) -> IO a@@ -32,3 +34,9 @@ loadString conn str doc coll = withTransaction conn $ (\conn' -> sednaLoadData conn' (pack str) doc coll) ++-------------------------------------------------------------------------------+version :: SednaConnection -> IO Text+version conn = withTransaction conn $ (\conn' -> do+ sednaExecute conn' "doc ('$version')"+ sednaGetResult conn')
src/Database/SednaBindings.hs view
@@ -10,7 +10,7 @@ , sednaGetData , sednaGetLastErrorCode , sednaGetLastErrorMsg- , sednaGetResultString+ , sednaGetResult , sednaNext , sednaResetAllConnectionAttr , sednaRollBack@@ -26,7 +26,7 @@ import Control.Exception import Control.Monad.Trans import Data.ByteString as BS-import Data.ByteString.Char8 as C+import qualified Data.ByteString.Char8 as C import Data.Iteratee as I hiding (mapM_, peek) import Data.Iteratee.IO import Data.Maybe@@ -35,6 +35,9 @@ import Foreign.C.Types import Prelude hiding (replicate,concat) import qualified Data.Map as DM (fromList, lookup)+import Data.Text (Text) +import qualified Data.Text as T+import Data.Text.Encoding import Database.Internal.SednaCBindings import Database.Internal.SednaConnectionAttributes@@ -286,18 +289,18 @@ ---------------------------------------------------------------------------------sednaGetResultString :: SednaConnection -> IO QueryResult-sednaGetResultString conn = procItemStream conn 8 getXMLData+sednaGetResult :: SednaConnection -> IO Text+sednaGetResult conn = procItemStream conn 8 getXMLData ---------------------------------------------------------------------------------getXMLData :: (Monad m) => Iteratee [ByteString] m QueryResult+getXMLData :: (Monad m) => Iteratee [ByteString] m Text 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)+ step acc (EOF _) = idone (decodeUtf8 acc) (EOF Nothing) --------------------------------------------------------------------------------
src/Database/SednaTypes.hs view
@@ -1,6 +1,5 @@ module Database.SednaTypes ( SednaConnection- , QueryResult , Query , Document , Collection@@ -40,8 +39,6 @@ -------------------------------------------------------------------------------- type Query = String-type QueryResult = String- -------------------------------------------------------------------------------- type ErrorMsg = String
test/sedna-testsuite.cabal view
@@ -13,7 +13,8 @@ test-framework-hunit >= 0.2.5 && < 0.3, process, bytestring,- sednaDBXML+ sednaDBXML,+ text Ghc-Options: -Wall -fwarn-tabs -funbox-strict-fields -threaded -fno-warn-unused-do-bind
test/suite/Integration/SednaBindingTests.hs view
@@ -1,24 +1,25 @@-{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} module Integration.SednaBindingTests (integrationTests) where ---------------------------------------------------------------------------------import Prelude hiding (catch)-import Control.Exception-import Data.ByteString.Char8 (pack, unpack)-import Foreign (free)-import System.Process (readProcess)-import Text.Printf (printf)+import Prelude hiding (catch)+import Control.Exception+import Data.ByteString.Char8 (pack, unpack)+import Foreign (free)+import System.Process (readProcess)+import Text.Printf (printf) -import Test.HUnit hiding (Test)-import Test.Framework (Test, testGroup)-import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit -import Database.SednaTypes-import Database.SednaBindings-import Database.Internal.SednaConnectionAttributes-import Database.SednaExceptions+import Database.SednaTypes+import Database.SednaBindings+import Database.Internal.SednaConnectionAttributes+import Database.SednaExceptions+import qualified Data.Text as T+import Data.Text.Encoding (decodeUtf8) --------------------------------------------------------------------------------@@ -26,7 +27,7 @@ ---------------------------------------------------------------------------------testDBName :: [Char]+testDBName :: String testDBName = "SednaDBXMLTestDB" testCollName = "'testCollection'"@@ -59,10 +60,10 @@ bringUpDB onException (sednaConnect url dbname login password)- (bringDownDB)+ bringDownDB tearDown :: SednaConnection -> IO String-tearDown = \conn ->+tearDown conn = do sednaCloseConnection conn bringDownDB@@ -70,7 +71,7 @@ -------------------------------------------------------------------------------- formatMsg :: String -> String-formatMsg rawMsg = printf "%-60s" rawMsg+formatMsg = printf "%-60s" --------------------------------------------------------------------------------@@ -99,7 +100,7 @@ -------------------------------------------------------------------------------- openTest :: IO () openTest = do- bracketOnError (bringUpDB)+ bracketOnError bringUpDB (\_ -> bringDownDB >> assertFailure "Open Connection Failed") (\_ -> sednaConnect "localhost" testDBName "SYSTEM" "MANAGER" >>= free) bringDownDB@@ -115,13 +116,13 @@ -------------------------------------------------------------------------------- testBeginTransaction :: Test testBeginTransaction = connectionTest sednaBegin- "Test transaction initialization"+ "Testing transaction initialization" --------------------------------------------------------------------------------- testSetConnectionAttr :: Test testSetConnectionAttr =- connectionTest (\conn -> sednaSetConnectionAttr conn autoCommitOff)+ connectionTest (`sednaSetConnectionAttr` autoCommitOff) "Testing modification of connection attributes" @@ -154,12 +155,11 @@ testLoadFile :: Test testLoadFile = let testFile = "fixtures/baseballleague.xml" in- connectionTest (\conn -> do- sednaLoadFile testFile- conn- "testdoc3"- "testCollection")- "Test loading of XML file"+ connectionTest (\conn -> sednaLoadFile conn+ testFile + "testdoc3"+ "testCollection")+ "Testing loading of XML file" --------------------------------------------------------------------------------@@ -182,12 +182,12 @@ sednaEndLoadData conn sednaExecute conn "doc('testdoc','testCollection')/note" - queryResult <- sednaGetResultString conn+ queryResult <- sednaGetResult conn assertEqual "Testing proper retrieval of query results"- (unpack xmlData)- (concat.lines $ queryResult)+ (decodeUtf8 xmlData)+ (T.concat.T.lines $ queryResult) sednaCommit conn)- "Test loading and retrieval of data."+ "Testing loading and retrieval of data." -----------------------------------------------------------------------------------