module Database.PostgreSQL.PQTypes.Migrate (
  createDomain,
  createTable,
  createTableConstraints
  ) where

import Control.Monad
import qualified Data.Foldable as F

import Database.PostgreSQL.PQTypes
import Database.PostgreSQL.PQTypes.Checks.Util
import Database.PostgreSQL.PQTypes.Model
import Database.PostgreSQL.PQTypes.SQL.Builder

createDomain :: MonadDB m => Domain -> m ()
createDomain :: Domain -> m ()
createDomain dom :: Domain
dom@Domain{Bool
Maybe (RawSQL ())
Set Check
RawSQL ()
ColumnType
domChecks :: Domain -> Set Check
domDefault :: Domain -> Maybe (RawSQL ())
domNullable :: Domain -> Bool
domType :: Domain -> ColumnType
domName :: Domain -> RawSQL ()
domChecks :: Set Check
domDefault :: Maybe (RawSQL ())
domNullable :: Bool
domType :: ColumnType
domName :: RawSQL ()
..} = do
  -- create the domain
  RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ Domain -> RawSQL ()
sqlCreateDomain Domain
dom
  -- add constraint checks to the domain
  Set Check -> (Check -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
F.forM_ Set Check
domChecks ((Check -> m ()) -> m ()) -> (Check -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> (Check -> RawSQL ()) -> Check -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSQL () -> RawSQL () -> RawSQL ()
sqlAlterDomain RawSQL ()
domName (RawSQL () -> RawSQL ())
-> (Check -> RawSQL ()) -> Check -> RawSQL ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Check -> RawSQL ()
sqlAddValidCheckMaybeDowntime

createTable :: MonadDB m => Bool -> Table -> m ()
createTable :: Bool -> Table -> m ()
createTable Bool
withConstraints table :: Table
table@Table{Int32
[Check]
[ForeignKey]
[TableIndex]
[TableColumn]
Maybe PrimaryKey
Maybe TableInitialSetup
RawSQL ()
tblInitialSetup :: Table -> Maybe TableInitialSetup
tblIndexes :: Table -> [TableIndex]
tblForeignKeys :: Table -> [ForeignKey]
tblChecks :: Table -> [Check]
tblPrimaryKey :: Table -> Maybe PrimaryKey
tblColumns :: Table -> [TableColumn]
tblVersion :: Table -> Int32
tblName :: Table -> RawSQL ()
tblInitialSetup :: Maybe TableInitialSetup
tblIndexes :: [TableIndex]
tblForeignKeys :: [ForeignKey]
tblChecks :: [Check]
tblPrimaryKey :: Maybe PrimaryKey
tblColumns :: [TableColumn]
tblVersion :: Int32
tblName :: RawSQL ()
..} = do
  -- Create empty table and add the columns.
  RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ RawSQL () -> RawSQL ()
sqlCreateTable RawSQL ()
tblName
  RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ RawSQL () -> [RawSQL ()] -> RawSQL ()
sqlAlterTable RawSQL ()
tblName ([RawSQL ()] -> RawSQL ()) -> [RawSQL ()] -> RawSQL ()
forall a b. (a -> b) -> a -> b
$ (TableColumn -> RawSQL ()) -> [TableColumn] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map TableColumn -> RawSQL ()
sqlAddColumn [TableColumn]
tblColumns
  -- Add indexes.
  [TableIndex] -> (TableIndex -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TableIndex]
tblIndexes ((TableIndex -> m ()) -> m ()) -> (TableIndex -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ())
-> (TableIndex -> RawSQL ()) -> TableIndex -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawSQL () -> TableIndex -> RawSQL ()
sqlCreateIndexMaybeDowntime RawSQL ()
tblName
  -- Add all the other constraints if applicable.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
withConstraints (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Table -> m ()
forall (m :: * -> *). MonadDB m => Table -> m ()
createTableConstraints Table
table
  -- Register the table along with its version.
  SqlInsert -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (SqlInsert -> m ())
-> (State SqlInsert () -> SqlInsert) -> State SqlInsert () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SQL -> State SqlInsert () -> SqlInsert
sqlInsert SQL
"table_versions" (State SqlInsert () -> m ()) -> State SqlInsert () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    SQL -> Text -> State SqlInsert ()
forall v (m :: * -> *) a.
(MonadState v m, SqlSet v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlSet SQL
"name" (Table -> Text
tblNameText Table
table)
    SQL -> Int32 -> State SqlInsert ()
forall v (m :: * -> *) a.
(MonadState v m, SqlSet v, Show a, ToSQL a) =>
SQL -> a -> m ()
sqlSet SQL
"version" Int32
tblVersion

createTableConstraints :: MonadDB m => Table -> m ()
createTableConstraints :: Table -> m ()
createTableConstraints Table{Int32
[Check]
[ForeignKey]
[TableIndex]
[TableColumn]
Maybe PrimaryKey
Maybe TableInitialSetup
RawSQL ()
tblInitialSetup :: Maybe TableInitialSetup
tblIndexes :: [TableIndex]
tblForeignKeys :: [ForeignKey]
tblChecks :: [Check]
tblPrimaryKey :: Maybe PrimaryKey
tblColumns :: [TableColumn]
tblVersion :: Int32
tblName :: RawSQL ()
tblInitialSetup :: Table -> Maybe TableInitialSetup
tblIndexes :: Table -> [TableIndex]
tblForeignKeys :: Table -> [ForeignKey]
tblChecks :: Table -> [Check]
tblPrimaryKey :: Table -> Maybe PrimaryKey
tblColumns :: Table -> [TableColumn]
tblVersion :: Table -> Int32
tblName :: Table -> RawSQL ()
..} = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [RawSQL ()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RawSQL ()]
addConstraints) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  RawSQL () -> m ()
forall sql (m :: * -> *). (IsSQL sql, MonadDB m) => sql -> m ()
runQuery_ (RawSQL () -> m ()) -> RawSQL () -> m ()
forall a b. (a -> b) -> a -> b
$ RawSQL () -> [RawSQL ()] -> RawSQL ()
sqlAlterTable RawSQL ()
tblName [RawSQL ()]
addConstraints
  where
    addConstraints :: [RawSQL ()]
addConstraints = [[RawSQL ()]] -> [RawSQL ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
        [RawSQL () -> PrimaryKey -> RawSQL ()
sqlAddPK RawSQL ()
tblName PrimaryKey
pk | Just PrimaryKey
pk <- Maybe PrimaryKey -> [Maybe PrimaryKey]
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe PrimaryKey
tblPrimaryKey]
      , (Check -> RawSQL ()) -> [Check] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map Check -> RawSQL ()
sqlAddValidCheckMaybeDowntime [Check]
tblChecks
      , (ForeignKey -> RawSQL ()) -> [ForeignKey] -> [RawSQL ()]
forall a b. (a -> b) -> [a] -> [b]
map (RawSQL () -> ForeignKey -> RawSQL ()
sqlAddValidFKMaybeDowntime RawSQL ()
tblName) [ForeignKey]
tblForeignKeys
      ]