module Sqel.Migration.Ddl where

import Generics.SOP (NP (Nil, (:*)))
import Sqel.ColumnConstraints (ColumnConstraints, columnConstraints)
import Sqel.Data.Dd (CompInc (Merge, Nest), Dd (Dd), DdK (DdK), DdStruct (DdComp, DdPrim), Struct (Comp, Prim))
import Sqel.Data.MigrationParams (MigrationDeleteK, MigrationRenameK, MigrationRenameTypeK)
import Sqel.Data.Mods (Mods (Mods))
import Sqel.Data.PgType (ColumnType (ColumnComp, ColumnPrim), pgTypeRefSym)
import Sqel.Data.PgTypeName (MkPgTypeName (pgTypeName))
import Sqel.Data.Sel (ReifySel, Sel (SelSymbol), SelW (SelWSymbol), TSel (TSel), TSelW (TSelW), TypeName)
import Sqel.Kind (type (++))
import Sqel.ReifyDd (ReifyPrimName (reifyPrimName))

import Sqel.Migration.Data.Ddl (DdlColumn (DdlColumn), DdlColumnK (DdlColumnK), DdlType (DdlType), DdlTypeK (DdlTypeK))

appendNP :: NP f as -> NP f bs -> NP f (as ++ bs)
appendNP :: forall {a} (f :: a -> *) (as :: [a]) (bs :: [a]).
NP f as -> NP f bs -> NP f (as ++ bs)
appendNP NP f as
Nil NP f bs
bs =
  NP f bs
bs
appendNP (f x
h :* NP f xs
t) NP f bs
bs =
  f x
h forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {a} (f :: a -> *) (as :: [a]) (bs :: [a]).
NP f as -> NP f bs -> NP f (as ++ bs)
appendNP NP f xs
t NP f bs
bs

type DdCols :: [DdK] -> [DdlColumnK] -> [DdlTypeK] -> Constraint
class DdCols s cols types | s -> cols types where
  ddCols :: NP Dd s -> (NP DdlColumn cols, NP DdlType types)

instance DdCols '[] '[] '[] where
  ddCols :: NP Dd '[] -> (NP DdlColumn '[], NP DdlType '[])
ddCols NP Dd '[]
Nil = (forall {k} (a :: k -> *). NP a '[]
Nil, forall {k} (a :: k -> *). NP a '[]
Nil)

-- TODO the migration params could be extracted in OldColumnsChanges and passed to OldColumnChanges.
instance (
    ReifySel sel name,
    ReifyPrimName a mods,
    ColumnConstraints mods,
    DdCols ss cols types,
    rename ~ MigrationRenameK mods,
    renameType ~ MigrationRenameTypeK mods,
    delete ~ MigrationDeleteK mods
  ) => DdCols ('DdK sel mods a 'Prim : ss) ('DdlColumnK name 'Nothing mods rename renameType delete a : cols) types where
    ddCols :: NP Dd ('DdK sel mods a 'Prim : ss)
-> (NP
      DdlColumn
      ('DdlColumnK name 'Nothing mods rename renameType delete a : cols),
    NP DdlType types)
