module Sqel.Migration.Table where

import qualified Data.Map as Map

import Sqel.Data.Dd (Dd, DdType)
import qualified Sqel.Data.Migration as Migration
import Sqel.Data.Migration (Mig (Mig), Migration (Migration), MigrationActions (AutoActions))
import Sqel.Migration.Ddl (DdlTypes, ddTable)
import Sqel.Migration.Type (TableChange (tableChange), TypeChanges (typeChanges))
import Sqel.PgType (pgTable)
import Sqel.ReifyDd (ReifyDd)

class TableChanges old new where
  tableChanges :: Dd old -> Dd new -> MigrationActions ext

instance (
    DdlTypes 'True old (oldTable : oldTypes),
    DdlTypes 'True new (newTable : newTypes),
    TypeChanges oldTypes newTypes,
    TableChange oldTable newTable
  ) => TableChanges old new where
    tableChanges :: forall ext. Dd old -> Dd new -> MigrationActions ext
tableChanges Dd old
old Dd new
new =
      AutoActions {
        $sel:table:AutoActions :: TableAction
table = forall (old :: DdlTypeK) (new :: DdlTypeK).
TableChange old new =>
DdlType old -> DdlType new -> TableAction
tableChange DdlType oldTable
oldTable DdlType newTable
newTable,
        $sel:types:AutoActions :: Map PgCompName CompAction
types = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (old :: [DdlTypeK]) (new :: [DdlTypeK]).
TypeChanges old new =>
NP DdlType old -> NP DdlType new -> [(PgCompName, CompAction)]
typeChanges NP DdlType oldTypes
oldTypes NP DdlType newTypes
newTypes)
      }
      where
        (DdlType oldTable
oldTable, NP DdlType oldTypes
oldTypes) = forall (s :: DdK) (table :: DdlTypeK) (types :: [DdlTypeK]).
DdlTypes 'True s (table : types) =>
Dd s -> (DdlType table, NP DdlType types)
ddTable Dd old
old
        (DdlType newTable
newTable, NP DdlType newTypes
newTypes) = forall (s :: DdK) (table :: DdlTypeK) (types :: [DdlTypeK]).
DdlTypes 'True s (table : types) =>
Dd s -> (DdlType table, NP DdlType types)
ddTable Dd new
new

class MigrationTables m old new where
  withMigrationTables ::
    MigrationActions ext ->
    Dd old ->
    Dd new ->
    Migration ('Mig (DdType old) (DdType new) m ext)

instance (
    ReifyDd old,
    ReifyDd new
  ) => MigrationTables m old new where
    withMigrationTables :: forall ext.
MigrationActions ext
-> Dd old
-> Dd new
-> Migration ('Mig (DdType old) (DdType new) m ext)
withMigrationTables MigrationActions ext
actions Dd old
old Dd new
new =
      forall from to ext (m :: * -> *).
PgTable from
-> PgTable to
-> MigrationActions ext
-> Migration ('Mig from to m ext)
Migration (forall (s :: DdK). ReifyDd s => Dd s -> PgTable (DdType s)
pgTable Dd old
old) (forall (s :: DdK). ReifyDd s => Dd s -> PgTable (DdType s)
pgTable Dd new
new) MigrationActions ext
actions

class AutoMigration old new where
  autoMigration :: Dd old -> Dd new -> Migration ('Mig (DdType old) (DdType new) m Void)

instance (
    TableChanges old new,
    ReifyDd old,
    ReifyDd new
  ) => AutoMigration old new where
    autoMigration :: forall (m :: * -> *).
Dd old
-> Dd new -> Migration ('Mig (DdType old) (DdType new) m Void)
autoMigration Dd old
old Dd new
new =
      forall (m :: * -> *) (old :: DdK) (new :: DdK) ext.
MigrationTables m old new =>
MigrationActions ext
-> Dd old
-> Dd new
-> Migration ('Mig (DdType old) (DdType new) m ext)
withMigrationTables (forall (old :: DdK) (new :: DdK) ext.
TableChanges old new =>
Dd old -> Dd new -> MigrationActions ext
tableChanges Dd old
old Dd new
new) Dd old
old Dd new
new

migrateAuto ::
  AutoMigration old new =>
  Dd old ->
  Dd new ->
  Migration ('Mig (DdType old) (DdType new) m Void)
migrateAuto :: forall (old :: DdK) (new :: DdK) (m :: * -> *).
AutoMigration old new =>
Dd old
-> Dd new -> Migration ('Mig (DdType old) (DdType new) m Void)
migrateAuto =
  forall (old :: DdK) (new :: DdK) (m :: * -> *).
AutoMigration old new =>
Dd old
-> Dd new -> Migration ('Mig (DdType old) (DdType new) m Void)
autoMigration