module Database.PostgreSQL.PQTypes.Model.Table (
TableColumn(..)
, tblColumn
, sqlAddColumn
, sqlAlterColumn
, sqlDropColumn
, Rows(..)
, Table(..)
, tblTable
, sqlCreateTable
, sqlAlterTable
, DropTableMode(..)
, sqlDropTable
, TableInitialSetup(..)
) where
import Control.Monad.Catch
import Data.ByteString (ByteString)
import Data.Int
import Data.Monoid.Utils
import Database.PostgreSQL.PQTypes
import Database.PostgreSQL.PQTypes.Model.Check
import Database.PostgreSQL.PQTypes.Model.ColumnType
import Database.PostgreSQL.PQTypes.Model.ForeignKey
import Database.PostgreSQL.PQTypes.Model.Index
import Database.PostgreSQL.PQTypes.Model.PrimaryKey
import Database.PostgreSQL.PQTypes.Model.Trigger
data TableColumn = TableColumn {
TableColumn -> RawSQL ()
colName :: RawSQL ()
, TableColumn -> ColumnType
colType :: ColumnType
, TableColumn -> Maybe (RawSQL ())
colCollation :: Maybe (RawSQL ())
, TableColumn -> Bool
colNullable :: Bool
, TableColumn -> Maybe (RawSQL ())
colDefault :: Maybe (RawSQL ())
} deriving Int -> TableColumn -> ShowS
[TableColumn] -> ShowS
TableColumn -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableColumn] -> ShowS
$cshowList :: [TableColumn] -> ShowS
show :: TableColumn -> String
$cshow :: TableColumn -> String
showsPrec :: Int -> TableColumn -> ShowS
$cshowsPrec :: Int -> TableColumn -> ShowS
Show
tblColumn :: TableColumn
tblColumn :: TableColumn
tblColumn = TableColumn {
colName :: RawSQL ()
colName = forall a. HasCallStack => String -> a
error String
"tblColumn: column name must be specified"
, colType :: ColumnType
colType = forall a. HasCallStack => String -> a
error String
"tblColumn: column type must be specified"
, colCollation :: Maybe (RawSQL ())
colCollation = forall a. Maybe a
Nothing
, colNullable :: Bool
colNullable = Bool
True
, colDefault :: Maybe (RawSQL ())
colDefault = forall a. Maybe a
Nothing
}
sqlAddColumn :: TableColumn -> RawSQL ()
sqlAddColumn :: TableColumn -> RawSQL ()
sqlAddColumn TableColumn{Bool
Maybe (RawSQL ())
RawSQL ()
ColumnType
colDefault :: Maybe (RawSQL ())
colNullable :: Bool
colCollation :: Maybe (RawSQL ())
colType :: ColumnType
colName :: RawSQL ()
colDefault :: TableColumn -> Maybe (RawSQL ())
colNullable :: TableColumn -> Bool
colCollation :: TableColumn -> Maybe (RawSQL ())
colType :: TableColumn -> ColumnType
colName :: TableColumn -> RawSQL ()
..} = forall m. (IsString m, Monoid m) => [m] -> m
smconcat [
RawSQL ()
"ADD COLUMN"
, RawSQL ()
colName
, ColumnType -> RawSQL ()
columnTypeToSQL ColumnType
colType
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSQL ()
"" (\RawSQL ()
c -> RawSQL ()
"COLLATE \"" forall a. Semigroup a => a -> a -> a
<> RawSQL ()
c forall a. Semigroup a => a -> a -> a
<> RawSQL ()
"\"") Maybe (RawSQL ())
colCollation
, if Bool
colNullable then RawSQL ()
"NULL" else RawSQL ()
"NOT NULL"
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe RawSQL ()
"" (RawSQL ()
"DEFAULT" forall m. (IsString m, Monoid m) => m -> m -> m
<+>) Maybe (RawSQL ())
colDefault
]
sqlAlterColumn :: RawSQL () -> RawSQL () -> RawSQL ()
sqlAlterColumn :: RawSQL () -> RawSQL () -> RawSQL ()
sqlAlterColumn RawSQL ()
cname RawSQL ()
alter = RawSQL ()
"ALTER COLUMN" forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
cname forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
alter
sqlDropColumn :: RawSQL () -> RawSQL ()
sqlDropColumn :: RawSQL () -> RawSQL ()
sqlDropColumn RawSQL ()
cname = RawSQL ()
"DROP COLUMN" forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
cname
data Rows = forall row. (Show row, ToRow row) => Rows [ByteString] [row]
data Table =
Table {
Table -> RawSQL ()
tblName :: RawSQL ()
, Table -> Int32
tblVersion :: Int32
, Table -> [TableColumn]
tblColumns :: [TableColumn]
, Table -> Maybe PrimaryKey
tblPrimaryKey :: Maybe PrimaryKey
, Table -> [Check]
tblChecks :: [Check]
, Table -> [ForeignKey]
tblForeignKeys :: [ForeignKey]
, Table -> [TableIndex]
tblIndexes :: [TableIndex]
, Table -> [Trigger]
tblTriggers :: [Trigger]
, Table -> Maybe TableInitialSetup
tblInitialSetup :: Maybe TableInitialSetup
}
data TableInitialSetup = TableInitialSetup {
TableInitialSetup
-> forall (m :: * -> *). (MonadDB m, MonadThrow m) => m Bool
checkInitialSetup :: forall m. (MonadDB m, MonadThrow m) => m Bool
, TableInitialSetup
-> forall (m :: * -> *). (MonadDB m, MonadThrow m) => m ()
initialSetup :: forall m. (MonadDB m, MonadThrow m) => m ()
}
tblTable :: Table
tblTable :: Table
tblTable = Table {
tblName :: RawSQL ()
tblName = forall a. HasCallStack => String -> a
error String
"tblTable: table name must be specified"
, tblVersion :: Int32
tblVersion = forall a. HasCallStack => String -> a
error String
"tblTable: table version must be specified"
, tblColumns :: [TableColumn]
tblColumns = forall a. HasCallStack => String -> a
error String
"tblTable: table columns must be specified"
, tblPrimaryKey :: Maybe PrimaryKey
tblPrimaryKey = forall a. Maybe a
Nothing
, tblChecks :: [Check]
tblChecks = []
, tblForeignKeys :: [ForeignKey]
tblForeignKeys = []
, tblIndexes :: [TableIndex]
tblIndexes = []
, tblTriggers :: [Trigger]
tblTriggers = []
, tblInitialSetup :: Maybe TableInitialSetup
tblInitialSetup = forall a. Maybe a
Nothing
}
sqlCreateTable :: RawSQL () -> RawSQL ()
sqlCreateTable :: RawSQL () -> RawSQL ()
sqlCreateTable RawSQL ()
tname = RawSQL ()
"CREATE TABLE" forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
tname forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
"()"
data DropTableMode =
DropTableCascade |
DropTableRestrict
sqlDropTable :: RawSQL () -> DropTableMode -> RawSQL ()
sqlDropTable :: RawSQL () -> DropTableMode -> RawSQL ()
sqlDropTable RawSQL ()
tname DropTableMode
mode = RawSQL ()
"DROP TABLE" forall m. (IsString m, Monoid m) => m -> m -> m
<+> RawSQL ()
tname
forall m. (IsString m, Monoid m) => m -> m -> m
<+> case DropTableMode
mode of
DropTableMode
DropTableCascade -> RawSQL ()
"CASCADE"
DropTableMode
DropTableRestrict -> RawSQL ()
"RESTRICT"
sqlAlterTable :: RawSQL () -> [RawSQL ()] -> RawSQL ()
sqlAlterTable :: RawSQL () -> [RawSQL ()] -> RawSQL ()
sqlAlterTable RawSQL ()
tname [RawSQL ()]
alter_statements = forall m. (IsString m, Monoid m) => [m] -> m
smconcat [
RawSQL ()
"ALTER TABLE"
, RawSQL ()
tname
, forall m. Monoid m => m -> [m] -> m
mintercalate RawSQL ()
", " [RawSQL ()]
alter_statements
]