Skip to content

Commit

Permalink
Add range types to static typeinfo table
Browse files Browse the repository at this point in the history
  • Loading branch information
@lpsmith
lpsmith committed Jul 15, 2015
1 parent d1a8c8f commit 6d044b8
Show file tree
Hide file tree
Showing 2 changed files with 189 additions and 17 deletions.
132 changes: 132 additions & 0 deletions src/Database/PostgreSQL/Simple/TypeInfo/Static.hs
View file
Expand Up @@ -114,6 +114,18 @@ module Database.PostgreSQL.Simple.TypeInfo.Static
, array_refcursor
, array_uuid
, array_jsonb
, int4range
, _int4range
, numrange
, _numrange
, tsrange
, _tsrange
, tstzrange
, _tstzrange
, daterange
, _daterange
, int8range
, _int8range
) where

import Database.PostgreSQL.LibPQ (Oid(..))
Expand Down Expand Up @@ -217,6 +229,18 @@ staticTypeInfo (Oid x) = case x of
2201 -> Just array_refcursor
2951 -> Just array_uuid
3807 -> Just array_jsonb
3904 -> Just int4range
3905 -> Just _int4range
3906 -> Just numrange
3907 -> Just _numrange
3908 -> Just tsrange
3909 -> Just _tsrange
3910 -> Just tstzrange
3911 -> Just _tstzrange
3912 -> Just daterange
3913 -> Just _daterange
3926 -> Just int8range
3927 -> Just _int8range
_ -> Nothing

bool :: TypeInfo
Expand Down Expand Up @@ -1035,3 +1059,111 @@ array_jsonb = Array {
typname = "_jsonb",
typelem = jsonb
}

int4range :: TypeInfo
int4range = Range {
typoid = Oid 3904,
typcategory = 'R',
typdelim = ',',
typname = "int4range",
rngsubtype = int4
}

_int4range :: TypeInfo
_int4range = Array {
typoid = Oid 3905,
typcategory = 'A',
typdelim = ',',
typname = "_int4range",
typelem = int4range
}

numrange :: TypeInfo
numrange = Range {
typoid = Oid 3906,
typcategory = 'R',
typdelim = ',',
typname = "numrange",
rngsubtype = numeric
}

_numrange :: TypeInfo
_numrange = Array {
typoid = Oid 3907,
typcategory = 'A',
typdelim = ',',
typname = "_numrange",
typelem = numrange
}

tsrange :: TypeInfo
tsrange = Range {
typoid = Oid 3908,
typcategory = 'R',
typdelim = ',',
typname = "tsrange",
rngsubtype = timestamp
}

_tsrange :: TypeInfo
_tsrange = Array {
typoid = Oid 3909,
typcategory = 'A',
typdelim = ',',
typname = "_tsrange",
typelem = tsrange
}

tstzrange :: TypeInfo
tstzrange = Range {
typoid = Oid 3910,
typcategory = 'R',
typdelim = ',',
typname = "tstzrange",
rngsubtype = timestamptz
}

_tstzrange :: TypeInfo
_tstzrange = Array {
typoid = Oid 3911,
typcategory = 'A',
typdelim = ',',
typname = "_tstzrange",
typelem = tstzrange
}

daterange :: TypeInfo
daterange = Range {
typoid = Oid 3912,
typcategory = 'R',
typdelim = ',',
typname = "daterange",
rngsubtype = date
}

_daterange :: TypeInfo
_daterange = Array {
typoid = Oid 3913,
typcategory = 'A',
typdelim = ',',
typname = "_daterange",
typelem = daterange
}

int8range :: TypeInfo
int8range = Range {
typoid = Oid 3926,
typcategory = 'R',
typdelim = ',',
typname = "int8range",
rngsubtype = int8
}

_int8range :: TypeInfo
_int8range = Array {
typoid = Oid 3927,
typcategory = 'A',
typdelim = ',',
typname = "_int8range",
typelem = int8range
}
74 changes: 57 additions & 17 deletions tools/GenTypeInfo.hs
View file
Expand Up @@ -63,10 +63,11 @@ data TypeInfo = TypeInfo
, typdelim :: Char
, typname :: ByteString
, typelem :: Oid
, rngsubtype :: Maybe Oid
}

instance FromRow TypeInfo where
fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field
instance FromRow TypeInfo where
fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

