diff --git a/sednaDBXML.cabal b/sednaDBXML.cabal --- a/sednaDBXML.cabal +++ b/sednaDBXML.cabal @@ -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 diff --git a/src/Database/Sedna.hs b/src/Database/Sedna.hs --- a/src/Database/Sedna.hs +++ b/src/Database/Sedna.hs @@ -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') diff --git a/src/Database/SednaBindings.hs b/src/Database/SednaBindings.hs --- a/src/Database/SednaBindings.hs +++ b/src/Database/SednaBindings.hs @@ -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) -------------------------------------------------------------------------------- diff --git a/src/Database/SednaTypes.hs b/src/Database/SednaTypes.hs --- a/src/Database/SednaTypes.hs +++ b/src/Database/SednaTypes.hs @@ -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 diff --git a/test/sedna-testsuite.cabal b/test/sedna-testsuite.cabal --- a/test/sedna-testsuite.cabal +++ b/test/sedna-testsuite.cabal @@ -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 diff --git a/test/suite/Integration/SednaBindingTests.hs b/test/suite/Integration/SednaBindingTests.hs --- a/test/suite/Integration/SednaBindingTests.hs +++ b/test/suite/Integration/SednaBindingTests.hs @@ -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." -----------------------------------------------------------------------------------