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)
|