type NameMap = Map.Map B.ByteString TypeInfo

Expand Down Expand Up @@ -176,6 +177,18 @@ _varbit array_varbit
_refcursor array_refcursor
_uuid array_uuid
_jsonb array_jsonb
int4range
_int4range
numrange
_numrange
tsrange
_tsrange
tstzrange
_tstzrange
daterange
_daterange
int8range
_int8range
|]

instance IsString Blaze.Builder where
Expand All @@ -187,28 +200,31 @@ withPostgreSQL = bracket (connectPostgreSQL connectionString) close

getTypeInfos :: TypeNames -> IO (OidMap, NameMap)
getTypeInfos typnames = withPostgreSQL $ \conn -> do
infos <- query conn [sql|
SELECT oid, typcategory, typdelim, typname, typelem
FROM pg_type
WHERE typname IN ?
|]
(Only (In (sort (map pg typnames))))
infos <- query conn [sql|
WITH types AS
(SELECT oid, typcategory, typdelim, typname, typelem
FROM pg_type WHERE typname IN ?)
SELECT types.*, rngsubtype FROM types LEFT JOIN pg_range ON oid = rngtypid
|] (Only (In (sort (map pg typnames))))
loop conn (oidMap infos) (nameMap infos) infos
where
oidMap = Map.fromList . map (typoid &&& id)
nameMap = Map.fromList . map (typname &&& id)
loop conn oids names infos = do
let unknowns = [ x | x <- map typelem infos,
let unknowns = [ x | x <- map typelem infos ++
[ x | Just x <- map rngsubtype infos ],
x /= Oid 0,
not (Map.member x oids) ]
case unknowns of
[] -> return (oids, names)
(_:_) -> do
infos' <- query conn [sql|
SELECT oid, typcategory, typdelim, typname, typelem
FROM pg_type
WHERE oid IN ?
|] (Only (In (sort unknowns)))
WITH types AS
(SELECT oid, typcategory, typdelim, typname, typelem
FROM pg_type WHERE oid IN ?)
SELECT types.*, rngsubtype
FROM types LEFT JOIN pg_range ON oid = rngtypid
|] (Only (In (sort unknowns)))
let oids' = oids `Map.union` oidMap infos'
names' = names `Map.union` nameMap infos'
loop conn oids' names' infos'
Expand Down Expand Up @@ -239,9 +255,13 @@ renderTypeInfo :: OidMap -> TypeInfo -> TypeName -> Blaze.Builder
renderTypeInfo byOid info name
| typcategory info == 'A' || typname info == "_record" =
let (Just typelem_info) = Map.lookup (typelem info) byOid
typelem_hs_name = case lookup (typname typelem_info) typeNames of
Nothing -> error ("type not found: " ++ B.unpack( typname typelem_info) ++ " (typelem of " ++ B.unpack (typname info) ++ ")")
Just x -> x
typelem_hs_name =
case lookup (typname typelem_info) typeNames of
Nothing -> error ( "type not found: "
++ B.unpack( typname typelem_info)
++ " (typelem of " ++ B.unpack (typname info)
++ ")")
Just x -> x
in concat
[ "\n"
, bs (hs name), " :: TypeInfo\n"
Expand All @@ -253,7 +273,27 @@ renderTypeInfo byOid info name
, " typelem = ", bs typelem_hs_name, "\n"
, " }\n"
]
| typcategory info == 'R' = undefined
| typcategory info == 'R' =
let (Just rngsubtype_oid) = rngsubtype info
(Just rngsubtype_info) = Map.lookup rngsubtype_oid byOid
rngsubtype_hs_name =
case lookup (typname rngsubtype_info) typeNames of
Nothing -> error ( "type not found: "
++ B.unpack (typname rngsubtype_info)
++ " (rngsubtype of "
++ B.unpack (typname info) ++ ")")
Just x -> x
in concat
[ "\n"
, bs (hs name), " :: TypeInfo\n"
, bs (hs name), " = Range {\n"
, " typoid = ", fromString (show (typoid info)), ",\n"
, " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
, " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
, " typname = \"", bs (typname info), "\",\n"
, " rngsubtype = ", bs rngsubtype_hs_name, "\n"
, " }\n"
]
| otherwise =
concat
[ "\n"
Expand Down

0 comments on commit 6d044b8

Please sign in to comment.