diff --git a/COPYRIGHT b/COPYRIGHT --- a/COPYRIGHT +++ b/COPYRIGHT @@ -1,4 +1,4 @@ -Copyright (C) 2005-2007 John Goerzen +Copyright (C) 2005-2009 John Goerzen This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public diff --git a/Database/HDBC/Sqlite3/Connection.hs b/Database/HDBC/Sqlite3/Connection.hs --- a/Database/HDBC/Sqlite3/Connection.hs +++ b/Database/HDBC/Sqlite3/Connection.hs @@ -1,7 +1,7 @@ {-# CFILES hdbc-sqlite3-helper.c #-} -- above line for hugs {- -Copyright (C) 2005-2007 John Goerzen +Copyright (C) 2005-2009 John Goerzen This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -36,6 +36,8 @@ import Foreign.ForeignPtr import Foreign.Ptr import Control.Concurrent.MVar +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BUTF8 {- | Connect to an Sqlite version 3 database. The only parameter needed is the filename of the database to connect to. @@ -43,7 +45,7 @@ All database accessor functions are provided in the main HDBC module. -} connectSqlite3 :: FilePath -> IO Impl.Connection connectSqlite3 fp = - withCString fp + B.useAsCString (BUTF8.fromString fp) (\cs -> alloca (\(p::Ptr (Ptr CSqlite3)) -> do res <- sqlite3_open cs p diff --git a/Database/HDBC/Sqlite3/Statement.hsc b/Database/HDBC/Sqlite3/Statement.hsc --- a/Database/HDBC/Sqlite3/Statement.hsc +++ b/Database/HDBC/Sqlite3/Statement.hsc @@ -2,7 +2,7 @@ {-# CFILES hdbc-sqlite3-helper.c #-} -- Above line for Hugs {- -Copyright (C) 2005 John Goerzen +Copyright (C) 2005-2009 John Goerzen This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public @@ -33,6 +33,7 @@ import Foreign.Storable import Control.Monad import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BUTF8 import Data.List import Control.Exception import Database.HDBC.DriverUtils @@ -90,7 +91,7 @@ -} fprepare :: SState -> IO Stmt fprepare sstate = withRawSqlite3 (dbo sstate) - (\p -> withCStringLen ((querys sstate) ++ "\0") + (\p -> B.useAsCStringLen (BUTF8.fromString ((querys sstate) ++ "\0")) (\(cs, cslen) -> alloca (\(newp::Ptr (Ptr CStmt)) -> (do res <- sqlite3_prepare p cs (fromIntegral cslen) newp nullPtr @@ -114,7 +115,7 @@ ffetchrow sstate = modifyMVar (stomv sstate) dofetchrow where dofetchrow Empty = return (Empty, Nothing) dofetchrow (Prepared _) = - throwDyn $ SqlError {seState = "HDBC Sqlite3 fetchrow", + throwSqlError $ SqlError {seState = "HDBC Sqlite3 fetchrow", seNativeError = (-1), seErrorMsg = "Attempt to fetch row from Statement that has not been executed. Query was: " ++ (querys sstate)} dofetchrow (Executed sto) = withStmt sto (\p -> @@ -137,8 +138,8 @@ then return SqlNull else do text <- sqlite3_column_text p icol len <- sqlite3_column_bytes p icol - s <- peekCStringLen (text, fromIntegral len) - return (SqlString s) + s <- B.packCStringLen (text, fromIntegral len) + return (SqlByteString s) fstep :: Sqlite3 -> Ptr CStmt -> IO Bool fstep dbo p = @@ -147,11 +148,11 @@ #{const SQLITE_ROW} -> return True #{const SQLITE_DONE} -> return False #{const SQLITE_ERROR} -> checkError "step" dbo #{const SQLITE_ERROR} - >> (throwDyn $ SqlError + >> (throwSqlError $ SqlError {seState = "", seNativeError = 0, seErrorMsg = "In HDBC step, internal processing error (got SQLITE_ERROR with no error)"}) - x -> throwDyn $ SqlError {seState = "", + x -> throwSqlError $ SqlError {seState = "", seNativeError = fromIntegral x, seErrorMsg = "In HDBC step, unexpected result from sqlite3_step"} @@ -164,7 +165,7 @@ doexecute (Prepared sto) = withStmt sto (\p -> do c <- sqlite3_bind_parameter_count p when (c /= genericLength args) - (throwDyn $ SqlError {seState = "", + (throwSqlError $ SqlError {seState = "", seNativeError = (-1), seErrorMsg = "In HDBC execute, received " ++ (show args) ++ " but expected " ++ (show c) ++ " args."}) sqlite3_reset p >>= checkError "execute (reset)" (dbo sstate) @@ -198,7 +199,7 @@ (dbo sstate) bindArgs p i (SqlByteString bs) = B.useAsCStringLen bs (bindCStringArgs p i) - bindArgs p i arg = withCStringLen (fromSql arg) (bindCStringArgs p i) + bindArgs p i arg = bindArgs p i (SqlByteString (fromSql arg)) bindCStringArgs p i (cs, len) = do r <- sqlite3_bind_text2 p i cs (fromIntegral len) @@ -210,7 +211,8 @@ mapM (getCol csth) [0..(count -1)] where getCol csth i = do cstr <- sqlite3_column_name csth i - peekCString cstr + bs <- B.packCString cstr + return (BUTF8.toString bs) fexecutemany _ [] = return () fexecutemany sstate (args:[]) = diff --git a/Database/HDBC/Sqlite3/Utils.hsc b/Database/HDBC/Sqlite3/Utils.hsc --- a/Database/HDBC/Sqlite3/Utils.hsc +++ b/Database/HDBC/Sqlite3/Utils.hsc @@ -22,8 +22,11 @@ import Foreign.C.String import Foreign.ForeignPtr import Foreign.Ptr +import Database.HDBC(throwSqlError) import Database.HDBC.Types import Database.HDBC.Sqlite3.Types +import qualified Data.ByteString as B +import qualified Data.ByteString.UTF8 as BUTF8 import Foreign.C.Types import Control.Exception import Foreign.Storable @@ -35,8 +38,10 @@ checkError msg o res = withSqlite3 o (\p -> do rc <- sqlite3_errmsg p - str <- peekCString rc - throwDyn $ SqlError {seState = "", + bs <- B.packCString rc + let str = BUTF8.toString bs + throwSqlError $ + SqlError {seState = "", seNativeError = fromIntegral res, seErrorMsg = msg ++ ": " ++ str} ) diff --git a/HDBC-sqlite3.cabal b/HDBC-sqlite3.cabal --- a/HDBC-sqlite3.cabal +++ b/HDBC-sqlite3.cabal @@ -1,32 +1,34 @@ Name: HDBC-sqlite3 -Version: 1.1.6.0 +Version: 2.0.0.0 License: LGPL Maintainer: John Goerzen 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-sqlite3-helper.h +extra-source-files: COPYING, hdbc-sqlite3-helper.h, Makefile homepage: http://software.complete.org/hdbc-sqlite3 synopsis: Sqlite v3 driver for HDBC Description: This is the Sqlite v3 driver for HDBC, the generic database access system for Haskell Stability: Stable Build-Type: Simple -Cabal-Version: >=1.2 +Cabal-Version: >=1.2.3 Flag splitBase description: Choose the new smaller, split-up package. +Flag buildtests + description: Build the executable to run unit tests + default: False Library if flag(splitBase) - Build-Depends: base>=3 && <4, bytestring + Build-Depends: base>=3, bytestring else Build-Depends: base<3 - Build-Depends: mtl, HDBC>=1.1.0 + Build-Depends: mtl, HDBC>=2.0.0, utf8-string C-Sources: hdbc-sqlite3-helper.c include-dirs: . - GHC-Options: -fglasgow-exts Extra-Libraries: sqlite3 Exposed-Modules: Database.HDBC.Sqlite3 Other-Modules: Database.HDBC.Sqlite3.Connection, @@ -35,7 +37,41 @@ Database.HDBC.Sqlite3.Types, Database.HDBC.Sqlite3.Utils, Database.HDBC.Sqlite3.Consts - --Extensions: ExistentialQuantification, AllowOverlappingInstances, - -- AllowUndecidableInstances, CPP + GHC-Options: -O2 Extensions: ExistentialQuantification, - ForeignFunctionInterface + ForeignFunctionInterface, + EmptyDataDecls, + ScopedTypeVariables, + PatternSignatures + +Executable runtests + if flag(buildtests) + Buildable: True + else + Buildable: False + Build-Depends: HUnit, QuickCheck, testpack, containers, convertible, + old-time, time, old-locale + Main-Is: runtests.hs + Other-Modules: SpecificDB, + SpecificDBTests, + TestMisc, + TestSbasics, + TestUtils, + Testbasics, + Tests, + Database.HDBC.Sqlite3.Connection, + Database.HDBC.Sqlite3.ConnectionImpl, + Database.HDBC.Sqlite3.Statement, + Database.HDBC.Sqlite3.Types, + Database.HDBC.Sqlite3.Utils, + Database.HDBC.Sqlite3.Consts + C-Sources: hdbc-sqlite3-helper.c + include-dirs: . + Extra-Libraries: sqlite3 + Hs-Source-Dirs: ., testsrc + GHC-Options: -O2 + Extensions: ExistentialQuantification, + ForeignFunctionInterface, + EmptyDataDecls, + ScopedTypeVariables, + PatternSignatures diff --git a/Makefile b/Makefile new file mode 100644 --- /dev/null +++ b/Makefile @@ -0,0 +1,36 @@ +all: setup + @echo "Please use Cabal to build this package; not make." + ./setup configure + ./setup build + +setup: Setup.hs + ghc --make -package Cabal -o setup Setup.hs + +install: setup + ./setup install + +clean: + -runghc Setup.hs clean + -rm -rf html `find . -name "*.o"` `find . -name "*.hi" | grep -v debian` \ + `find . -name "*~" | grep -v debian` *.a setup dist testsrc/runtests \ + local-pkg doctmp + -rm -rf testtmp/* testtmp* + +.PHONY: test +test: test-ghc test-hugs + @echo "" + @echo "All tests pass." + +test-hugs: setup + @echo " ****** Running hugs tests" + ./setup configure -f buildtests --hugs # for GHC 6.10: --extra-include-dirs=/usr/lib/hugs/include + ./setup build + runhugs -98 +o -P$(PWD)/dist/scratch:$(PWD)/dist/scratch/programs/runtests: \ + dist/scratch/programs/runtests/Main.hs + +test-ghc: setup + @echo " ****** Building GHC tests" + ./setup configure -f buildtests + ./setup build + @echo " ****** Running GHC tests" + ./dist/build/runtests/runtests diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +#!/usr/bin/env runhugs + +import Distribution.Simple + +main = defaultMain + diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,6 +0,0 @@ -#!/usr/bin/env runhugs - -> import Distribution.Simple - -> main = defaultMain -