{-# LANGUAGE OverloadedStrings #-}
module Database.PostgreSQL.Typed.TypeCache
( PGTypes
, pgGetTypes
, PGTypeConnection
, pgConnection
, newPGTypeConnection
, flushPGTypeConnection
, lookupPGType
, findPGType
) where
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Data.IntMap as IntMap
import Data.List (find)
import Database.PostgreSQL.Typed.Types (PGName, OID)
import Database.PostgreSQL.Typed.Dynamic
import Database.PostgreSQL.Typed.Protocol
type PGTypes = IntMap.IntMap PGName
data PGTypeConnection = PGTypeConnection
{ pgConnection :: !PGConnection
, pgTypes :: IORef (Maybe PGTypes)
}
newPGTypeConnection :: PGConnection -> IO PGTypeConnection
newPGTypeConnection c = do
t <- newIORef Nothing
return $ PGTypeConnection c t
flushPGTypeConnection :: PGTypeConnection -> IO ()
flushPGTypeConnection c =
writeIORef (pgTypes c) Nothing
pgGetTypes :: PGConnection -> IO PGTypes
pgGetTypes c =
IntMap.fromAscList . map (\[to, tn] -> (fromIntegral (pgDecodeRep to :: OID), pgDecodeRep tn)) .
snd <$> pgSimpleQuery c "SELECT oid, format_type(CASE WHEN typtype = 'd' THEN typbasetype ELSE oid END, -1) FROM pg_catalog.pg_type ORDER BY oid"
getPGTypes :: PGTypeConnection -> IO PGTypes
getPGTypes (PGTypeConnection c tr) =
maybe (do
t <- pgGetTypes c
writeIORef tr $ Just t
return t)
return
=<< readIORef tr
lookupPGType :: PGTypeConnection -> OID -> IO (Maybe PGName)
lookupPGType c o =
IntMap.lookup (fromIntegral o) <$> getPGTypes c
findPGType :: PGTypeConnection -> PGName -> IO (Maybe OID)
findPGType c t =
fmap (fromIntegral . fst) . find ((==) t . snd) . IntMap.toList <$> getPGTypes c