HDBC-odbc 1.1.6.0 → 2.0.0.0
raw patch · 5 files changed
+88/−32 lines, 5 filesdep +HUnitdep +QuickCheckdep +bytestringdep ~HDBCdep ~basenew-component:exe:runtestsPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, QuickCheck, bytestring, containers, convertible, old-locale, old-time, testpack, time, utf8-string
Dependency ranges changed: HDBC, base
API changes (from Hackage documentation)
Files
- COPYRIGHT +1/−1
- Database/HDBC/ODBC/Connection.hsc +4/−2
- Database/HDBC/ODBC/Statement.hsc +31/−11
- Database/HDBC/ODBC/Utils.hsc +10/−15
- HDBC-odbc.cabal +42/−3
COPYRIGHT view
@@ -1,4 +1,4 @@-Copyright (C) 2005-2008 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2005-2009 John Goerzen <jgoerzen@complete.org> This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public
Database/HDBC/ODBC/Connection.hsc view
@@ -2,7 +2,7 @@ {-# CFILES hdbc-odbc-helper.c #-} -- Above line for hugs {--Copyright (C) 2005-2006 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2005-2009 John Goerzen <jgoerzen@complete.org> This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public@@ -38,6 +38,8 @@ import Data.Int import Control.Concurrent.MVar import Control.Monad (when)+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BUTF8 #ifdef mingw32_HOST_OS #include <windows.h>@@ -86,7 +88,7 @@ -} connectODBC :: String -> IO Impl.Connection-connectODBC args = withCStringLen args $ \(cs, cslen) -> +connectODBC args = B.useAsCStringLen (BUTF8.fromString args) $ \(cs, cslen) -> alloca $ \(penvptr::Ptr (Ptr CEnv)) -> alloca $ \(pdbcptr::Ptr (Ptr CConn)) -> do -- Create the Environment Handle
Database/HDBC/ODBC/Statement.hsc view
@@ -39,6 +39,9 @@ import Control.Exception import System.IO import Data.Maybe+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BUTF8+import qualified Data.ByteString.Unsafe as B l _ = return () --l m = hPutStrLn stderr ("\n" ++ m)@@ -120,7 +123,8 @@ l (show results) return $ map (\x -> fromSql (x !! 2)) results -fdescribetable iconn tablename = withCStringLen tablename $ \(cs, csl) ->+fdescribetable iconn tablename = B.useAsCStringLen (BUTF8.fromString tablename) $ + \(cs, csl) -> do fsthptr <- makesth iconn "fdescribetable" withStmt fsthptr (\sthptr -> simpleSqlColumns sthptr cs (fromIntegral csl) >>=@@ -135,7 +139,8 @@ {- For now, we try to just handle things as simply as possible. FIXME lots of room for improvement here (types, etc). -} fexecute sstate args = withConn (dbo sstate) $ \cconn ->- withCStringLen (squery sstate) $ \(cquery, cqlen) ->+ B.useAsCStringLen (BUTF8.fromString (squery sstate)) $ + \(cquery, cqlen) -> alloca $ \(psthptr::Ptr (Ptr CStmt)) -> do l "in fexecute" public_ffinish sstate @@ -216,12 +221,13 @@ return [] x -> do -- Otherwise, we have to allocate RAM, make sure it's -- not freed now, and pass it along...- (csptr, cslen) <- newCStringLen (fromSql x)+ (csptr, cslen) <- cstrUtf8BString (fromSql x) do pcslen <- malloc poke pcslen (fromIntegral cslen) rc2 <- sqlBindParameter sthptr (fromIntegral icol) #{const SQL_PARAM_INPUT}- #{const SQL_C_CHAR} coltype colsize decdigits+ #{const SQL_C_CHAR} coltype + (if isOK rc1 then colsize else fromIntegral cslen + 1) decdigits csptr (fromIntegral cslen + 1) pcslen if isOK rc2 then do -- We bound it. Make foreignPtrs and return.@@ -244,6 +250,18 @@ of each to see if it's NULL. If it's not, fetch it as text and return that. -} +cstrUtf8BString :: B.ByteString -> IO CStringLen+cstrUtf8BString bs = do+ B.unsafeUseAsCStringLen bs $ \(s,len) -> do+ res <- mallocBytes (len+1)+ -- copy in+ copyBytes res s len+ -- null terminate+ poke (plusPtr res len) (0::CChar)+ -- return ptr+ return (res, len)++ ffetchrow :: SState -> IO (Maybe [SqlValue]) ffetchrow sstate = modifyMVar (stomv sstate) $ \stmt -> case stmt of@@ -273,18 +291,19 @@ case len of #{const SQL_NULL_DATA} -> return SqlNull #{const SQL_NO_TOTAL} -> fail $ "Unexpected SQL_NO_TOTAL"- len -> do s <- peekCString buf- l $ "col is: " ++ s- return (SqlString s)+ len -> do bs <- B.packCString buf+ l $ "col is: " ++ show (BUTF8.toString bs)+ return (SqlByteString bs) #{const SQL_SUCCESS_WITH_INFO} -> do len <- peek plen allocaBytes (fromIntegral len + 1) $ \buf2 -> do sqlGetData cstmt (fromIntegral icol) #{const SQL_CHAR} buf2 (fromIntegral len + 1) plen >>= checkError "sqlGetData" (StmtHandle cstmt)- s <- liftM2 (++) (peekCString buf) (peekCString buf2)- l $ "col is: " ++ s- return (SqlString s)+ bs <- liftM2 (B.append) (B.packCString buf)+ (B.packCString buf2)+ l $ "col is: " ++ (BUTF8.toString bs)+ return (SqlByteString bs) res -> raiseError "sqlGetData" res (StmtHandle cstmt) @@ -299,7 +318,8 @@ do sqlDescribeCol cstmt icol cscolname 127 colnamelp datatypeptr colsizeptr nullPtr nullableptr colnamelen <- peek colnamelp- colname <- peekCStringLen (cscolname, fromIntegral colnamelen)+ colnamebs <- B.packCStringLen (cscolname, fromIntegral colnamelen)+ let colname = BUTF8.toString colnamebs datatype <- peek datatypeptr colsize <- peek colsizeptr nullable <- peek nullableptr
Database/HDBC/ODBC/Utils.hsc view
@@ -1,5 +1,5 @@ {- -*- mode: haskell; -*- -Copyright (C) 2005 John Goerzen <jgoerzen@complete.org>+Copyright (C) 2005-2009 John Goerzen <jgoerzen@complete.org> This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public@@ -21,6 +21,7 @@ import Foreign.ForeignPtr import Foreign.Ptr import Data.Int+import Database.HDBC(throwSqlError) import Database.HDBC.Types import Database.HDBC.ODBC.Types import Foreign.C.Types@@ -29,6 +30,8 @@ import Foreign.Marshal.Array import Foreign.Marshal.Alloc import Data.Word+import qualified Data.ByteString as B+import qualified Data.ByteString.UTF8 as BUTF8 #ifdef mingw32_HOST_OS #include <windows.h>@@ -55,9 +58,9 @@ raiseError :: String -> #{type SQLRETURN} -> SqlHandleT -> IO a raiseError msg code cconn = do info <- getdiag ht hp 1 - throwDyn $ SqlError {seState = show (map fst info),- seNativeError = fromIntegral code,- seErrorMsg = msg ++ ": " ++ + throwSqlError $ SqlError {seState = show (map fst info),+ seNativeError = fromIntegral code,+ seErrorMsg = msg ++ ": " ++ show (map snd info)} where (ht, hp::(Ptr ())) = case cconn of EnvHandle c -> (#{const SQL_HANDLE_ENV}, castPtr c)@@ -74,8 +77,9 @@ else do state <- peekCStringLen (csstate, 5) nat <- peek pnaterr msglen <- peek pmsglen- msg <- peekCStringLen (csmsg, - fromIntegral msglen)+ msgbs <- B.packCStringLen (csmsg,+ fromIntegral msglen)+ let msg = BUTF8.toString msgbs next <- getdiag ht hp (irow + 1) return $ (state, (show nat) ++ ": " ++ msg) : next@@ -108,15 +112,6 @@ withRawEnv :: Env -> (Ptr WrappedCEnv -> IO b) -> IO b withRawEnv = withForeignPtr--withCStringArr0 :: [SqlValue] -> (Ptr CString -> IO a) -> IO a-withCStringArr0 inp action = withAnyArr0 convfunc freefunc inp action- where convfunc SqlNull = return nullPtr- convfunc x = newCString (fromSql x)- freefunc x =- if x == nullPtr- then return ()- else free x withAnyArr0 :: (a -> IO (Ptr b)) -- ^ Function that transforms input data into pointer -> (Ptr b -> IO ()) -- ^ Function that frees generated data
HDBC-odbc.cabal view
@@ -1,11 +1,11 @@ Name: HDBC-odbc-Version: 1.1.6.0+Version: 2.0.0.0 Cabal-Version: >=1.2.3 Build-type: Simple License: LGPL Maintainer: John Goerzen <jgoerzen@complete.org> Author: John Goerzen-Copyright: Copyright (c) 2005-2008 John Goerzen+Copyright: Copyright (c) 2005-2009 John Goerzen license-file: COPYRIGHT extra-source-files: COPYING, hdbc-odbc-helper.h homepage: http://software.complete.org/hdbc-odbc@@ -17,6 +17,10 @@ MySQL databases from Haskell. Stability: Beta +Flag buildtests+ description: Build the executable to run unit tests+ default: False+ Library Exposed-Modules: Database.HDBC.ODBC Other-Modules: Database.HDBC.ODBC.Connection,@@ -29,7 +33,7 @@ ExistentialQuantification, ForeignFunctionInterface, PatternSignatures- Build-Depends: base<4, mtl, HDBC>=1.1.0+ Build-Depends: base, mtl, HDBC>=2.0.0, utf8-string, bytestring GHC-Options: -O2 C-Sources: hdbc-odbc-helper.c if os(mingw32) || os(win32)@@ -38,3 +42,38 @@ Extra-Libraries: odbc include-dirs: . -- extra-lib-dirs: ++Executable runtests+ if flag(buildtests)+ Buildable: True+ else+ Buildable: False+ Build-Depends: HUnit, QuickCheck, testpack, containers, old-time,+ time, old-locale, convertible+ Main-Is: runtests.hs+ Other-Modules: Database.HDBC.ODBC,+ Database.HDBC.ODBC.Connection,+ Database.HDBC.ODBC.Statement,+ Database.HDBC.ODBC.Types,+ Database.HDBC.ODBC.Utils,+ Database.HDBC.ODBC.TypeConv,+ Database.HDBC.ODBC.ConnectionImpl+ SpecificDB,+ SpecificDBTests,+ TestMisc,+ TestSbasics,+ TestUtils,+ Testbasics,+ Tests+ Hs-Source-Dirs: ., testsrc+ C-Sources: hdbc-odbc-helper.c+ if os(mingw32) || os(win32)+ Extra-Libraries: odbc32+ else+ Extra-Libraries: odbc+ include-dirs: .+ GHC-Options: -O2+ Extensions: + ExistentialQuantification,+ ForeignFunctionInterface,+ PatternSignatures