6d044b8 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Add range types to static typeinfo table

6d044b8Leon P Smith11 years ago

src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+132

compare with master

unifiedsplit

@@ -114,6 +114,18 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

114 , array_refcursor

115 , array_uuid

116 , array_jsonb

117+ , int4range

118+ , _int4range

119+ , numrange

120+ , _numrange

121+ , tsrange

122+ , _tsrange

123+ , tstzrange

124+ , _tstzrange

125+ , daterange

126+ , _daterange

127+ , int8range

128+ , _int8range

117 ) where

129 ) where

118

130

119import Database.PostgreSQL.LibPQ (Oid(..))

131import Database.PostgreSQL.LibPQ (Oid(..))

@@ -217,6 +229,18 @@ staticTypeInfo (Oid x) = case x of

217 2201 -> Just array_refcursor

229 2201 -> Just array_refcursor

218 2951 -> Just array_uuid

230 2951 -> Just array_uuid

219 3807 -> Just array_jsonb

231 3807 -> Just array_jsonb

232+ 3904 -> Just int4range

233+ 3905 -> Just _int4range

234+ 3906 -> Just numrange

235+ 3907 -> Just _numrange

236+ 3908 -> Just tsrange

237+ 3909 -> Just _tsrange

238+ 3910 -> Just tstzrange

239+ 3911 -> Just _tstzrange

240+ 3912 -> Just daterange

241+ 3913 -> Just _daterange

242+ 3926 -> Just int8range

243+ 3927 -> Just _int8range

220 _ -> Nothing

244 _ -> Nothing

221

245

222bool :: TypeInfo

246bool :: TypeInfo

@@ -1035,3 +1059,111 @@ array_jsonb = Array {

1035 typname = "_jsonb",

1059 typname = "_jsonb",

1036 typelem = jsonb

1060 typelem = jsonb

1037 }

1061 }

1062+

1063+int4range :: TypeInfo

1064+int4range = Range {

1065+ typoid = Oid 3904,

1066+ typcategory = 'R',

1067+ typdelim = ',',

1068+ typname = "int4range",

1069+ rngsubtype = int4

1070+ }

1071+

1072+_int4range :: TypeInfo

1073+_int4range = Array {

1074+ typoid = Oid 3905,

1075+ typcategory = 'A',

1076+ typdelim = ',',

1077+ typname = "_int4range",

1078+ typelem = int4range

1079+ }

1080+

1081+numrange :: TypeInfo

1082+numrange = Range {

1083+ typoid = Oid 3906,

1084+ typcategory = 'R',

1085+ typdelim = ',',

1086+ typname = "numrange",

1087+ rngsubtype = numeric

1088+ }

1089+

1090+_numrange :: TypeInfo

1091+_numrange = Array {

1092+ typoid = Oid 3907,

1093+ typcategory = 'A',

1094+ typdelim = ',',

1095+ typname = "_numrange",

1096+ typelem = numrange

1097+ }

1098+

1099+tsrange :: TypeInfo

1100+tsrange = Range {

1101+ typoid = Oid 3908,

1102+ typcategory = 'R',

1103+ typdelim = ',',

1104+ typname = "tsrange",

1105+ rngsubtype = timestamp

1106+ }

1107+

1108+_tsrange :: TypeInfo

1109+_tsrange = Array {

1110+ typoid = Oid 3909,

1111+ typcategory = 'A',

1112+ typdelim = ',',

1113+ typname = "_tsrange",

1114+ typelem = tsrange

1115+ }

1116+

1117+tstzrange :: TypeInfo

1118+tstzrange = Range {

1119+ typoid = Oid 3910,

1120+ typcategory = 'R',

1121+ typdelim = ',',

1122+ typname = "tstzrange",

1123+ rngsubtype = timestamptz

1124+ }

1125+

1126+_tstzrange :: TypeInfo

