{-# LANGUAGE RecordWildCards #-}
module Database.PostgreSQL.Simple.TypeInfo
( getTypeInfo
, TypeInfo(..)
, Attribute(..)
) where
import qualified Data.ByteString as B
import qualified Data.IntMap as IntMap
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
import Control.Concurrent.MVar
import Control.Exception (throw)
import qualified Database.PostgreSQL.LibPQ as PQ
import {-# SOURCE #-} Database.PostgreSQL.Simple
import Database.PostgreSQL.Simple.Internal
import Database.PostgreSQL.Simple.Types
import Database.PostgreSQL.Simple.TypeInfo.Types
import Database.PostgreSQL.Simple.TypeInfo.Static
getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo
getTypeInfo :: Connection -> Oid -> IO TypeInfo
getTypeInfo conn :: Connection
conn@Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: Connection -> IORef Int64
connectionObjects :: Connection -> MVar TypeInfoCache
connectionHandle :: Connection -> MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
..} Oid
oid' =
case Oid -> Maybe TypeInfo
staticTypeInfo Oid
oid' of
Just TypeInfo
name' -> TypeInfo -> IO TypeInfo
forall (m :: * -> *) a. Monad m => a -> m a
return TypeInfo
name'
Maybe TypeInfo
Nothing -> MVar TypeInfoCache
-> (TypeInfoCache -> IO (TypeInfoCache, TypeInfo)) -> IO TypeInfo
forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar TypeInfoCache
connectionObjects ((TypeInfoCache -> IO (TypeInfoCache, TypeInfo)) -> IO TypeInfo)
-> (TypeInfoCache -> IO (TypeInfoCache, TypeInfo)) -> IO TypeInfo
forall a b. (a -> b) -> a -> b
$ Connection -> Oid -> TypeInfoCache -> IO (TypeInfoCache, TypeInfo)
getTypeInfo' Connection
conn Oid
oid'
getTypeInfo' :: Connection -> PQ.Oid -> TypeInfoCache
-> IO (TypeInfoCache, TypeInfo)
getTypeInfo' :: Connection -> Oid -> TypeInfoCache -> IO (TypeInfoCache, TypeInfo)
getTypeInfo' Connection
conn Oid
oid' TypeInfoCache
oidmap =
case Key -> TypeInfoCache -> Maybe TypeInfo
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup (Oid -> Key
oid2int Oid
oid') TypeInfoCache
oidmap of
Just TypeInfo
typeinfo -> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeInfoCache
oidmap, TypeInfo
typeinfo)
Maybe TypeInfo
Nothing -> do
[(Oid, Char, Char, ByteString, Oid, Oid)]
names <- Connection
-> Query
-> Only Oid
-> IO [(Oid, Char, Char, ByteString, Oid, Oid)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT oid, typcategory, typdelim, typname,\
\ typelem, typrelid\
\ FROM pg_type WHERE oid = ?"
(Oid -> Only Oid
forall a. a -> Only a
Only Oid
oid')
(TypeInfoCache
oidmap', TypeInfo
typeInfo) <-
case [(Oid, Char, Char, ByteString, Oid, Oid)]
names of
[] -> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo))
-> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall a b. (a -> b) -> a -> b
$ SqlError -> (TypeInfoCache, TypeInfo)
forall a e. Exception e => e -> a
throw (ByteString -> SqlError
fatalError ByteString
"invalid type oid")
[(Oid
typoid, Char
typcategory, Char
typdelim, ByteString
typname, Oid
typelem_, Oid
typrelid)] -> do
case Char
typcategory of
Char
'A' -> do
(TypeInfoCache
oidmap', TypeInfo
typelem) <- Connection -> Oid -> TypeInfoCache -> IO (TypeInfoCache, TypeInfo)
getTypeInfo' Connection
conn Oid
typelem_ TypeInfoCache
oidmap
let !typeInfo :: TypeInfo
typeInfo = Array :: Oid -> Char -> Char -> ByteString -> TypeInfo -> TypeInfo
Array{Char
ByteString
Oid
TypeInfo
typelem :: TypeInfo
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
typelem :: TypeInfo
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
..}
(TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo))
-> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall a b. (a -> b) -> a -> b
$! (TypeInfoCache
oidmap', TypeInfo
typeInfo)
Char
'R' -> do
[Only Oid]
rngsubtypeOids <- Connection -> Query -> Only Oid -> IO [Only Oid]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT rngsubtype\
\ FROM pg_range\
\ WHERE rngtypid = ?"
(Oid -> Only Oid
forall a. a -> Only a
Only Oid
oid')
case [Only Oid]
rngsubtypeOids of
[Only Oid
rngsubtype_] -> do
(TypeInfoCache
oidmap', TypeInfo
rngsubtype) <-
Connection -> Oid -> TypeInfoCache -> IO (TypeInfoCache, TypeInfo)
getTypeInfo' Connection
conn Oid
rngsubtype_ TypeInfoCache
oidmap
let !typeInfo :: TypeInfo
typeInfo = Range :: Oid -> Char -> Char -> ByteString -> TypeInfo -> TypeInfo
Range{Char
ByteString
Oid
TypeInfo
rngsubtype :: TypeInfo
rngsubtype :: TypeInfo
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
..}
(TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo))
-> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall a b. (a -> b) -> a -> b
$! (TypeInfoCache
oidmap', TypeInfo
typeInfo)
[Only Oid]
_ -> String -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"range subtype query failed to return exactly one result"
Char
'C' -> do
[(ByteString, Oid)]
cols <- Connection -> Query -> Only Oid -> IO [(ByteString, Oid)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
"SELECT attname, atttypid\
\ FROM pg_attribute\
\ WHERE attrelid = ?\
\ AND attnum > 0\
\ AND NOT attisdropped\
\ ORDER BY attnum"
(Oid -> Only Oid
forall a. a -> Only a
Only Oid
typrelid)
IOVector Attribute
vec <- Key -> IO (IOVector Attribute)
forall (m :: * -> *) a.
PrimMonad m =>
Key -> m (MVector (PrimState m) a)
MV.new (Key -> IO (IOVector Attribute)) -> Key -> IO (IOVector Attribute)
forall a b. (a -> b) -> a -> b
$! [(ByteString, Oid)] -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length [(ByteString, Oid)]
cols
(TypeInfoCache
oidmap', Vector Attribute
attributes) <- Connection
-> [(ByteString, Oid)]
-> TypeInfoCache
-> IOVector Attribute
-> Key
-> IO (TypeInfoCache, Vector Attribute)
getAttInfos Connection
conn [(ByteString, Oid)]
cols TypeInfoCache
oidmap IOVector Attribute
vec Key
0
let !typeInfo :: TypeInfo
typeInfo = Composite :: Oid
-> Char
-> Char
-> ByteString
-> Oid
-> Vector Attribute
-> TypeInfo
Composite{Char
ByteString
Oid
Vector Attribute
attributes :: Vector Attribute
typrelid :: Oid
attributes :: Vector Attribute
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
typrelid :: Oid
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
..}
(TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo))
-> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall a b. (a -> b) -> a -> b
$! (TypeInfoCache
oidmap', TypeInfo
typeInfo)
Char
_ -> do
let !typeInfo :: TypeInfo
typeInfo = Basic :: Oid -> Char -> Char -> ByteString -> TypeInfo
Basic{Char
ByteString
Oid
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
typname :: ByteString
typdelim :: Char
typcategory :: Char
typoid :: Oid
..}
(TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo))
-> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall a b. (a -> b) -> a -> b
$! (TypeInfoCache
oidmap, TypeInfo
typeInfo)
[(Oid, Char, Char, ByteString, Oid, Oid)]
_ -> String -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"typename query returned more than one result"
let !oidmap'' :: TypeInfoCache
oidmap'' = Key -> TypeInfo -> TypeInfoCache -> TypeInfoCache
forall a. Key -> a -> IntMap a -> IntMap a
IntMap.insert (Oid -> Key
oid2int Oid
oid') TypeInfo
typeInfo TypeInfoCache
oidmap'
(TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo))
-> (TypeInfoCache, TypeInfo) -> IO (TypeInfoCache, TypeInfo)
forall a b. (a -> b) -> a -> b
$! (TypeInfoCache
oidmap'', TypeInfo
typeInfo)
getAttInfos :: Connection -> [(B.ByteString, PQ.Oid)] -> TypeInfoCache
-> MV.IOVector Attribute -> Int
-> IO (TypeInfoCache, V.Vector Attribute)
getAttInfos :: Connection
-> [(ByteString, Oid)]
-> TypeInfoCache
-> IOVector Attribute
-> Key
-> IO (TypeInfoCache, Vector Attribute)
getAttInfos Connection
conn [(ByteString, Oid)]
cols TypeInfoCache
oidmap IOVector Attribute
vec Key
n =
case [(ByteString, Oid)]
cols of
[] -> do
!Vector Attribute
attributes <- MVector (PrimState IO) Attribute -> IO (Vector Attribute)
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> m (Vector a)
V.unsafeFreeze IOVector Attribute
MVector (PrimState IO) Attribute
vec
(TypeInfoCache, Vector Attribute)
-> IO (TypeInfoCache, Vector Attribute)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TypeInfoCache, Vector Attribute)
-> IO (TypeInfoCache, Vector Attribute))
-> (TypeInfoCache, Vector Attribute)
-> IO (TypeInfoCache, Vector Attribute)
forall a b. (a -> b) -> a -> b
$! (TypeInfoCache
oidmap, Vector Attribute
attributes)
((ByteString
attname, Oid
attTypeOid):[(ByteString, Oid)]
xs) -> do
(TypeInfoCache
oidmap', TypeInfo
atttype) <- Connection -> Oid -> TypeInfoCache -> IO (TypeInfoCache, TypeInfo)
getTypeInfo' Connection
conn Oid
attTypeOid TypeInfoCache
oidmap
MVector (PrimState IO) Attribute -> Key -> Attribute -> IO ()
forall (m :: * -> *) a.
PrimMonad m =>
MVector (PrimState m) a -> Key -> a -> m ()
MV.write IOVector Attribute
MVector (PrimState IO) Attribute
vec Key
n (Attribute -> IO ()) -> Attribute -> IO ()
forall a b. (a -> b) -> a -> b
$! Attribute :: ByteString -> TypeInfo -> Attribute
Attribute{ByteString
TypeInfo
atttype :: TypeInfo
attname :: ByteString
atttype :: TypeInfo
attname :: ByteString
..}
Connection
-> [(ByteString, Oid)]
-> TypeInfoCache
-> IOVector Attribute
-> Key
-> IO (TypeInfoCache, Vector Attribute)
getAttInfos Connection
conn [(ByteString, Oid)]
xs TypeInfoCache
oidmap' IOVector Attribute
vec (Key
nKey -> Key -> Key
forall a. Num a => a -> a -> a
+Key
1)