[htoolkit-cvs] HSQL/HSQL/Database HSQL.hsc,1.2,1.3

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

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

Modified Files:
	HSQL.hsc 
Log Message:
Another way to handle null values in HSQL. Not tested yet.


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/HSQL/Database/HSQL.hsc,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** HSQL.hsc	14 Jun 2005 09:39:56 -0000	1.2
--- HSQL.hsc	12 Dec 2005 15:21:55 -0000	1.3
***************
*** 29,33 ****
  	-- * Retrieving Statement values and types
  	, FieldDef, SqlType(..), SqlBind, toSqlValue
- 	, getFieldValueMB   -- :: SqlBind a => Statement -> String -> IO (Maybe a)
  	, getFieldValue     -- :: SqlBind a => Statement -> String -> IO a
  	, getFieldValue'    -- :: SqlBind a => Statement -> String -> a -> IO a
--- 29,32 ----
***************
*** 194,243 ****
  #endif
  
  instance SqlBind Int where
! 	fromNonNullSqlCStringLen sqlType cstr cstrLen = do
! 	    if sqlType==SqlInteger || sqlType==SqlMedInt 
! 	       || sqlType==SqlTinyInt || sqlType==SqlSmallInt
! 	       || sqlType==SqlBigInt
! 		then do
! 		    val <- c_atoi cstr
! 		    return (Just val)
! 		else
! 		    return Nothing
  
! 	fromSqlValue SqlInteger  s = Just (read s)
! 	fromSqlValue SqlMedInt s   = Just (read s)
! 	fromSqlValue SqlTinyInt s  = Just (read s)
! 	fromSqlValue SqlSmallInt s = Just (read s)
! 	fromSqlValue SqlBigInt s = Just (read s)
! 	fromSqlValue SqlDouble s = Just (truncate (read s :: Double))
! 	fromSqlValue SqlText   s = Just (read s)
! 	fromSqlValue _ _           = Nothing
  
! 	toSqlValue s = show s
  
  instance SqlBind Int64 where
! 	fromNonNullSqlCStringLen sqlType cstr cstrLen = do
! 	    if sqlType==SqlInteger || sqlType==SqlMedInt 
! 	       || sqlType==SqlTinyInt || sqlType==SqlSmallInt || sqlType==SqlBigInt
! 	      then do
  #ifdef mingw32_TARGET_OS
! 	        val <- c_atoi64 cstr
  #else
! 	        val <- c_strtoll cstr nullPtr 10
  #endif
! 	        return (Just val)
! 	      else
! 	        return Nothing
  
! 	fromSqlValue SqlInteger s = Just (read s)
! 	fromSqlValue SqlMedInt s   = Just (read s)
! 	fromSqlValue SqlTinyInt s  = Just (read s)
! 	fromSqlValue SqlSmallInt s = Just (read s)
! 	fromSqlValue SqlBigInt s = Just (read s)
! 	fromSqlValue SqlDouble s = Just (truncate (read s :: Double))
! 	fromSqlValue SqlText   s = Just (read s)
! 	fromSqlValue _ s = Nothing
  
! 	toSqlValue val = show val
  
  instance SqlBind Integer where
--- 193,254 ----
  #endif
  
+ instance SqlBind a => SqlBind (Maybe a) where
+   fromSqlCStringLen fieldDef cstr cstrLen
+     | cstr == nullPtr = return Nothing
+     | otherwise       = do v <- fromSqlCStringLen fieldDef cstr cstrLen
+                            return (Just v)
+                            
+   fromSqlValue tp "null" = Nothing
+   fromSqlValue tp s      = fromSqlValue tp s
+ 
+   toSqlValue (Just v) = toSqlValue v
+   toSqlValue Nothing  = "null"
+ 
  instance SqlBind Int where
!   fromSqlCStringLen (name,sqlType,_) cstr cstrLen
!     | cstr == nullPtr        = throwDyn (SqlFetchNull name)
!     | sqlType==SqlInteger || 
!       sqlType==SqlMedInt  ||
!       sqlType==SqlTinyInt ||
!       sqlType==SqlSmallInt||
!       sqlType==SqlBigInt     = c_atoi cstr
!     | otherwise              = throwDyn (SqlBadTypeCast name sqlType)
  
