hsql-sqlite3 1.7.1 → 1.8.1

raw patch · 6 files changed

+205/−160 lines, 6 filesdep ~hsqlsetup-changedPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hsql

API changes (from Hackage documentation)

Files

• ChangeLog +2/−0
• DB/HSQL/SQLite3/Functions.hsc +46/−0
• Database/HSQL/SQLite3.hs +150/−0
• Database/HSQL/SQLite3.hsc +0/−155
• Setup.lhs +2/−2
• hsql-sqlite3.cabal +5/−3

@@ -1,2 +1,4 @@+2010-1-29+    1.8.1: uses updated exception handling of hsql-1.8.1; refactorings 2009-9-6     1.7.1: Fix to make it run on GHC 6.10.

@@ -0,0 +1,46 @@+module DB.HSQL.SQLite3.Functions where++import Foreign(Ptr,FunPtr)+import Foreign.C(CString,CInt)++#include <fcntl.h>+#include <sqlite3.h>++type SQLite3 = Ptr ()++foreign import ccall +  sqlite3_open :: CString -> (Ptr SQLite3) -> IO Int++foreign import ccall+  sqlite3_errmsg :: SQLite3 -> IO CString++foreign import ccall+  sqlite3_close :: SQLite3 -> IO ()++foreign import ccall+  sqlite3_exec :: SQLite3 -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO CInt++foreign import ccall+  sqlite3_get_table ::   SQLite3 -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CInt -> Ptr CString -> IO CInt++foreign import ccall+ sqlite3_free_table :: Ptr CString -> IO ()++foreign import ccall+  sqlite3_free :: CString -> IO ()++-- |+foreign import ccall "strlen"+  strlen :: CString -> IO CInt++-- |+sqliteOk:: Int+sqliteOk = #const SQLITE_OK++oRdOnly = #const O_RDONLY++oWrOnly = #const O_WRONLY++oRdWr = #const O_RDWR++oAppend = #const O_APPEND

