module Sqel.Migration.Type where

import Generics.SOP (NP (Nil, (:*)), SListI, Top, hcfoldMap)
import Sqel.Data.Migration (CompAction, TableAction, TypeAction (AddAction, ModifyAction, RenameAction))
import Sqel.Data.PgType (PgColumn (PgColumn), PgColumns (PgColumns), pgColumnName)
import Sqel.Data.PgTypeName (PgCompName)
import Sqel.Kind (type (++))
import Sqel.SOP.Constraint (symbolText)

import Sqel.Migration.Column (ColIndex (colIndex), ColumnsChanges (columnsChanges))
import Sqel.Migration.Data.Ddl (DdlColumn (DdlColumn), DdlColumnK, DdlType (DdlType), DdlTypeK (DdlTypeK))

data OldK =
  OldK {
    OldK -> Bool
table :: Bool,
    OldK -> Symbol
name :: Symbol,
    OldK -> [DdlColumnK]
cols :: [DdlColumnK]
  }

data NewK =
  NewK {
    NewK -> Nat
index :: Nat,
    NewK -> Bool
table :: Bool,
    NewK -> Symbol
name :: Symbol,
    NewK -> Maybe Symbol
rename :: Maybe Symbol,
    NewK -> [DdlColumnK]
cols :: [DdlColumnK]
  }

data ModK =
  KeepK
  |
  AddK
  |
  RenameK

data ActionK =
  ActionK {
    ActionK -> ModK
mod :: ModK,
    ActionK -> Nat
index :: Nat
  }
  |
  UnusedK

