[htoolkit-cvs] HSQL/src HSQL.hsc,1.5,1.6

[<kr_...@us...>]

Update of /cvsroot/htoolkit/HSQL/src
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv23722

Modified Files:
	HSQL.hsc 
Log Message:
Fix the bug with dates (PostgreSQL)


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/src/HSQL.hsc,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** HSQL.hsc	9 Feb 2004 06:33:10 -0000	1.5
--- HSQL.hsc	9 Feb 2004 21:49:43 -0000	1.6
***************
*** 1,32 ****
! -----------------------------------------------------------------------------------------
! {-| Module      :  Database.HSQL.ODBC
!     Copyright   :  (c) Krasimir Angelov 2003
!     License     :  BSD-style
! 
!     Maintainer  :  ka2...@ya...
!     Stability   :  provisional
!     Portability :  portable
! 
!     The module provides an abstract database interface
! -}
! -----------------------------------------------------------------------------------------
! 
  module Database.HSQL
! 	(
! 	-- * Connect\/Disconnect
! 	  Connection
  	, disconnect        -- :: Connection -> IO ()
! 	
! 	-- * Command Execution Functions
! 	-- | Once a connection to a database has been successfully established, 
! 	-- the functions described here are used to perform SQL queries and commands.
  	, execute           -- :: Connection -> String -> IO ()
! 	, Statement
  	, query             -- :: Connection -> String -> IO Statement
  	, closeStatement    -- :: Statement -> IO ()
  	, fetch             -- :: Statement -> IO Bool
! 	
! 	-- * Retrieving Statement values and types
! 	, FieldDef, SqlType(..), SqlBind
  	, getFieldValueMB   -- :: SqlBind a => Statement -> String -> IO (Maybe a)
  	, getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
--- 1,32 ----
! -----------------------------------------------------------------------------------------
! {-| Module      :  Database.HSQL.ODBC
!     Copyright   :  (c) Krasimir Angelov 2003
!     License     :  BSD-style
! 
!     Maintainer  :  ka2...@ya...
!     Stability   :  provisional
!     Portability :  portable
! 
!     The module provides an abstract database interface
! -}
! -----------------------------------------------------------------------------------------
! 
  module Database.HSQL
! 	(
! 	-- * Connect\/Disconnect
! 	  Connection
  	, disconnect        -- :: Connection -> IO ()
! 	
! 	-- * Command Execution Functions
! 	-- | Once a connection to a database has been successfully established, 
! 	-- the functions described here are used to perform SQL queries and commands.
  	, execute           -- :: Connection -> String -> IO ()
! 	, Statement
  	, query             -- :: Connection -> String -> IO Statement
  	, closeStatement    -- :: Statement -> IO ()
  	, fetch             -- :: Statement -> IO Bool
! 	
! 	-- * Retrieving Statement values and types
! 	, FieldDef, SqlType(..), SqlBind
  	, getFieldValueMB   -- :: SqlBind a => Statement -> String -> IO (Maybe a)
  	, getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
***************
*** 34,54 ****
  	, getFieldValueType -- :: Statement -> String -> (SqlType, Bool)
  	, getFieldsTypes    -- :: Statement -> [(String, SqlType, Bool)]
! 	
! 	-- * Transactions
! 	, inTransaction     -- :: Connection -> (Connection -> IO a) -> IO a
! 
! 	
! 	-- * SQL Exceptions handling
! 	, SqlError(..)
! 	, catchSql          -- :: IO a -> (SqlError -> IO a) -> IO a
! 	, handleSql         -- :: (SqlError -> IO a) -> IO a -> IO a
! 	, sqlExceptions     -- :: Exception -> Maybe SqlError
! 	
! 	-- * Utilities
  	, forEachRow        -- :: (Statement -> s -> IO s) -- ^ an action
  	, forEachRow'       -- :: (Statement -> IO ()) -> Statement -> IO ()
  	, collectRows       -- :: (Statement -> IO a) -> Statement -> IO [a]
! 	
! 	-- * Metadata
  	, tables            -- :: Connection -> IO [String]
  	, describe          -- :: Connection -> String -> IO [FieldDef]
--- 34,54 ----
  	, getFieldValueType -- :: Statement -> String -> (SqlType, Bool)
  	, getFieldsTypes    -- :: Statement -> [(String, SqlType, Bool)]
! 	
! 	-- * Transactions
! 	, inTransaction     -- :: Connection -> (Connection -> IO a) -> IO a
! 
! 	
! 	-- * SQL Exceptions handling
! 	, SqlError(..)
! 	, catchSql          -- :: IO a -> (SqlError -> IO a) -> IO a
! 	, handleSql         -- :: (SqlError -> IO a) -> IO a -> IO a
! 	, sqlExceptions     -- :: Exception -> Maybe SqlError
! 	
! 	-- * Utilities
  	, forEachRow        -- :: (Statement -> s -> IO s) -- ^ an action
  	, forEachRow'       -- :: (Statement -> IO ()) -> Statement -> IO ()
  	, collectRows       -- :: (Statement -> IO a) -> Statement -> IO [a]
! 	
! 	-- * Metadata
  	, tables            -- :: Connection -> IO [String]
  	, describe          -- :: Connection -> String -> IO [FieldDef]
***************
*** 62,67 ****
  import Data.Int
  import Data.Char
! import Data.Dynamic
! import Data.IORef
  import System.Time
  import System.IO.Unsafe(unsafePerformIO)
--- 62,67 ----
  import Data.Int
  import Data.Char
! import Data.Dynamic
! import Data.IORef
  import System.Time
  import System.IO.Unsafe(unsafePerformIO)
***************
*** 72,76 ****
  import Text.Read.Lex
  import Numeric
! import Database.HSQL.Types
  
  #include <time.h>
--- 72,76 ----
  import Text.Read.Lex
  import Numeric
! import Database.HSQL.Types
  
  #include <time.h>
***************
*** 88,102 ****
  sqlExceptions :: Exception -> Maybe SqlError
  sqlExceptions e = dynExceptions e >>= fromDynamic
- 
- checkHandle :: IORef Bool -> IO ()
- checkHandle ref = do
- 	closed <- readIORef ref
- 	when closed (throwDyn SqlClosedHandle)
  
! closeHandle :: (a -> IORef Bool) -> (a -> IO ()) -> a -> IO ()
! closeHandle getRef action handle = do
! 	closed <- readIORef (getRef handle)
! 	unless closed (action handle)
! 	writeIORef (getRef handle) True
  
  -----------------------------------------------------------------------------------------
--- 88,102 ----
  sqlExceptions :: Exception -> Maybe SqlError
  sqlExceptions e = dynExceptions e >>= fromDynamic
  
! checkHandle :: IORef Bool -> IO ()
! checkHandle ref = do
! 	closed <- readIORef ref
! 	when closed (throwDyn SqlClosedHandle)
! 
! closeHandle :: (a -> IORef Bool) -> (a -> IO ()) -> a -> IO ()
! closeHandle getRef action handle = do
! 	closed <- readIORef (getRef handle)
! 	unless closed (action handle)
! 	writeIORef (getRef handle) True
  
  -----------------------------------------------------------------------------------------
***************
*** 109,113 ****
  disconnect = closeHandle connClosed connDisconnect
  	
! -- | Submits a command to the database.
  execute :: Connection  -- ^ the database connection
          -> String      -- ^ the text of SQL command
--- 109,113 ----
  disconnect = closeHandle connClosed connDisconnect
  	
! -- | Submits a command to the database.
  execute :: Connection  -- ^ the database connection
          -> String      -- ^ the text of SQL command
***************
*** 123,127 ****
                         -- the 'closeStatement' function
  query conn query = do
! 	checkHandle (connClosed conn)
  	connQuery conn query
  
--- 123,127 ----
                         -- the 'closeStatement' function
  query conn query = do
! 	checkHandle (connClosed conn)
  	connQuery conn query
  
***************
*** 130,134 ****
         -> IO [String]  -- ^ The names of all tables in the database.
  tables conn = do
! 	checkHandle (connClosed conn)
  	connTables conn
  
--- 130,134 ----
         -> IO [String]  -- ^ The names of all tables in the database.
  tables conn = do
! 	checkHandle (connClosed conn)
  	connTables conn
  
***************
*** 138,142 ****
  	 -> IO [FieldDef] -- ^ The list of fields in the table
  describe conn table = do
! 	checkHandle (connClosed conn)
  	connDescribe conn table
  
--- 138,142 ----
  	 -> IO [FieldDef] -- ^ The list of fields in the table
  describe conn table = do
! 	checkHandle (connClosed conn)
  	connDescribe conn table
  
***************
*** 152,157 ****
                -> (Connection -> IO a)  -- ^ an action
                -> IO a                  -- ^ the returned value is the result returned from action
! inTransaction conn action = do
! 	checkHandle (connClosed conn)	
  	connBeginTransaction conn
  	r <- catchSql (action conn) (\err -> do
--- 152,157 ----
                -> (Connection -> IO a)  -- ^ an action
                -> IO a                  -- ^ the returned value is the result returned from action
! inTransaction conn action = do
! 	checkHandle (connClosed conn)	
  	connBeginTransaction conn
  	r <- catchSql (action conn) (\err -> do
***************
*** 169,173 ****
  fetch :: Statement -> IO Bool
  fetch stmt = do
! 	checkHandle (stmtClosed stmt)
  	stmtFetch stmt
  
--- 169,173 ----
  fetch :: Statement -> IO Bool
  fetch stmt = do
! 	checkHandle (stmtClosed stmt)
  	stmtFetch stmt
  
***************
*** 200,208 ****
  
  foreign import ccall "stdlib.h atoi" c_atoi :: CString -> IO Int
! #ifdef WIN32
! foreign import ccall "stdlib.h _atoi64" c_atoi64 :: CString -> IO Int64
! #else
! foreign import ccall "stdlib.h strtoll" c_strtoll :: CString -> Ptr CString -> Int -> IO Int64
! #endif
  
  instance SqlBind Int where
--- 200,208 ----
  
  foreign import ccall "stdlib.h atoi" c_atoi :: CString -> IO Int
! #ifdef WIN32
! foreign import ccall "stdlib.h _atoi64" c_atoi64 :: CString -> IO Int64
! #else
! foreign import ccall "stdlib.h strtoll" c_strtoll :: CString -> Ptr CString -> Int -> IO Int64
! #endif
  
  instance SqlBind Int where
***************
*** 229,237 ****
  	       || sqlType==SqlTinyInt || sqlType==SqlSmallInt || sqlType==SqlBigInt
  	      then do
! #ifdef WIN32
! 	        val <- c_atoi64 cstr
! #else
! 	        val <- c_strtoll cstr nullPtr 10
! #endif
  	        return (Just val)
  	      else
--- 229,237 ----
  	       || sqlType==SqlTinyInt || sqlType==SqlSmallInt || sqlType==SqlBigInt
  	      then do
! #ifdef WIN32
! 	        val <- c_atoi64 cstr
! #else
! 	        val <- c_strtoll cstr nullPtr 10
! #endif
  	        return (Just val)
  	      else
***************
*** 320,323 ****
--- 320,324 ----
  				char ':'
  				seconds <- readDecP
+ 				(char '.' >> readDecP) `mplus` (return 0)
  				tz <- parseTZ
  				return (mkClockTime 1970 0 1 hour minutes seconds (tz*3600))
***************
*** 356,363 ****
  				skipSpaces
  				hour  <- readDecP
! 				char '-'
  				minutes <- readDecP
! 				char '-'
  				seconds <- readDecP
  				tz    <- parseTZ
  				return (mkClockTime year month day hour minutes seconds (tz*3600))
--- 357,365 ----
  				skipSpaces
  				hour  <- readDecP
! 				char ':'
  				minutes <- readDecP
! 				char ':'
  				seconds <- readDecP
+ 				char '.' >> readDecP -- ) `mplus` (return 0)
  				tz    <- parseTZ
  				return (mkClockTime year month day hour minutes seconds (tz*3600))
***************
*** 535,539 ****
                               -> IO (Maybe a)   -- ^ Field value or Nothing
  getFieldValueMB stmt name = do
! 	checkHandle (stmtClosed stmt)
  	stmtGetCol stmt colNumber (name,sqlType,nullable) fromNonNullSqlCStringLen
  	where
--- 537,541 ----
                               -> IO (Maybe a)   -- ^ Field value or Nothing
  getFieldValueMB stmt name = do
! 	checkHandle (stmtClosed stmt)
  	stmtGetCol stmt colNumber (name,sqlType,nullable) fromNonNullSqlCStringLen
  	where