module Database.PostgreSQL.PQTypes.Model.CompositeType (
CompositeType(..)
, CompositeColumn(..)
, compositeTypePqFormat
, sqlCreateComposite
, sqlDropComposite
, getDBCompositeTypes
) where
import Data.Int
import Data.Monoid.Utils
import Database.PostgreSQL.PQTypes
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as T
import Database.PostgreSQL.PQTypes.Model.ColumnType
import Database.PostgreSQL.PQTypes.SQL.Builder
data CompositeType = CompositeType {
ctName :: !(RawSQL ())
, ctColumns :: ![CompositeColumn]
} deriving (Eq, Ord, Show)
data CompositeColumn = CompositeColumn {
ccName :: !(RawSQL ())
, ccType :: ColumnType
} deriving (Eq, Ord, Show)
compositeTypePqFormat :: CompositeType -> BS.ByteString
compositeTypePqFormat ct = "%" `BS.append` T.encodeUtf8 (unRawSQL $ ctName ct)
sqlCreateComposite :: CompositeType -> RawSQL ()
sqlCreateComposite CompositeType{..} = smconcat [
"CREATE TYPE"
, ctName
, "AS ("
, mintercalate ", " $ map columnToSQL ctColumns
, ")"
]
where
columnToSQL CompositeColumn{..} = ccName <+> columnTypeToSQL ccType
sqlDropComposite :: RawSQL () -> RawSQL ()
sqlDropComposite = ("DROP TYPE" <+>)
getDBCompositeTypes :: forall m. MonadDB m => m [CompositeType]
getDBCompositeTypes = do
runQuery_ . sqlSelect "pg_catalog.pg_class c" $ do
sqlResult "c.relname::text"
sqlResult "c.oid::int4"
sqlWhere "pg_catalog.pg_table_is_visible(c.oid)"
sqlWhereEq "c.relkind" 'c'
sqlOrderBy "c.relname"
mapM getComposite =<< fetchMany id
where
getComposite :: (String, Int32) -> m CompositeType
getComposite (name, oid) = do
runQuery_ . sqlSelect "pg_catalog.pg_attribute a" $ do
sqlResult "a.attname::text"
sqlResult "pg_catalog.format_type(a.atttypid, a.atttypmod)"
sqlWhereEq "a.attrelid" oid
sqlOrderBy "a.attnum"
columns <- fetchMany fetch
return CompositeType { ctName = unsafeSQL name, ctColumns = columns }
where
fetch :: (String, ColumnType) -> CompositeColumn
fetch (cname, ctype) =
CompositeColumn { ccName = unsafeSQL cname, ccType = ctype }