type family OldKs (index :: Nat) (types :: [DdlTypeK]) :: [OldK] where
  OldKs _ '[] = '[]
  OldKs index ('DdlTypeK table name _ cols : types) =
    'OldK table name cols : OldKs (index + 1) types

type family NewKs (index :: Nat) (types :: [DdlTypeK]) :: [NewK] where
  NewKs _ '[] = '[]
  NewKs index ('DdlTypeK table name rename cols : types) =
    'NewK index table name rename cols : NewKs (index + 1) types

type family MkMigrationAction (old :: OldK) (check :: [NewK]) (other :: [NewK]) :: (ActionK, [NewK]) where
  MkMigrationAction _ '[] other =
    '( 'UnusedK, other)
  MkMigrationAction ('OldK table name _) ('NewK index table name 'Nothing _ : news) other =
    '( 'ActionK 'KeepK index, news ++ other)
  MkMigrationAction ('OldK table oldName _) ('NewK index table _ ('Just oldName) _ : news) other =
    '( 'ActionK 'RenameK index, news ++ other)
  MkMigrationAction old (new : news) other =
    MkMigrationAction old news (new : other)

type family NewMigrationActions (cols :: [NewK]) :: [ActionK] where
  NewMigrationActions '[] = '[]
  NewMigrationActions ('NewK index 'False _ 'Nothing _ : news) =
    'ActionK 'AddK index : NewMigrationActions news
  NewMigrationActions cols = TypeError ("type NewMigrationActions:" % cols)

type family MigrationActionsCont (cur :: (ActionK, [NewK])) (old :: [OldK]) :: [ActionK] where
  MigrationActionsCont '(cur, new) old = cur : MigrationActions old new

type family MigrationActions (old :: [OldK]) (new :: [NewK]) :: [ActionK] where
  MigrationActions '[] rest =
    NewMigrationActions rest
  MigrationActions (old : olds) new =
    MigrationActionsCont (MkMigrationAction old new '[]) olds

type ReifyKeepAction :: Bool -> DdlTypeK -> DdlTypeK -> Constraint
class ReifyKeepAction table old new where
  reifyKeepAction :: DdlType old -> DdlType new -> TypeAction table

instance (
    ColumnsChanges colsOld colsNew
  ) => ReifyKeepAction table ('DdlTypeK table tname renameOld colsOld) ('DdlTypeK table tname renameNew colsNew) where
    reifyKeepAction :: DdlType ('DdlTypeK table tname renameOld colsOld)
-> DdlType ('DdlTypeK table tname renameNew colsNew)
-> TypeAction table
reifyKeepAction (DdlType PgTypeName table
name NP DdlColumn cols
colsOld) (DdlType PgTypeName table
_ NP DdlColumn cols
colsNew) =
      forall (table :: Bool).
PgTypeName table -> [ColumnAction] -> TypeAction table
ModifyAction PgTypeName table
name (forall (old :: [DdlColumnK]) (new :: [DdlColumnK]).
ColumnsChanges old new =>
NP DdlColumn old -> NP DdlColumn new -> [ColumnAction]
columnsChanges NP DdlColumn cols
colsOld NP DdlColumn cols
colsNew)

type family ReifyModResult (table :: Bool) :: Type where
  ReifyModResult 'False =
    [(PgCompName, CompAction)]
  ReifyModResult 'True =
    TypeAction 'True

type ReifyModAction :: Bool -> ModK -> DdlTypeK -> DdlTypeK -> Constraint
class ReifyModAction table action old new where
  reifyModAction :: DdlType old -> DdlType new -> ReifyModResult table

instance (
    ReifyKeepAction 'True old new
  ) => ReifyModAction 'True 'KeepK old new where
    reifyModAction :: DdlType old -> DdlType new -> ReifyModResult 'True
reifyModAction DdlType old
old DdlType new
new =
      forall (table :: Bool) (old :: DdlTypeK) (new :: DdlTypeK).
ReifyKeepAction table old new =>
DdlType old -> DdlType new -> TypeAction table
reifyKeepAction @'True DdlType old
old DdlType new
new

instance (
    ReifyKeepAction 'False ('DdlTypeK 'False tname renameOld colsOld) new
  ) => ReifyModAction 'False 'KeepK ('DdlTypeK 'False tname renameOld colsOld) new where
    reifyModAction :: DdlType ('DdlTypeK 'False tname renameOld colsOld)
-> DdlType new -> ReifyModResult 'False
reifyModAction old :: DdlType ('DdlTypeK 'False tname renameOld colsOld)
old@(DdlType PgTypeName table
name NP DdlColumn cols
_) DdlType new
new =
      [(PgTypeName table
name, forall (table :: Bool) (old :: DdlTypeK) (new :: DdlTypeK).
ReifyKeepAction table old new =>
DdlType old -> DdlType new -> TypeAction table
reifyKeepAction @'False DdlType ('DdlTypeK 'False tname renameOld colsOld)
old DdlType new
new)]

instance (
    ColumnsChanges colsOld colsNew
  ) => ReifyModAction 'False 'RenameK ('DdlTypeK 'False name renameOld colsOld) ('DdlTypeK 'False nameNew ('Just name) colsNew) where
    reifyModAction :: DdlType ('DdlTypeK 'False name renameOld colsOld)
-> DdlType ('DdlTypeK 'False nameNew ('Just name) colsNew)
-> ReifyModResult 'False
reifyModAction (DdlType PgTypeName table
nameOld NP DdlColumn cols
colsOld) (DdlType PgTypeName table
nameNew NP DdlColumn cols
colsNew) =
      [(PgTypeName table
nameOld, PgCompName -> [ColumnAction] -> CompAction
RenameAction PgTypeName table
nameNew (forall (old :: [DdlColumnK]) (new :: [DdlColumnK]).
ColumnsChanges old new =>
NP DdlColumn old -> NP DdlColumn new -> [ColumnAction]
columnsChanges NP DdlColumn cols
colsOld NP DdlColumn cols
colsNew))]

type ReifyOldAction :: Bool -> ActionK -> DdlTypeK -> [DdlTypeK] -> Constraint
class ReifyOldAction table action old new where
  reifyOldAction :: DdlType old -> NP DdlType new -> ReifyModResult table

instance (
    ColIndex index news new,
    ReifyModAction table mod old new
  ) => ReifyOldAction table ('ActionK mod index) old news where
  reifyOldAction :: DdlType old -> NP DdlType news -> ReifyModResult table
reifyOldAction DdlType old
old NP DdlType news
news =
    forall (table :: Bool) (action :: ModK) (old :: DdlTypeK)
       (new :: DdlTypeK).
ReifyModAction table action old new =>
DdlType old -> DdlType new -> ReifyModResult table
reifyModAction @table @mod DdlType old
old (forall {k} {k1} (index :: k) (cols :: [k1]) (col :: k1)
       (f :: k1 -> *).
ColIndex index cols col =>
NP f cols -> f col
colIndex @index NP DdlType news
news)

instance ReifyOldAction 'False 'UnusedK ('DdlTypeK 'False name renameOld colsOld) new where
  reifyOldAction :: DdlType ('DdlTypeK 'False name renameOld colsOld)
-> NP DdlType new -> ReifyModResult 'False
reifyOldAction DdlType ('DdlTypeK 'False name renameOld colsOld)
_ NP DdlType new
_ = []

-- -- TODO this has to check that new columns in composite types are
-- -- a) at the end of the list
-- -- b) Maybe
type ReifyNewAction :: ActionK -> [DdlTypeK] -> Constraint
class ReifyNewAction action new where
  reifyNewAction :: NP DdlType new -> (PgCompName, CompAction)

instance (
    SListI cols,
    ColIndex index news ('DdlTypeK 'False name rename cols)
  ) => ReifyNewAction ('ActionK 'AddK index) news where
  reifyNewAction :: NP DdlType news -> (PgCompName, CompAction)
reifyNewAction NP DdlType news
news =
    let
      DdlType PgTypeName table
PgCompName
name NP DdlColumn cols
NP DdlColumn cols
ddlCols = forall {k} {k1} (index :: k) (cols :: [k1]) (col :: k1)
       (f :: k1 -> *).
ColIndex index cols col =>
NP f cols -> f col
colIndex @index NP DdlType news
news
      cols :: NP DdlColumn cols -> [PgColumn]
cols = forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) m (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HTraverse_ h, AllN h c xs, Monoid m) =>
proxy c -> (forall (a :: k). c a => f a -> m) -> h f xs -> m
hcfoldMap (forall {k} (t :: k). Proxy t
Proxy @Top) \ (DdlColumn (Proxy name
Proxy :: Proxy n) ColumnType
t Mods p
_) ->
        [PgColumnName -> ColumnType -> PgColumn
PgColumn (Text -> PgColumnName
pgColumnName (forall (name :: Symbol). KnownSymbol name => Text
symbolText @n)) ColumnType
t]
    in (PgCompName
name, PgColumns -> CompAction
AddAction ([PgColumn] -> PgColumns
PgColumns (NP DdlColumn cols -> [PgColumn]
cols NP DdlColumn cols
ddlCols)))

type ReifyActions :: [ActionK] -> [DdlTypeK] -> [DdlTypeK] -> Constraint
class ReifyActions actions old new where
  reifyActions :: NP DdlType old -> NP DdlType new -> [(PgCompName, CompAction)]

instance ReifyActions '[] '[] new where
  reifyActions :: NP DdlType '[] -> NP DdlType new -> [(PgCompName, CompAction)]
reifyActions NP DdlType '[]
_ NP DdlType new
_ =
    forall a. Monoid a => a
mempty

instance (
    ReifyNewAction action new,
    ReifyActions actions '[] new
  ) => ReifyActions (action : actions) '[] new where
    reifyActions :: NP DdlType '[] -> NP DdlType new -> [(PgCompName, CompAction)]
reifyActions NP DdlType '[]
Nil NP DdlType new
new =
      forall (action :: ActionK) (new :: [DdlTypeK]).
ReifyNewAction action new =>
NP DdlType new -> (PgCompName, CompAction)
reifyNewAction @action NP DdlType new
new forall a. a -> [a] -> [a]
: forall (actions :: [ActionK]) (old :: [DdlTypeK])
       (new :: [DdlTypeK]).
ReifyActions actions old new =>
NP DdlType old -> NP DdlType new -> [(PgCompName, CompAction)]
reifyActions @actions forall {k} (a :: k -> *). NP a '[]
Nil NP DdlType new
new

instance (
    ReifyOldAction 'False action o new,
    ReifyActions actions old new
  ) => ReifyActions (action : actions) (o : old) new where
    reifyActions :: NP DdlType (o : old)
-> NP DdlType new -> [(PgCompName, CompAction)]
reifyActions (DdlType x
o :* NP DdlType xs
old) NP DdlType new
new =
      forall (table :: Bool) (action :: ActionK) (old :: DdlTypeK)
       (new :: [DdlTypeK]).
ReifyOldAction table action old new =>
DdlType old -> NP DdlType new -> ReifyModResult table
reifyOldAction @'False @action DdlType x
o NP DdlType new
new forall a. Semigroup a => a -> a -> a
<> forall (actions :: [ActionK]) (old :: [DdlTypeK])
       (new :: [DdlTypeK]).
ReifyActions actions old new =>
NP DdlType old -> NP DdlType new -> [(PgCompName, CompAction)]
reifyActions @actions NP DdlType xs
old NP DdlType new
new

type TypeChanges :: [DdlTypeK] -> [DdlTypeK] -> Constraint
class TypeChanges old new where
  typeChanges :: NP DdlType old -> NP DdlType new -> [(PgCompName, CompAction)]

instance (
    actions ~ MigrationActions (OldKs 0 old) (NewKs 0 new),
    ReifyActions actions old new
  ) => TypeChanges old new where
    typeChanges :: NP DdlType old -> NP DdlType new -> [(PgCompName, CompAction)]
typeChanges = forall (actions :: [ActionK]) (old :: [DdlTypeK])
       (new :: [DdlTypeK]).
ReifyActions actions old new =>
NP DdlType old -> NP DdlType new -> [(PgCompName, CompAction)]
reifyActions @actions

type TableChange :: DdlTypeK -> DdlTypeK -> Constraint
class TableChange old new where
  tableChange :: DdlType old -> DdlType new -> TableAction

instance (
    '[oldk] ~ OldKs 0 '[old],
    '(action, '[]) ~ MkMigrationAction oldk (NewKs 0 '[new]) '[],
    ReifyOldAction 'True action old '[new]
  ) => TableChange old new where
    tableChange :: DdlType old -> DdlType new -> TableAction
tableChange DdlType old
old DdlType new
new =
      forall (table :: Bool) (action :: ActionK) (old :: DdlTypeK)
       (new :: [DdlTypeK]).
ReifyOldAction table action old new =>
DdlType old -> NP DdlType new -> ReifyModResult table
reifyOldAction @'True @action DdlType old
old (DdlType new
new forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil)