@@ -4,6 +4,7 @@
44{-# LANGUAGE PatternGuards #-}
55{-# LANGUAGE RecordWildCards #-}
66{-# LANGUAGE ViewPatterns #-}
7+{-# LANGUAGE QuasiQuotes #-}
78
89------------------------------------------------------------------------------
910-- |
@@ -140,6 +141,7 @@ import Database.PostgreSQL.Simple.ToRow (ToRow(..))
140141import Database.PostgreSQL.Simple.Types
141142 ( Binary(..), In(..), Only(..), Query(..), (:.)(..) )
142143import Database.PostgreSQL.Simple.Internal as Base
144+import Database.PostgreSQL.Simple.SqlQQ (sql)
143145import qualified Database.PostgreSQL.LibPQ as PQ
144146import qualified Data.ByteString.Char8 as B
145147import qualified Data.Text as T
@@ -549,19 +551,19 @@ finishQuery conn q result = do
549551 PQ.TuplesOk -> do
550552 ncols <- PQ.nfields result
551553 let unCol (PQ.Col x) = fromIntegral x :: Int
552− typenames <- V.generateM (unCol ncols)
554+ typeinfos <- V.generateM (unCol ncols)
553555 (\(PQ.Col . fromIntegral -> col) -> do
554− getTypename conn =<< PQ.ftype result col)
556+ getTypeInfo conn =<< PQ.ftype result col)
555557 nrows <- PQ.ntuples result
556558 ncols <- PQ.nfields result
557559 forM' 0 (nrows-1) $ \row -> do
558− let rw = Row row typenames result
560+ let rw = Row row typeinfos result
559561 case runStateT (runReaderT (unRP fromRow) rw) 0 of
560562 Ok (val,col) | col == ncols -> return val
561563 | otherwise -> do
562564 vals <- forM' 0 (ncols-1) $ \c -> do
563565 v <- PQ.getvalue result row c
564− return ( typenames V.! unCol c
566+ return ( typeinfos V.! unCol c
565567 , fmap ellipsis v )
566568 throw (ConversionFailed
567569 (show (unCol ncols) ++ " values: " ++ show vals)
@@ -963,24 +965,36 @@ fmtError msg q xs = throw FormatError {
963965-- wrong results. In such cases, write a @newtype@ wrapper and a
964966-- custom 'Result' instance to handle your encoding.
965967
966−getTypename :: Connection -> PQ.Oid -> IO ByteString
967−getTypename conn@Connection{..} oid =
968+getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo
969+getTypeInfo conn@Connection{..} oid =
968970 case oid2typname oid of
969− Just name -> return name
971+ Just name -> return $! TypeInfo { typ = NamedOid oid name
972+ , typelem = Nothing
973+ }
970974 Nothing -> modifyMVar connectionObjects $ \oidmap -> do
971975 case IntMap.lookup (oid2int oid) oidmap of
972− Just name -> return (oidmap, name)
976+ Just typeinfo -> return (oidmap, typeinfo)
973977 Nothing -> do
974− names <- query conn "SELECT typname FROM pg_type WHERE oid=?"
975− (Only oid)
976− name <- case names of
977− [] -> return $ throw SqlError {
978− sqlNativeError = -1,
979− sqlErrorMsg = "invalid type oid",
980− sqlState = ""
981− }
982− [Only x] -> return x
983− _ -> fail "typename query returned more than one result"
984− -- oid is a primary key, so the query should
985− -- never return more than one result
986− return (IntMap.insert (oid2int oid) name oidmap, name)
978+ names <- query conn
979+ [sql| SELECT p.oid, p.typname, c.oid, c.typname
980+ FROM pg_type AS p LEFT OUTER JOIN pg_type AS c
981+ ON c.oid = p.typelem
982+ WHERE p.oid = ?
983+ |] (Only oid)
984+ typinf <- case names of
985+ [] -> return $ throw SqlError {
986+ sqlNativeError = -1,
987+ sqlErrorMsg = "invalid type oid",
988+ sqlState = ""
989+ }
990+ [(pOid, pTypName, mbCOid, mbCTypName)] ->
991+ return $! TypeInfo { typ = NamedOid pOid pTypName
992+ , typelem = do
993+ cOid <- mbCOid
994+ cTypName <- mbCTypName
995+ return $ NamedOid cOid cTypName
996+ }
997+ _ -> fail "typename query returned more than one result"
998+ -- oid is a primary key, so the query should
999+ -- never return more than one result
1000+ return (IntMap.insert (oid2int oid) typinf oidmap, typinf)