Add range types to static typeinfo table

Author: lpsmith

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

@@ -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(..))
@@ -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
@@ -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
+  }

tools/GenTypeInfo.hs

@@ -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
 
@@ -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
@@ -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'
@@ -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"
@@ -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"