ddCols (Dd SelW sel
_ m :: Mods mods
m@(Mods NP I mods
mods) DdStruct s1
DdPrim :* NP Dd xs
t) =
      (forall (name :: Symbol) (p :: [*]) (comp :: Maybe Symbol)
       (rename :: Maybe Symbol) (renameType :: Maybe Symbol)
       (delete :: Bool) a.
KnownSymbol name =>
Proxy name
-> ColumnType
-> Mods p
-> DdlColumn ('DdlColumnK name comp p rename renameType delete a)
DdlColumn forall {k} (t :: k). Proxy t
Proxy (PgPrimName -> Bool -> [Sql] -> ColumnType
ColumnPrim (forall {k} (a :: k) (mods :: [*]).
ReifyPrimName a mods =>
NP I mods -> PgPrimName
reifyPrimName @a NP I mods
mods) Bool
unique [Sql]
constr) Mods mods
m forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP DdlColumn cols
cols, NP DdlType types
types)
      where
        (Bool
unique, [Sql]
constr) = forall (mods :: [*]).
ColumnConstraints mods =>
Mods mods -> (Bool, [Sql])
columnConstraints Mods mods
m
        (NP DdlColumn cols
cols, NP DdlType types
types) = forall (s :: [DdK]) (cols :: [DdlColumnK]) (types :: [DdlTypeK]).
DdCols s cols types =>
NP Dd s -> (NP DdlColumn cols, NP DdlType types)
ddCols NP Dd xs
t

instance (
    ColumnConstraints mods,
    DdlTypes 'False ('DdK ('SelSymbol name) mods a ('Comp ('TSel tprefix tname) c 'Nest sub)) hTypes,
    DdCols ss cols types,
    allTypes ~ hTypes ++ types,
    rename ~ MigrationRenameK mods,
    renameType ~ MigrationRenameTypeK mods,
    delete ~ MigrationDeleteK mods,
    TypeName tprefix tname pgName
  ) => DdCols ('DdK ('SelSymbol name) mods a ('Comp ('TSel tprefix tname) c 'Nest sub) : ss) ('DdlColumnK name ('Just pgName) mods rename renameType delete a : cols) allTypes where
    ddCols :: NP
  Dd
  ('DdK
     ('SelSymbol name) mods a ('Comp ('TSel tprefix tname) c 'Nest sub)
     : ss)
-> (NP
      DdlColumn
      ('DdlColumnK name ('Just pgName) mods rename renameType delete a
         : cols),
    NP DdlType allTypes)
ddCols (h :: Dd x
h@(Dd (SelWSymbol Proxy name
Proxy) Mods mods
mods (DdComp (TSelW Proxy '(tpe, name)
Proxy) DdSort c
_ DdInc i
_ NP Dd sub
_)) :* NP Dd xs
t) =
      (forall (name :: Symbol) (p :: [*]) (comp :: Maybe Symbol)
       (rename :: Maybe Symbol) (renameType :: Maybe Symbol)
       (delete :: Bool) a.
KnownSymbol name =>
Proxy name
-> ColumnType
-> Mods p
-> DdlColumn ('DdlColumnK name comp p rename renameType delete a)
DdlColumn forall {k} (t :: k). Proxy t
Proxy (PgTypeRef -> Bool -> [Sql] -> ColumnType
ColumnComp (forall (tname :: Symbol). KnownSymbol tname => PgTypeRef
pgTypeRefSym @pgName) Bool
unique [Sql]
constr) Mods mods
mods forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP DdlColumn cols
tailCols, forall {a} (f :: a -> *) (as :: [a]) (bs :: [a]).
NP f as -> NP f bs -> NP f (as ++ bs)
appendNP NP DdlType hTypes
subTypes NP DdlType types
tailTypes)
      where
        (Bool
unique, [Sql]
constr) = forall (mods :: [*]).
ColumnConstraints mods =>
Mods mods -> (Bool, [Sql])
columnConstraints Mods mods
mods
        subTypes :: NP DdlType hTypes
subTypes = forall (table :: Bool) (s :: DdK) (types :: [DdlTypeK]).
DdlTypes table s types =>
Dd s -> NP DdlType types
ddTypes @'False @_ @hTypes Dd x
h
        (NP DdlColumn cols
tailCols, NP DdlType types
tailTypes) = forall (s :: [DdK]) (cols :: [DdlColumnK]) (types :: [DdlTypeK]).
DdCols s cols types =>
NP Dd s -> (NP DdlColumn cols, NP DdlType types)
ddCols NP Dd xs
t

instance (
    DdCols sub mergeCols subTypes,
    DdCols ss cols types,
    allCols ~ mergeCols ++ cols,
    allTypes ~ subTypes ++ types
  ) => DdCols ('DdK sel mods a ('Comp ('TSel tprefix tname) c 'Merge sub) : ss) allCols allTypes where
    ddCols :: NP
  Dd
  ('DdK sel mods a ('Comp ('TSel tprefix tname) c 'Merge sub) : ss)
-> (NP DdlColumn allCols, NP DdlType allTypes)
ddCols (Dd SelW sel
_ Mods mods
_ (DdComp TSelW sel
_ DdSort c
_ DdInc i
_ NP Dd sub
sub) :* NP Dd xs
t) =
      (forall {a} (f :: a -> *) (as :: [a]) (bs :: [a]).
NP f as -> NP f bs -> NP f (as ++ bs)
appendNP NP DdlColumn mergeCols
subCols NP DdlColumn cols
tailCols, forall {a} (f :: a -> *) (as :: [a]) (bs :: [a]).
NP f as -> NP f bs -> NP f (as ++ bs)
appendNP NP DdlType subTypes
subTypes NP DdlType types
tailTypes)
      where
        (NP DdlColumn mergeCols
subCols, NP DdlType subTypes
subTypes) = forall (s :: [DdK]) (cols :: [DdlColumnK]) (types :: [DdlTypeK]).
DdCols s cols types =>
NP Dd s -> (NP DdlColumn cols, NP DdlType types)
ddCols NP Dd sub
sub
        (NP DdlColumn cols
tailCols, NP DdlType types
tailTypes) = forall (s :: [DdK]) (cols :: [DdlColumnK]) (types :: [DdlTypeK]).
DdCols s cols types =>
NP Dd s -> (NP DdlColumn cols, NP DdlType types)
ddCols NP Dd xs
t

type DdlTypes :: Bool -> DdK -> [DdlTypeK] -> Constraint
class DdlTypes table s types | table s -> types where
  ddTypes :: Dd s -> NP DdlType types

instance (
    DdCols sub cols types,
    rename ~ MigrationRenameTypeK mods,
    MkPgTypeName tprefix tname table pgName
  ) => DdlTypes table ('DdK sel mods a ('Comp ('TSel tprefix tname) c i sub)) ('DdlTypeK table pgName rename cols : types) where
  ddTypes :: Dd ('DdK sel mods a ('Comp ('TSel tprefix tname) c i sub))
-> NP DdlType ('DdlTypeK table pgName rename cols : types)
ddTypes (Dd SelW sel
_ Mods mods
_ (DdComp (TSelW Proxy '(tpe, name)
Proxy) DdSort c
_ DdInc i
_ NP Dd sub
sub)) =
    forall (tname :: Symbol) (table :: Bool) (cols :: [DdlColumnK])
       (rename :: Maybe Symbol).
KnownSymbol tname =>
PgTypeName table
-> NP DdlColumn cols -> DdlType ('DdlTypeK table tname rename cols)
DdlType (forall (prefix :: SelPrefix) (name :: Symbol) (table :: Bool)
       (tname :: Symbol).
MkPgTypeName prefix name table tname =>
PgTypeName table
pgTypeName @tprefix @tname) NP DdlColumn cols
cols forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP DdlType types
types
    where
      (NP DdlColumn cols
cols, NP DdlType types
types) = forall (s :: [DdK]) (cols :: [DdlColumnK]) (types :: [DdlTypeK]).
DdCols s cols types =>
NP Dd s -> (NP DdlColumn cols, NP DdlType types)
ddCols NP Dd sub
sub

ddTable ::
  DdlTypes 'True s (table : types) =>
  Dd s ->
  (DdlType table, NP DdlType types)
ddTable :: forall (s :: DdK) (table :: DdlTypeK) (types :: [DdlTypeK]).
DdlTypes 'True s (table : types) =>
Dd s -> (DdlType table, NP DdlType types)
ddTable Dd s
dd =
  (DdlType table
table, NP DdlType types
types)
  where
    DdlType table
DdlType x
table :* NP DdlType types
NP DdlType xs
types = forall (table :: Bool) (s :: DdK) (types :: [DdlTypeK]).
DdlTypes table s types =>
Dd s -> NP DdlType types
ddTypes @'True Dd s
dd