module Sqel.Migration.Init where

import Exon (exon)
import Lens.Micro ((^.))
import qualified Sqel.Class.MigrationEffect as MigrationEffect
import Sqel.Class.MigrationEffect (MigrationEffect)
import Sqel.Data.PgType (
  PgColumnName (PgColumnName),
  PgComposite (PgComposite),
  PgStructure (PgStructure),
  PgTable,
  StructureType (StructureComp, StructurePrim),
  structureToColumns,
  )
import Sqel.Data.PgTypeName (PgCompName, getPgTypeName)
import qualified Sqel.Sql.Type as Sql
import Sqel.Statement (createTable, plain, typeColumnsSql)

import Sqel.Migration.Metadata (DbCols (DbCols), typeColumns)

initComp ::
  Monad m =>
  MigrationEffect m =>
  PgCompName ->
  PgStructure ->
  m ()
initComp :: forall (m :: * -> *).
(Monad m, MigrationEffect m) =>
PgCompName -> PgStructure -> m ()
initComp PgCompName
tpe PgStructure
structure = do
  DbCols Map PgColumnName (Either PgTypeRef PgPrimName)
existing <- forall (m :: * -> *) (table :: Bool).
(Monad m, MigrationEffect m) =>
Sql -> PgTypeName table -> m DbCols
typeColumns Sql
typeColumnsSql PgCompName
tpe
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map PgColumnName (Either PgTypeRef PgPrimName)
existing) m ()
createType
  where
    createType :: m ()
createType = do
      forall (m :: * -> *).
(Monad m, MigrationEffect m) =>
PgStructure -> m ()
initStructure PgStructure
structure
      forall (m :: * -> *) q.
MigrationEffect m =>
q -> Statement q () -> m ()
MigrationEffect.runStatement_ () (Sql -> Statement () ()
plain (PgComposite -> Sql
Sql.createProdType (PgCompName -> PgColumns -> PgComposite
PgComposite PgCompName
tpe (PgStructure -> PgColumns
structureToColumns PgStructure
structure))))

initType ::
  Monad m =>
  MigrationEffect m =>
  PgColumnName ->
  StructureType ->
  m ()
initType :: forall (m :: * -> *).
(Monad m, MigrationEffect m) =>
PgColumnName -> StructureType -> m ()
initType (PgColumnName Text
_) = \case
  StructurePrim PgPrimName
_ Bool
_ [Sql]
_ ->
    forall (f :: * -> *). Applicative f => f ()
unit
  StructureComp PgCompName
tpe PgStructure
columns Bool
_ [Sql]
_ ->
    forall (m :: * -> *).
(Monad m, MigrationEffect m) =>
PgCompName -> PgStructure -> m ()
initComp PgCompName
tpe PgStructure
columns

initStructure ::
  Monad m =>
  MigrationEffect m =>
  PgStructure ->
  m ()
initStructure :: forall (m :: * -> *).
(Monad m, MigrationEffect m) =>
PgStructure -> m ()
initStructure (PgStructure [(PgColumnName, StructureType)]
cols) =
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
(Monad m, MigrationEffect m) =>
PgColumnName -> StructureType -> m ()
initType) [(PgColumnName, StructureType)]
cols

initTable ::
  Monad m =>
  MigrationEffect m =>
  PgTable a ->
  m ()
initTable :: forall {k} (m :: * -> *) (a :: k).
(Monad m, MigrationEffect m) =>
PgTable a -> m ()
initTable PgTable a
table = do
  forall (m :: * -> *). MigrationEffect m => Text -> m ()
MigrationEffect.log [exon|Initializing table '#{getPgTypeName (table ^. #name)}'|]
  forall (m :: * -> *).
(Monad m, MigrationEffect m) =>
PgStructure -> m ()
initStructure (PgTable a
table forall s a. s -> Getting a s a -> a
^. forall a. IsLabel "structure" a => a
#structure)
  forall (m :: * -> *) q.
MigrationEffect m =>
q -> Statement q () -> m ()
MigrationEffect.runStatement_ () (forall {k} (a :: k). PgTable a -> Statement () ()
createTable PgTable a
table)