@@ -0,0 +1,150 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-| Module      :  Database.HSQL.SQLite3+    Copyright   :  (c) Krasimir Angelov 2005+    License     :  BSD-style++    Maintainer  :  kr.angelov@gmail.com+    Stability   :  provisional+    Portability :  portable++    The module provides interface to SQLite3+-}+module Database.HSQL.SQLite3(connect+                            ,module Database.HSQL) where++import Foreign(Ptr,alloca,peek,nullPtr,peekElemOff,nullFunPtr)+import Foreign.C(CString,CInt,peekCString,withCString)+import System.IO(IOMode(..))+import Control.Monad(when)+import Control.Exception(throw)+import Control.Concurrent.MVar(newMVar,modifyMVar,readMVar)++import Database.HSQL+import Database.HSQL.Types(Connection(..),Statement(..))++import DB.HSQL.SQLite3.Functions++------------------------------------------------------------------------------+-- Connect+------------------------------------------------------------------------------+-- |+connect :: FilePath -> IOMode -> IO Connection+connect fpath mode =+    alloca $ \psqlite ->+	withCString fpath $ \pFPath -> do+	  res <- sqlite3_open pFPath psqlite+	  sqlite <- peek psqlite+	  when (res /= sqliteOk) $ do+	    pMsg <- sqlite3_errmsg sqlite+	    msg <- peekCString pMsg+	    throw SqlError { seState = "C"+			   , seNativeError = 0+			   , seErrorMsg = msg }+	  refFalse <- newMVar False+	  let connection +                = Connection { connDisconnect = sqlite3_close sqlite+			     , connClosed     = refFalse+			     , connExecute    = sqlite3Execute sqlite+			     , connQuery      = sqlite3Query connection sqlite+			     , connTables     = sqlite3Tables connection sqlite+			     , connDescribe   = +                                 sqlite3Describe connection sqlite+			     , connBeginTransaction = +                                 sqlite3Execute sqlite "BEGIN TRANSACTION"+			     , connCommitTransaction = +                                 sqlite3Execute sqlite "COMMIT TRANSACTION"+			     , connRollbackTransaction = +                                 sqlite3Execute sqlite "ROLLBACK TRANSACTION" }+	  return connection+    where oflags1 = case mode of+	    ReadMode      -> oRdOnly+	    WriteMode     -> oWrOnly+	    ReadWriteMode -> oRdWr+	    AppendMode    -> oAppend++-- |+sqlite3Tables :: Connection -> SQLite3 -> IO [String]+sqlite3Tables connection sqlite = do+  stmt <- sqlite3Query connection sqlite "SELECT tbl_name FROM sqlite_master"+  collectRows (\stmt -> getFieldValue stmt "tbl_name") stmt++-- |+sqlite3Describe :: Connection -> SQLite3 -> String -> IO [FieldDef]+sqlite3Describe connection sqlite table = do+  stmt <- sqlite3Query connection sqlite ("pragma table_info("++table++")")+  collectRows getRow stmt++-- |+sqlite3Query :: Connection -> SQLite3 -> String -> IO Statement+sqlite3Query connection sqlite query = do+  withCString query $ \pQuery -> do+  alloca $ \ppResult -> do+  alloca $ \pnRow -> do+  alloca $ \pnColumn -> do+  alloca $ \ppMsg -> do+    res <- sqlite3_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg+    handleSqlResult res ppMsg+    pResult <- peek ppResult+    rows    <- fmap fromIntegral (peek pnRow)+    columns <- fmap fromIntegral (peek pnColumn)+    defs <- getFieldDefs pResult 0 columns+    refFalse <- newMVar False+    refIndex <- newMVar 0+    return Statement { stmtConn   = connection+		     , stmtClose  = sqlite3_free_table pResult+		     , stmtFetch  = sqlite3Fetch refIndex rows+		     , stmtGetCol = getColValue pResult refIndex columns rows+		     , stmtFields = defs+		     , stmtClosed = refFalse }++-- |+getRow stmt = do+  name <- getFieldValue stmt "name"+  notnull <- getFieldValue stmt "notnull"+  return (name, SqlText, notnull=="0")++-- |+getFieldDefs :: Ptr CString -> Int -> Int -> IO [FieldDef]+getFieldDefs pResult index count+    | index >= count = return []+    | otherwise = do+        name <- peekElemOff pResult index >>= peekCString+	defs <- getFieldDefs pResult (index+1) count+	return ((name,SqlText,True):defs)++-- |+sqlite3Fetch tupleIndex countTuples =+    modifyMVar tupleIndex +               (\index -> return (index+1,index < countTuples))++-- |+getColValue pResult refIndex columns rows colNumber fieldDef f = do+  index <- readMVar refIndex+  when (index > rows) (throw SqlNoData)+  pStr <- peekElemOff pResult (columns*index+colNumber)+  if pStr == nullPtr+    then f fieldDef pStr 0+    else do strLen <- strlen pStr+	    f fieldDef pStr (fromIntegral strLen)++-- |+sqlite3Execute :: SQLite3 -> String -> IO ()+sqlite3Execute sqlite query =+    withCString query $ \pQuery -> do+      alloca $ \ppMsg -> do+	res <- sqlite3_exec sqlite pQuery nullFunPtr nullPtr ppMsg+	handleSqlResult res ppMsg+++------------------------------------------------------------------------------+-- routines for handling exceptions+------------------------------------------------------------------------------+-- |+handleSqlResult :: CInt -> Ptr CString -> IO ()+handleSqlResult res ppMsg+    | fromIntegral res == sqliteOk = return ()+    | otherwise = do+        pMsg <- peek ppMsg+	msg <- peekCString pMsg+	sqlite3_free pMsg+	throw (SqlError "E" (fromIntegral res) msg)

