f4e2ff6 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Extend TypeInfo to cover Composite types

f4e2ff6Leon P Smith14 years ago

src/Database/PostgreSQL/Simple/FromRow.hs-boot+9−2

compare with master

unifiedsplit

@@ -6,6 +6,13 @@ import Database.PostgreSQL.Simple.Types

6class FromRow a

8instance (FromField a) => FromRow (Only a)

9−instance (FromField a, FromField b, FromField c, FromField d) => FromRow (a,b,c,d)

9+instance (FromField a, FromField b)

10+ => FromRow (a,b)

11+instance (FromField a, FromField b, FromField c, FromField d)

12+ => FromRow (a,b,c,d)

13+instance (FromField a, FromField b, FromField c, FromField d, FromField e)

14+ => FromRow (a,b,c,d,e)

10−instance (FromField a, FromField b, FromField c, FromField d, FromField e) => FromRow (a,b,c,d,e)

15+instance (FromField a, FromField b, FromField c, FromField d, FromField e

16+ ,FromField f)

17+ => FromRow (a,b,c,d,e,f)

src/Database/PostgreSQL/Simple/TypeInfo.hs+34−5

@@ -27,7 +27,10 @@ module Database.PostgreSQL.Simple.TypeInfo

27 , TypeInfo(..)

28 ) where

30+import qualified Data.ByteString as B

30import qualified Data.IntMap as IntMap

31import qualified Data.IntMap as IntMap

32+import qualified Data.Vector as V

33+import qualified Data.Vector.Mutable as MV

31import Control.Concurrent.MVar

34import Control.Concurrent.MVar

32import Control.Exception (throw)

35import Control.Exception (throw)

@@ -57,18 +60,19 @@ getTypeInfo' conn oid oidmap =

57 case IntMap.lookup (oid2int oid) oidmap of

60 case IntMap.lookup (oid2int oid) oidmap of

58 Just typeinfo -> return (oidmap, typeinfo)

61 Just typeinfo -> return (oidmap, typeinfo)

59 Nothing -> do

62 Nothing -> do

60− names <- query conn "SELECT oid, typcategory, typdelim, typname, typelem\

63+ names <- query conn "SELECT oid, typcategory, typdelim, typname,\

64+ \ typelem, typrelid\

61 \ FROM pg_type WHERE oid = ?"

65 \ FROM pg_type WHERE oid = ?"

62 (Only oid)

66 (Only oid)

63 (oidmap', typeInfo) <-

67 (oidmap', typeInfo) <-

64 case names of

68 case names of

65 [] -> return $ throw (fatalError "invalid type oid")

69 [] -> return $ throw (fatalError "invalid type oid")

66− [(typoid, typcategory, typdelim, typname, typelem_)] -> do

70+ [(typoid, typcategory, typdelim, typname, typelem_, typrelid)] -> do

67 case typcategory of

71 case typcategory of

68 'A' -> do

72 'A' -> do

69 (oidmap', typelem) <- getTypeInfo' conn typelem_ oidmap

73 (oidmap', typelem) <- getTypeInfo' conn typelem_ oidmap

70 let !typeInfo = Array{..}

74 let !typeInfo = Array{..}

71− return (oidmap', typeInfo)

75+ return $! (oidmap', typeInfo)

72 'R' -> do

76 'R' -> do

73 rngsubtypeOids <- query conn "SELECT rngsubtype\

77 rngsubtypeOids <- query conn "SELECT rngsubtype\

74 \ FROM pg_range\

78 \ FROM pg_range\

@@ -79,13 +83,38 @@ getTypeInfo' conn oid oidmap =

79 (oidmap', rngsubtype) <-

83 (oidmap', rngsubtype) <-

80 getTypeInfo' conn rngsubtype_ oidmap

84 getTypeInfo' conn rngsubtype_ oidmap

81 let !typeInfo = Range{..}

85 let !typeInfo = Range{..}

82− return (oidmap', typeInfo)

86+ return $! (oidmap', typeInfo)

83 _ -> fail "range subtype query failed to return exactly one result"

87 _ -> fail "range subtype query failed to return exactly one result"

88+ 'C' -> do

89+ cols <- query conn "SELECT attname, atttypid\

90+ \ FROM pg_attribute\

91+ \ WHERE attrelid = ?\

92+ \ AND attnum > 0\

93+ \ AND NOT attisdropped\

94+ \ ORDER BY attnum"

95+ (Only typrelid)

96+ vec <- MV.new $! length cols

97+ (oidmap', attributes) <- getAttInfos conn cols oidmap vec 0

98+ let !typeInfo = Composite{..}

99+ return $! (oidmap', typeInfo)

84 _ -> do

100 _ -> do

85 let !typeInfo = Basic{..}

101 let !typeInfo = Basic{..}

86− return (oidmap, typeInfo)

102+ return $! (oidmap, typeInfo)

87 _ -> fail "typename query returned more than one result"

103 _ -> fail "typename query returned more than one result"

88 -- oid is a primary key, so the query should

104 -- oid is a primary key, so the query should

89 -- never return more than one result

105 -- never return more than one result

90 let !oidmap'' = IntMap.insert (oid2int oid) typeInfo oidmap'

106 let !oidmap'' = IntMap.insert (oid2int oid) typeInfo oidmap'

91 return $! (oidmap'', typeInfo)

107 return $! (oidmap'', typeInfo)

108+

109+getAttInfos :: Connection -> [(B.ByteString, PQ.Oid)] -> TypeInfoCache

110+ -> MV.IOVector Attribute -> Int

111+ -> IO (TypeInfoCache, V.Vector Attribute)

112+getAttInfos conn cols oidmap vec n =

113+ case cols of

114+ [] -> do

115+ !attributes <- V.unsafeFreeze vec

116+ return $! (oidmap, attributes)

117+ ((attname, attTypeOid):xs) -> do

118+ (oidmap', atttype) <- getTypeInfo' conn attTypeOid oidmap

119+ MV.write vec n $! Attribute{..}

120+ getAttInfos conn xs oidmap' vec (n+1)

src/Database/PostgreSQL/Simple/TypeInfo/Types.hs+15

@@ -12,6 +12,7 @@ module Database.PostgreSQL.Simple.TypeInfo.Types where

13import Data.ByteString(ByteString)

14import Database.PostgreSQL.LibPQ(Oid)

15+import Data.Vector(Vector)

16-- | A structure representing some of the metadata regarding a PostgreSQL

17-- | A structure representing some of the metadata regarding a PostgreSQL

17-- type, mostly taken from the @pg_type@ table.

18-- type, mostly taken from the @pg_type@ table.

@@ -38,4 +39,18 @@ data TypeInfo

38 , rngsubtype :: !TypeInfo

39 , rngsubtype :: !TypeInfo

39 }

40 }

42+ | Composite { typoid :: {-# UNPACK #-} !Oid

43+ , typcategory :: {-# UNPACK #-} !Char

44+ , typdelim :: {-# UNPACK #-} !Char

45+ , typname :: !ByteString

46+ , typrelid :: {-# UNPACK #-} !Oid

47+ , attributes :: !(Vector Attribute)

48+ }

49+

41 deriving (Show)

50 deriving (Show)

51+

52+data Attribute

53+ = Attribute { attname :: !ByteString

54+ , atttype :: !TypeInfo

55+ }

56+ deriving (Show)