[htoolkit-cvs] HSQL/PostgreSQL HSQL.hsc,1.1,1.2

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

Update of /cvsroot/htoolkit/HSQL/PostgreSQL
In directory sc8-pr-cvs1:/tmp/cvs-serv1131/PostgreSQL

Modified Files:
	HSQL.hsc 
Log Message:
Add support for inet, cidr and macaddr sql types


Index: HSQL.hsc
===================================================================
RCS file: /cvsroot/htoolkit/HSQL/PostgreSQL/HSQL.hsc,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** HSQL.hsc	6 Sep 2003 19:59:06 -0000	1.1
--- HSQL.hsc	6 Sep 2003 21:50:28 -0000	1.2
***************
*** 33,36 ****
--- 33,37 ----
  		, collectRows		-- :: (Statement -> IO s) -> Statement -> IO [s]
  		, Point(..), Line(..), Path(..), Box(..), Circle(..), Polygon(..)
+ 		, INetAddr(..), MacAddr(..)
  		) where
  
***************
*** 38,41 ****
--- 39,43 ----
  import Data.Dynamic
  import Data.IORef
+ import Data.Char
  import Foreign
  import Foreign.C
***************
*** 46,49 ****
--- 48,52 ----
  import Text.ParserCombinators.ReadP
  import Text.Read
+ import Numeric
  
  # include <time.h>
***************
*** 418,422 ****
                         where
                           t = toUTCTime ct
!                          score = showChar '.'
                           space = showChar ' '
                           colon = showChar ':'
--- 421,425 ----
                         where
                           t = toUTCTime ct
!                          score = showChar '-'
                           space = showChar ' '
                           colon = showChar ':'
***************
*** 477,480 ****
--- 480,545 ----
  
  	toSqlValue (Circle (Point x y) r) = "'<" ++ show (x,y) ++ "," ++ show r ++ "'>"
+ 
+ data INetAddr = INetAddr Int Int Int Int Int deriving (Eq,Show)
+ 
+ instance SqlBind INetAddr where
+ 	fromSqlValue t s
+ 		| t == SqlINetAddr || t == SqlCIDRAddr =
+ 			case readNum s of
+ 				(x1,s) -> case readNum s of
+ 					(x2,s) -> case readNum s of
+ 						(x3,s) -> case readNum s of
+ 							(x4,s) -> case readNum s of
+ 								(mask,_) -> Just (INetAddr x1 x2 x3 x4 mask)
+ 		| otherwise = Nothing
+ 		where
+ 			readNum s = case readDec s of
+ 				[(x,'.':s)] -> (x,s)
+ 				[(x,'/':s)] -> (x,s)
+ 				[(x,"")]    -> (x,"")
+ 				_           -> (0,"")
+ 
+ 	toSqlValue (INetAddr x1 x2 x3 x4 mask) = '\'' :
+ 		(shows x1 .
+ 		 dot .
+ 		 shows x2.
+ 		 dot .
+ 		 shows x3 .
+ 		 dot .
+ 		 shows x4 .
+ 		 slash .
+ 		 shows mask) "'"
+ 		where
+ 			dot = showChar '.'
+ 			slash = showChar '/'
+ 
+ data MacAddr = MacAddr Int Int Int Int Int Int deriving (Eq,Show)
+ 
+ instance SqlBind MacAddr where
+ 	fromSqlValue SqlMacAddr s =
+ 		case readHex s of
+ 			[(x1,':':s)] -> case readHex s of
+ 				[(x2,':':s)] -> case readHex s of
+ 					[(x3,':':s)] -> case readHex s of
+ 						[(x4,':':s)] -> case readHex s of
+ 							[(x5,':':s)] -> case readHex s of
+ 								[(x6,_)] -> Just (MacAddr x1 x2 x3 x4 x5 x6)
+ 	fromSqlValue _ _ = Nothing
+ 
+ 	toSqlValue (MacAddr x1 x2 x3 x4 x5 x6) = '\'' :
+ 		(showHex x1 .
+ 		 colon .
+ 		 showHex x2 .
+ 		 colon .
+ 		 showHex x3 .
+ 		 colon .
+ 		 showHex x4 .
+ 		 colon .
+ 		 showHex x5 .
+ 		 colon .
+ 		 showHex x6) "'"
+ 		where
+ 			colon = showChar ':'
+ 			showHex = showIntAtBase 16 intToDigit
  
  getFieldValueMB :: SqlBind a => Statement -> String -> IO (Maybe a)