@@ -1,155 +0,0 @@--------------------------------------------------------------------------------{-| Module      :  Database.HSQL.SQLite3-    Copyright   :  (c) Krasimir Angelov 2005-    License     :  BSD-style--    Maintainer  :  kr.angelov@gmail.com-    Stability   :  provisional-    Portability :  portable--    The module provides interface to SQLite3--}--------------------------------------------------------------------------------module Database.HSQL.SQLite3(connect-                            ,module Database.HSQL) where--import Database.HSQL-import Database.HSQL.Types-import Foreign-import Foreign.C-import System.IO-import Control.Monad(when)-import Control.OldException(throwDyn)-import Control.Concurrent.MVar--#include <fcntl.h>-#include <sqlite3.h>--type SQLite3 = Ptr ()--foreign import ccall sqlite3_open :: CString -> (Ptr SQLite3) -> IO Int-foreign import ccall sqlite3_errmsg :: SQLite3 -> IO CString-foreign import ccall sqlite3_close :: SQLite3 -> IO ()-foreign import ccall sqlite3_exec :: SQLite3 -> CString -> FunPtr () -> Ptr () -> Ptr CString -> IO CInt-foreign import ccall sqlite3_get_table ::   SQLite3 -> CString -> Ptr (Ptr CString) -> Ptr CInt -> Ptr CInt -> Ptr CString -> IO CInt-foreign import ccall sqlite3_free_table :: Ptr CString -> IO ()-foreign import ccall sqlite3_free :: CString -> IO ()--foreign import ccall "strlen" strlen :: CString -> IO CInt----------------------------------------------------------------------------------- routines for handling exceptions---------------------------------------------------------------------------------handleSqlResult :: CInt -> Ptr CString -> IO ()-handleSqlResult res ppMsg-	| res == (#const SQLITE_OK) = return ()-	| otherwise = do-		pMsg <- peek ppMsg-		msg <- peekCString pMsg-		sqlite3_free pMsg-		throwDyn (SqlError "E" (fromIntegral res) msg)----------------------------------------------------------------------------------- Connect---------------------------------------------------------------------------------connect :: FilePath -> IOMode -> IO Connection-connect fpath mode =-	alloca $ \psqlite ->-	  withCString fpath $ \pFPath -> do-		res <- sqlite3_open pFPath psqlite-		sqlite <- peek psqlite-		when (res /= (#const SQLITE_OK)) $ do-			pMsg <- sqlite3_errmsg sqlite-			msg <- peekCString pMsg-			throwDyn (SqlError-			            { seState = "C"-			            , seNativeError = 0-			            , seErrorMsg = msg-			            })-		refFalse <- newMVar False-		let connection = Connection-			{ connDisconnect = sqlite3_close sqlite-			, connClosed     = refFalse-			, connExecute    = execute sqlite-			, connQuery      = query connection sqlite-			, connTables     = tables connection sqlite-			, connDescribe   = describe connection sqlite-			, connBeginTransaction = execute sqlite "BEGIN TRANSACTION"-			, connCommitTransaction = execute sqlite "COMMIT TRANSACTION"-			, connRollbackTransaction = execute sqlite "ROLLBACK TRANSACTION"-			}-		return connection-	where-		oflags1 = case mode of-	    	  ReadMode      -> (#const O_RDONLY)-	    	  WriteMode     -> (#const O_WRONLY)-	    	  ReadWriteMode -> (#const O_RDWR)-	    	  AppendMode    -> (#const O_APPEND)--		execute :: SQLite3 -> String -> IO ()-		execute sqlite query =-			withCString query $ \pQuery -> do-			alloca $ \ppMsg -> do-				res <- sqlite3_exec sqlite pQuery nullFunPtr nullPtr ppMsg-				handleSqlResult res ppMsg--		query :: Connection -> SQLite3 -> String -> IO Statement-		query connection sqlite query = do-			withCString query $ \pQuery -> do-			alloca $ \ppResult -> do-			alloca $ \pnRow -> do-			alloca $ \pnColumn -> do-			alloca $ \ppMsg -> do-				res <- sqlite3_get_table sqlite pQuery ppResult pnRow pnColumn ppMsg-				handleSqlResult res ppMsg-				pResult <- peek ppResult-				rows    <- fmap fromIntegral (peek pnRow)-				columns <- fmap fromIntegral (peek pnColumn)-				defs <- getFieldDefs pResult 0 columns-				refFalse <- newMVar False-				refIndex <- newMVar 0-				return (Statement-				              { stmtConn   = connection-				              , stmtClose  = sqlite3_free_table pResult-				              , stmtFetch  = fetch refIndex rows-				              , stmtGetCol = getColValue pResult refIndex columns rows-				              , stmtFields = defs-				              , stmtClosed = refFalse-				              })-			where-				getFieldDefs :: Ptr CString -> Int -> Int -> IO [FieldDef]-				getFieldDefs pResult index count-					| index >= count = return []-					| otherwise         = do-						name <- peekElemOff pResult index >>= peekCString-						defs <- getFieldDefs pResult (index+1) count-						return ((name,SqlText,True):defs)--		tables :: Connection -> SQLite3 -> IO [String]-		tables connection sqlite = do-			stmt <- query connection sqlite "select tbl_name from sqlite_master"-			collectRows (\stmt -> getFieldValue stmt "tbl_name") stmt--		describe :: Connection -> SQLite3 -> String -> IO [FieldDef]-		describe connection sqlite table = do-			stmt <- query connection sqlite ("pragma table_info("++table++")")-			collectRows getRow stmt-			where-				getRow stmt = do-					name <- getFieldValue stmt "name"-					notnull <- getFieldValue stmt "notnull"-					return (name, SqlText, notnull=="0")--		fetch tupleIndex countTuples =-			modifyMVar tupleIndex (\index -> return (index+1,index < countTuples))--		getColValue pResult refIndex columns rows colNumber fieldDef f = do-			index <- readMVar refIndex-			when (index > rows) (throwDyn SqlNoData)-			pStr <- peekElemOff pResult (columns*index+colNumber)-			if pStr == nullPtr-			  then f fieldDef pStr 0-			  else do strLen <- strlen pStr-				  f fieldDef pStr (fromIntegral strLen)