1127+_tstzrange = Array {

1128+ typoid = Oid 3911,

1129+ typcategory = 'A',

1130+ typdelim = ',',

1131+ typname = "_tstzrange",

1132+ typelem = tstzrange

1133+ }

1134+

1135+daterange :: TypeInfo

1136+daterange = Range {

1137+ typoid = Oid 3912,

1138+ typcategory = 'R',

1139+ typdelim = ',',

1140+ typname = "daterange",

1141+ rngsubtype = date

1142+ }

1143+

1144+_daterange :: TypeInfo

1145+_daterange = Array {

1146+ typoid = Oid 3913,

1147+ typcategory = 'A',

1148+ typdelim = ',',

1149+ typname = "_daterange",

1150+ typelem = daterange

1151+ }

1152+

1153+int8range :: TypeInfo

1154+int8range = Range {

1155+ typoid = Oid 3926,

1156+ typcategory = 'R',

1157+ typdelim = ',',

1158+ typname = "int8range",

1159+ rngsubtype = int8

1160+ }

1161+

1162+_int8range :: TypeInfo

1163+_int8range = Array {

1164+ typoid = Oid 3927,

1165+ typcategory = 'A',

1166+ typdelim = ',',

1167+ typname = "_int8range",

1168+ typelem = int8range

1169+ }

tools/GenTypeInfo.hs+57−17

@@ -63,10 +63,11 @@ data TypeInfo = TypeInfo

63 , typdelim :: Char

64 , typname :: ByteString

65 , typelem :: Oid

66+ , rngsubtype :: Maybe Oid

66 }

67 }

68−instance FromRow TypeInfo where

69+instance FromRow TypeInfo where

69− fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field

70+ fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

71type NameMap = Map.Map B.ByteString TypeInfo

72type NameMap = Map.Map B.ByteString TypeInfo

@@ -176,6 +177,18 @@ _varbit array_varbit

176_refcursor array_refcursor

177_refcursor array_refcursor

177_uuid array_uuid

178_uuid array_uuid

178_jsonb array_jsonb

179_jsonb array_jsonb

180+int4range

181+_int4range

182+numrange

183+_numrange

184+tsrange

185+_tsrange

186+tstzrange

187+_tstzrange

188+daterange

189+_daterange

190+int8range

191+_int8range

179|]

192|]

180

193

181instance IsString Blaze.Builder where

194instance IsString Blaze.Builder where

@@ -187,28 +200,31 @@ withPostgreSQL = bracket (connectPostgreSQL connectionString) close

187

200

188getTypeInfos :: TypeNames -> IO (OidMap, NameMap)

201getTypeInfos :: TypeNames -> IO (OidMap, NameMap)

189getTypeInfos typnames = withPostgreSQL $ \conn -> do

202getTypeInfos typnames = withPostgreSQL $ \conn -> do

190− infos <- query conn [sql|

203+ infos <- query conn [sql|

204+ WITH types AS

191− SELECT oid, typcategory, typdelim, typname, typelem

205+ (SELECT oid, typcategory, typdelim, typname, typelem

192− FROM pg_type

193− WHERE typname IN ?

206+ FROM pg_type WHERE typname IN ?)

194− |]

207+ SELECT types.*, rngsubtype FROM types LEFT JOIN pg_range ON oid = rngtypid

195− (Only (In (sort (map pg typnames))))

208+ |] (Only (In (sort (map pg typnames))))

196 loop conn (oidMap infos) (nameMap infos) infos

209 loop conn (oidMap infos) (nameMap infos) infos

197 where

210 where

198 oidMap = Map.fromList . map (typoid &&& id)

211 oidMap = Map.fromList . map (typoid &&& id)

199 nameMap = Map.fromList . map (typname &&& id)

212 nameMap = Map.fromList . map (typname &&& id)

200 loop conn oids names infos = do

213 loop conn oids names infos = do

