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 {
  CompositeType -> RawSQL ()
ctName    :: !(RawSQL ())
, CompositeType -> [CompositeColumn]
ctColumns :: ![CompositeColumn]
} deriving (CompositeType -> CompositeType -> Bool
(CompositeType -> CompositeType -> Bool)
-> (CompositeType -> CompositeType -> Bool) -> Eq CompositeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeType -> CompositeType -> Bool
$c/= :: CompositeType -> CompositeType -> Bool
== :: CompositeType -> CompositeType -> Bool
$c== :: CompositeType -> CompositeType -> Bool
Eq, Eq CompositeType
Eq CompositeType
-> (CompositeType -> CompositeType -> Ordering)
-> (CompositeType -> CompositeType -> Bool)
-> (CompositeType -> CompositeType -> Bool)
-> (CompositeType -> CompositeType -> Bool)
-> (CompositeType -> CompositeType -> Bool)
-> (CompositeType -> CompositeType -> CompositeType)
-> (CompositeType -> CompositeType -> CompositeType)
-> Ord CompositeType
CompositeType -> CompositeType -> Bool
CompositeType -> CompositeType -> Ordering
CompositeType -> CompositeType -> CompositeType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompositeType -> CompositeType -> CompositeType
$cmin :: CompositeType -> CompositeType -> CompositeType
max :: CompositeType -> CompositeType -> CompositeType
$cmax :: CompositeType -> CompositeType -> CompositeType
>= :: CompositeType -> CompositeType -> Bool
$c>= :: CompositeType -> CompositeType -> Bool
> :: CompositeType -> CompositeType -> Bool
$c> :: CompositeType -> CompositeType -> Bool
<= :: CompositeType -> CompositeType -> Bool
$c<= :: CompositeType -> CompositeType -> Bool
< :: CompositeType -> CompositeType -> Bool
$c< :: CompositeType -> CompositeType -> Bool
compare :: CompositeType -> CompositeType -> Ordering
$ccompare :: CompositeType -> CompositeType -> Ordering
$cp1Ord :: Eq CompositeType
Ord, Int -> CompositeType -> ShowS
[CompositeType] -> ShowS
CompositeType -> String
(Int -> CompositeType -> ShowS)
-> (CompositeType -> String)
-> ([CompositeType] -> ShowS)
-> Show CompositeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompositeType] -> ShowS
$cshowList :: [CompositeType] -> ShowS
show :: CompositeType -> String
$cshow :: CompositeType -> String
showsPrec :: Int -> CompositeType -> ShowS
$cshowsPrec :: Int -> CompositeType -> ShowS
Show)