@@ -2,7 +2,7 @@  \begin{code} import Control.Monad(when)-import Control.OldException(try)+import Control.Exception(SomeException,try) import System.Directory(removeFile,findExecutable) import System.Exit(ExitCode(ExitSuccess) ,exitWith) import System.IO(hClose, hGetContents, hPutStr, stderr)@@ -24,7 +24,7 @@   where     preConf:: [String] -> ConfigFlags -> IO HookedBuildInfo     preConf args flags = do-      try (removeFile "SQLite3.buildinfo")+      try (removeFile "SQLite3.buildinfo"):: IO (Either SomeException ())       return emptyHookedBuildInfo     postConf:: [String] -> ConfigFlags -> PackageDescription -> LocalBuildInfo              -> IO ()

@@ -1,5 +1,5 @@ Name:            hsql-sqlite3-Version:         1.7.1+Version:         1.8.1 Synopsis:        SQLite3 driver for HSQL. License:         BSD3 License-File:    LICENSE@@ -8,8 +8,10 @@ Category:        Database Description:     A Haskell Interface to SQLite 3 via libsqlite3                  in the standard library path.-Exposed-modules: Database.HSQL.SQLite3-build-depends: 	 base >= 4 && < 5, hsql >= 1.7+Exposed-modules: +  Database.HSQL.SQLite3+  DB.HSQL.SQLite3.Functions+build-depends: 	 base >= 4 && < 5, hsql >= 1.8 Extensions:      ForeignFunctionInterface, CPP Build-type:      Simple Extra-libraries: sqlite3