201− let unknowns = [ x | x <- map typelem infos,

214+ let unknowns = [ x | x <- map typelem infos ++

215+ [ x | Just x <- map rngsubtype infos ],

202 x /= Oid 0,

216 x /= Oid 0,

203 not (Map.member x oids) ]

217 not (Map.member x oids) ]

204 case unknowns of

218 case unknowns of

205 [] -> return (oids, names)

219 [] -> return (oids, names)

206 (_:_) -> do

220 (_:_) -> do

207 infos' <- query conn [sql|

221 infos' <- query conn [sql|

222+ WITH types AS

208− SELECT oid, typcategory, typdelim, typname, typelem

223+ (SELECT oid, typcategory, typdelim, typname, typelem

209− FROM pg_type

224+ FROM pg_type WHERE oid IN ?)

210− WHERE oid IN ?

225+ SELECT types.*, rngsubtype

226+ FROM types LEFT JOIN pg_range ON oid = rngtypid

211− |] (Only (In (sort unknowns)))

227+ |] (Only (In (sort unknowns)))

212 let oids' = oids `Map.union` oidMap infos'

228 let oids' = oids `Map.union` oidMap infos'

213 names' = names `Map.union` nameMap infos'

229 names' = names `Map.union` nameMap infos'

214 loop conn oids' names' infos'

230 loop conn oids' names' infos'

@@ -239,9 +255,13 @@ renderTypeInfo :: OidMap -> TypeInfo -> TypeName -> Blaze.Builder

239renderTypeInfo byOid info name

255renderTypeInfo byOid info name

240 | typcategory info == 'A' || typname info == "_record" =

256 | typcategory info == 'A' || typname info == "_record" =

241 let (Just typelem_info) = Map.lookup (typelem info) byOid

257 let (Just typelem_info) = Map.lookup (typelem info) byOid

258+ typelem_hs_name =

242− typelem_hs_name = case lookup (typname typelem_info) typeNames of

259+ case lookup (typname typelem_info) typeNames of

260+ Nothing -> error ( "type not found: "

261+ ++ B.unpack( typname typelem_info)

243− Nothing -> error ("type not found: " ++ B.unpack( typname typelem_info) ++ " (typelem of " ++ B.unpack (typname info) ++ ")")

262+ ++ " (typelem of " ++ B.unpack (typname info)

263+ ++ ")")

244− Just x -> x

264+ Just x -> x

245 in concat

265 in concat

246 [ "\n"

266 [ "\n"

247 , bs (hs name), " :: TypeInfo\n"

267 , bs (hs name), " :: TypeInfo\n"

@@ -253,7 +273,27 @@ renderTypeInfo byOid info name

253 , " typelem = ", bs typelem_hs_name, "\n"

273 , " typelem = ", bs typelem_hs_name, "\n"

254 , " }\n"

274 , " }\n"

255 ]

275 ]

256− | typcategory info == 'R' = undefined

276+ | typcategory info == 'R' =

277+ let (Just rngsubtype_oid) = rngsubtype info

278+ (Just rngsubtype_info) = Map.lookup rngsubtype_oid byOid

279+ rngsubtype_hs_name =

280+ case lookup (typname rngsubtype_info) typeNames of

281+ Nothing -> error ( "type not found: "

282+ ++ B.unpack (typname rngsubtype_info)

283+ ++ " (rngsubtype of "

284+ ++ B.unpack (typname info) ++ ")")

285+ Just x -> x

286+ in concat

287+ [ "\n"

288+ , bs (hs name), " :: TypeInfo\n"

289+ , bs (hs name), " = Range {\n"

290+ , " typoid = ", fromString (show (typoid info)), ",\n"

291+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

292+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

293+ , " typname = \"", bs (typname info), "\",\n"

294+ , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

295+ , " }\n"

296+ ]

257 | otherwise =

297 | otherwise =

258 concat

298 concat

259 [ "\n"

299 [ "\n"