data CompositeColumn = CompositeColumn {
  CompositeColumn -> RawSQL ()
ccName :: !(RawSQL ())
, CompositeColumn -> ColumnType
ccType :: ColumnType
} deriving (CompositeColumn -> CompositeColumn -> Bool
(CompositeColumn -> CompositeColumn -> Bool)
-> (CompositeColumn -> CompositeColumn -> Bool)
-> Eq CompositeColumn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeColumn -> CompositeColumn -> Bool
$c/= :: CompositeColumn -> CompositeColumn -> Bool
== :: CompositeColumn -> CompositeColumn -> Bool
$c== :: CompositeColumn -> CompositeColumn -> Bool
Eq, Eq CompositeColumn
Eq CompositeColumn
-> (CompositeColumn -> CompositeColumn -> Ordering)
-> (CompositeColumn -> CompositeColumn -> Bool)
-> (CompositeColumn -> CompositeColumn -> Bool)
-> (CompositeColumn -> CompositeColumn -> Bool)
-> (CompositeColumn -> CompositeColumn -> Bool)
-> (CompositeColumn -> CompositeColumn -> CompositeColumn)
-> (CompositeColumn -> CompositeColumn -> CompositeColumn)
-> Ord CompositeColumn
CompositeColumn -> CompositeColumn -> Bool
CompositeColumn -> CompositeColumn -> Ordering
CompositeColumn -> CompositeColumn -> CompositeColumn
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompositeColumn -> CompositeColumn -> CompositeColumn
$cmin :: CompositeColumn -> CompositeColumn -> CompositeColumn
max :: CompositeColumn -> CompositeColumn -> CompositeColumn
$cmax :: CompositeColumn -> CompositeColumn -> CompositeColumn
>= :: CompositeColumn -> CompositeColumn -> Bool
$c>= :: CompositeColumn -> CompositeColumn -> Bool
> :: CompositeColumn -> CompositeColumn -> Bool
$c> :: CompositeColumn -> CompositeColumn -> Bool
<= :: CompositeColumn -> CompositeColumn -> Bool
$c<= :: CompositeColumn -> CompositeColumn -> Bool
< :: CompositeColumn -> CompositeColumn -> Bool
$c< :: CompositeColumn -> CompositeColumn -> Bool
compare :: CompositeColumn -> CompositeColumn -> Ordering
$ccompare :: CompositeColumn -> CompositeColumn -> Ordering
$cp1Ord :: Eq CompositeColumn
Ord, Int -> CompositeColumn -> ShowS
[CompositeColumn] -> ShowS
CompositeColumn -> String
(Int -> CompositeColumn -> ShowS)
-> (CompositeColumn -> String)
-> ([CompositeColumn] -> ShowS)
-> Show CompositeColumn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompositeColumn] -> ShowS
$cshowList :: [CompositeColumn] -> ShowS
show :: CompositeColumn -> String
$cshow :: CompositeColumn -> String
showsPrec :: Int -> CompositeColumn -> ShowS
$cshowsPrec :: Int -> CompositeColumn -> ShowS
Show)

-- | Convenience function for converting CompositeType definition to
-- corresponding 'pqFormat' definition.
compositeTypePqFormat :: CompositeType -> BS.ByteString
compositeTypePqFormat :: CompositeType -> ByteString
compositeTypePqFormat CompositeType
ct = ByteString
"%" ByteString -> ByteString -> ByteString
`BS.append` Text -> ByteString
T.encodeUtf8 (RawSQL () -> Text
unRawSQL (RawSQL () -> Text) -> RawSQL () -> Text
forall a b. (a -> b) -> a -> b
$ CompositeType -> RawSQL ()
ctName CompositeType
ct)

-- | Make SQL query that creates a composite type.
sqlCreateComposite :: CompositeType -> RawSQL ()
sqlCreateComposite :: CompositeType -> RawSQL ()
sqlCreateComposite CompositeType{[CompositeColumn]
RawSQL ()
ctColumns :: [CompositeColumn]
ctName :: RawSQL ()
ctColumns :: CompositeType -> [CompositeColumn]
ctName :: CompositeType -> RawSQL ()
..} = [RawSQL ()] -> RawSQL ()
forall m. (IsString m, Monoid m) => [m] -> m
smconcat [
    RawSQL ()
"CREATE TYPE"
  , RawSQL ()
ctName
  , RawSQL ()
"AS ("
  , RawSQL () -> [RawSQL ()] -> RawSQL ()
forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
", " ([RawSQL ()] -> RawSQL ()) -> [RawSQL ()] -> RawSQL ()
forall a b. (a -> b) -> a -> b
$ (CompositeColumn -> RawSQL ()) -> [CompositeColumn] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map CompositeColumn -> RawSQL ()
columnToSQL [CompositeColumn]
ctColumns
  , RawSQL ()
")"
  ]
  where
    columnToSQL :: CompositeColumn -> RawSQL ()
columnToSQL CompositeColumn{RawSQL ()
ColumnType
ccType :: ColumnType
ccName :: RawSQL ()
ccType :: CompositeColumn -> ColumnType
ccName :: CompositeColumn -> RawSQL ()
..} = RawSQL ()
ccName RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+> ColumnType -> RawSQL ()
columnTypeToSQL ColumnType
ccType

-- | Make SQL query that drops a composite type.
sqlDropComposite :: RawSQL () -> RawSQL ()
sqlDropComposite :: RawSQL () -> RawSQL ()
sqlDropComposite = (RawSQL ()
"DROP TYPE" RawSQL () -> RawSQL () -> RawSQL ()
forall m. (IsString m, Monoid m) => m -> m -> m
<+>)

----------------------------------------

-- | Get composite types defined in the database.
getDBCompositeTypes :: forall m. MonadDB m => m [CompositeType]
getDBCompositeTypes :: m [CompositeType]
getDBCompositeTypes = do
  SqlSelect -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (SqlSelect -> m ())
-> (State SqlSelect () -> SqlSelect) -> State SqlSelect () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> State SqlSelect () -> SqlSelect
sqlSelect SQL
"pg_catalog.pg_class c" (State SqlSelect () -> m ()) -> State SqlSelect () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"c.relname::text"
    SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"c.oid::int4"
    SQL -> State SqlSelect ()
forall v (m :: * -> *). (MonadState v m, SqlWhere v) => SQL -> m ()
sqlWhere SQL
"pg_catalog.pg_table_is_visible(c.oid)"
    SQL -> Char -> State SqlSelect ()
forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlWhereEq SQL
"c.relkind" Char
'c'
    SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlOrderBy v) =>
SQL -> m ()
sqlOrderBy SQL
"c.relname"
  ((String, Int32) -> m CompositeType)
-> [(String, Int32)] -> m [CompositeType]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, Int32) -> m CompositeType
getComposite ([(String, Int32)] -> m [CompositeType])
-> m [(String, Int32)] -> m [CompositeType]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ((String, Int32) -> (String, Int32)) -> m [(String, Int32)]
forall (m :: * -> *) row t.
(MonadDB m, FromRow row) =>
(row -> t) -> m [t]
fetchMany (String, Int32) -> (String, Int32)
forall a. a -> a
id
  where
    getComposite :: (String, Int32) -> m CompositeType
    getComposite :: (String, Int32) -> m CompositeType
getComposite (String
name, Int32
oid) = do
      SqlSelect -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (SqlSelect -> m ())
-> (State SqlSelect () -> SqlSelect) -> State SqlSelect () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> State SqlSelect () -> SqlSelect
sqlSelect SQL
"pg_catalog.pg_attribute a" (State SqlSelect () -> m ()) -> State SqlSelect () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"a.attname::text"
        SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlResult v) =>
SQL -> m ()
sqlResult SQL
"pg_catalog.format_type(a.atttypid, a.atttypmod)"
        SQL -> Int32 -> State SqlSelect ()
forall v (m :: * -> *) a.
(MonadState v m, SqlWhere v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlWhereEq SQL
"a.attrelid" Int32
oid
        SQL -> State SqlSelect ()
forall v (m :: * -> *).
(MonadState v m, SqlOrderBy v) =>
SQL -> m ()
sqlOrderBy SQL
"a.attnum"
      [CompositeColumn]
columns <- ((String, ColumnType) -> CompositeColumn) -> m [CompositeColumn]
forall (m :: * -> *) row t.
(MonadDB m, FromRow row) =>
(row -> t) -> m [t]
fetchMany (String, ColumnType) -> CompositeColumn
fetch
      CompositeType -> m CompositeType
forall (m :: * -> *) a. Monad m => a -> m a
return CompositeType :: RawSQL () -> [CompositeColumn] -> CompositeType
CompositeType { ctName :: RawSQL ()
ctName = String -> RawSQL ()
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL String
name, ctColumns :: [CompositeColumn]
ctColumns = [CompositeColumn]
columns }
      where
        fetch :: (String, ColumnType) -> CompositeColumn
        fetch :: (String, ColumnType) -> CompositeColumn
fetch (String
cname, ColumnType
ctype) =
          CompositeColumn :: RawSQL () -> ColumnType -> CompositeColumn
CompositeColumn { ccName :: RawSQL ()
ccName = String -> RawSQL ()
forall sql. (IsSQL sql, IsString sql) => String -> sql
unsafeSQL String
cname, ccType :: ColumnType
ccType = ColumnType
ctype }