!   fromSqlValue SqlInteger  s = Just (read s)
!   fromSqlValue SqlMedInt   s = Just (read s)
!   fromSqlValue SqlTinyInt  s = Just (read s)
!   fromSqlValue SqlSmallInt s = Just (read s)
!   fromSqlValue SqlBigInt   s = Just (read s)
!   fromSqlValue SqlDouble   s = Just (truncate (read s :: Double))
!   fromSqlValue SqlText     s = Just (read s)
!   fromSqlValue _ _           = Nothing
  
!   toSqlValue s = show s
  
  instance SqlBind Int64 where
!   fromSqlCStringLen (name,sqlType,_) cstr cstrLen
!     | cstr == nullPtr        = throwDyn (SqlFetchNull name)
!     | sqlType==SqlInteger ||
!       sqlType==SqlMedInt  ||
!       sqlType==SqlTinyInt ||
!       sqlType==SqlSmallInt||
!       sqlType==SqlBigInt     =
  #ifdef mingw32_TARGET_OS
! 	                       c_atoi64 cstr
  #else
! 	                       c_strtoll cstr nullPtr 10
  #endif
!     | otherwise              = throwDyn (SqlBadTypeCast name sqlType)
  
!   fromSqlValue SqlInteger s = Just (read s)
!   fromSqlValue SqlMedInt s   = Just (read s)
!   fromSqlValue SqlTinyInt s  = Just (read s)
!   fromSqlValue SqlSmallInt s = Just (read s)
!   fromSqlValue SqlBigInt s = Just (read s)
!   fromSqlValue SqlDouble s = Just (truncate (read s :: Double))
!   fromSqlValue SqlText   s = Just (read s)
!   fromSqlValue _ s = Nothing
  
!   toSqlValue val = show val
  
  instance SqlBind Integer where
***************
*** 530,559 ****
  
  -- | Retrieves the value of field with the specified name.
- -- The returned value is Nothing if the field value is @null@.
- getFieldValueMB :: SqlBind a => Statement
-                              -> String         -- ^ Field name
-                              -> IO (Maybe a)   -- ^ Field value or Nothing
- getFieldValueMB stmt name = checkHandle (stmtClosed stmt) $
- 	stmtGetCol stmt colNumber (name,sqlType,nullable) fromCStr
- 	where
- 		(sqlType,nullable,colNumber) = findFieldInfo name (stmtFields stmt) 0
-                 fromCStr t c l = do m <- fromNonNullSqlCStringLen t c l
-                                     case m of
-                                            Just _ -> return m
-                                            Nothing ->
-                                                do str <- peekCStringLen (c, l)
-                                                   return (fromSqlValue t str)
- 
- 
- -- | Retrieves the value of field with the specified name.
- -- If the field value is @null@ then the function will throw 'SqlFetchNull' exception.
  getFieldValue :: SqlBind a => Statement
                             -> String       -- ^ Field name
                             -> IO a         -- ^ Field value
  getFieldValue stmt name = do
! 	mb_v <- getFieldValueMB stmt name
! 	case mb_v of
! 		Nothing -> throwDyn (SqlFetchNull name)
! 		Just a  -> return a
  
  -- | Retrieves the value of field with the specified name.
--- 541,551 ----
  
  -- | Retrieves the value of field with the specified name.
  getFieldValue :: SqlBind a => Statement
                             -> String       -- ^ Field name
                             -> IO a         -- ^ Field value
  getFieldValue stmt name = do
!   stmtGetCol stmt colNumber (name,sqlType,nullable) fromSqlCStringLen
!   where
!     (sqlType,nullable,colNumber) = findFieldInfo name (stmtFields stmt) 0
  
  -- | Retrieves the value of field with the specified name.
***************
*** 564,569 ****
                              -> IO a       -- ^ Field value
  getFieldValue' stmt name def = do
! 	mb_v <- getFieldValueMB stmt name
! 	return (case mb_v of { Nothing -> def; Just a -> a })
  
  
--- 556,561 ----
                              -> IO a       -- ^ Field value
  getFieldValue' stmt name def = do
!   mb_v <- getFieldValue stmt name
!   return (case mb_v of { Nothing -> def; Just a -> a })