module Sqel.Prim where

import Data.Aeson (FromJSON, ToJSON)
import Generics.SOP (I (I), NP (Nil, (:*)))
import Sqel.Class.Mods (MapMod, SymNP, setMod, symMods)
import Sqel.Column (nullable)
import Sqel.Data.Dd (ConCol, Dd (Dd), DdK (DdK), DdStruct (DdPrim), DdType, Struct (Prim))
import Sqel.Data.MigrationParams (
  MigrationDefault (MigrationDefault),
  MigrationDelete (MigrationDelete),
  MigrationRename (MigrationRename),
  MigrationRenameType (MigrationRenameType),
  )
import Sqel.Data.Mods (
  ArrayColumn (ArrayColumn),
  EnumColumn,
  Ignore (Ignore),
  Mods (Mods),
  Newtype (Newtype),
  pattern NoMods,
  type NoMods,
  Nullable,
  ReadShowColumn,
  )
import Sqel.Data.PgType (PgPrimName)
import Sqel.Data.Sel (
  IndexName,
  Sel (SelAuto, SelIndex, SelSymbol, SelUnused),
  SelPrefix (DefaultPrefix),
  SelW (SelWAuto, SelWIndex),
  )
import Sqel.Mods (PrimValueCodec, primEnumMods, primJsonMods, primReadShowMods)
import Sqel.Names (named, selAs)
import Sqel.SOP.Constraint (ProductGCode)
import Sqel.SOP.Error (Quoted)
import Sqel.SOP.Newtype (UnwrapNewtype (unwrapNewtype, wrapNewtype))

type IndexColumnWith prefix name =
  'DdK ('SelIndex prefix name) NoMods Int64 'Prim

type IndexColumn name =
  IndexColumnWith 'DefaultPrefix name

column :: Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column :: forall (p :: [*]) a. Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column Mods p
m =
  forall (sel :: Sel) (mods :: [*]) (s1 :: Struct) a.
SelW sel -> Mods mods -> DdStruct s1 -> Dd ('DdK sel mods a s1)
Dd SelW 'SelAuto
SelWAuto Mods p
m DdStruct 'Prim
DdPrim

mods ::
  SymNP p ps =>
  p ->
  Mods ps
mods :: forall p (ps :: [*]). SymNP p ps => p -> Mods ps
mods =
  forall p (ps :: [*]). SymNP p ps => p -> Mods ps
symMods

primMod ::
  p ->
  Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod :: forall p a. p -> Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod p
p =
  forall (p :: [*]) a. Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column (forall (ps :: [*]). NP I ps -> Mods ps
Mods (forall a. a -> I a
I p
p forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil))

primMods ::
  SymNP p ps =>
  p ->
  Dd ('DdK 'SelAuto ps a 'Prim)
primMods :: forall p (ps :: [*]) a.
SymNP p ps =>
p -> Dd ('DdK 'SelAuto ps a 'Prim)
primMods p
p =
  forall (p :: [*]) a. Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column (forall p (ps :: [*]). SymNP p ps => p -> Mods ps
mods p
p)

prim ::
  ∀ a .
  Dd ('DdK 'SelAuto NoMods a 'Prim)
prim :: forall a. Dd ('DdK 'SelAuto '[] a 'Prim)
prim =
  forall (p :: [*]) a. Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column forall (ps :: [*]). (ps ~ '[]) => Mods ps
NoMods

ignore ::
  ∀ a .
  Dd ('DdK 'SelUnused '[Ignore] a 'Prim)
ignore :: forall a. Dd ('DdK 'SelUnused '[Ignore] a 'Prim)
ignore =
  forall (sel :: Sel) (s0 :: DdK).
Rename s0 (SetSel s0 sel) =>
Dd s0 -> Dd (SetSel s0 sel)
selAs (forall p a. p -> Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod Ignore
Ignore)

type NewtypeError =
  Quoted "primNewtype" <> " declares a column for a newtype using " <> Quoted "Generic" <> "."

primNewtype ::
  ∀ a w err .
  err ~ NewtypeError =>
  UnwrapNewtype err a w =>
  Dd ('DdK 'SelAuto '[Newtype a w] a 'Prim)
primNewtype :: forall a w (err :: ErrorMessage).
(err ~ NewtypeError, UnwrapNewtype err a w) =>
Dd ('DdK 'SelAuto '[Newtype a w] a 'Prim)
primNewtype =
  forall p a. p -> Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod (forall a w. (a -> w) -> (w -> a) -> Newtype a w
Newtype (forall (errHead :: ErrorMessage) a w.
UnwrapNewtype errHead a w =>
a -> w
unwrapNewtype @err) (forall (errHead :: ErrorMessage) a w.
UnwrapNewtype errHead a w =>
w -> a
wrapNewtype @err))

primCoerce ::
  ∀ a w .
  Coercible a w =>
  Dd ('DdK 'SelAuto '[Newtype a w] a 'Prim)
primCoerce :: forall a w.
Coercible a w =>
Dd ('DdK 'SelAuto '[Newtype a w] a 'Prim)
primCoerce =
  forall p a. p -> Dd ('DdK 'SelAuto '[p] a 'Prim)
primMod (forall a w. (a -> w) -> (w -> a) -> Newtype a w
Newtype coerce :: forall a b. Coercible a b => a -> b
coerce coerce :: forall a b. Coercible a b => a -> b
coerce)

primIndex ::
  ∀ tpe name .
  IndexName 'DefaultPrefix tpe name =>
  Dd (IndexColumn tpe)
primIndex :: forall (tpe :: Symbol) (name :: Symbol).
IndexName 'DefaultPrefix tpe name =>
Dd (IndexColumn tpe)
primIndex =
  forall (sel :: Sel) (mods :: [*]) (s1 :: Struct) a.
SelW sel -> Mods mods -> DdStruct s1 -> Dd ('DdK sel mods a s1)
Dd (forall (prefix :: SelPrefix) (tpe :: Symbol) (name :: Symbol).
IndexName prefix tpe name =>
Proxy name -> SelW ('SelIndex prefix tpe)
SelWIndex forall {k} (t :: k). Proxy t
Proxy) forall (ps :: [*]). (ps ~ '[]) => Mods ps
NoMods DdStruct 'Prim
DdPrim

-- TODO move aeson to reify
json ::
  ∀ a .
  ToJSON a =>
  FromJSON a =>
  Dd ('DdK 'SelAuto [PgPrimName, PrimValueCodec a] a 'Prim)
json :: forall a.
(ToJSON a, FromJSON a) =>
Dd ('DdK 'SelAuto '[PgPrimName, PrimValueCodec a] a 'Prim)
json =
  forall (p :: [*]) a. Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column forall a.
(ToJSON a, FromJSON a) =>
Mods '[PgPrimName, PrimValueCodec a]
primJsonMods

enum ::
  ∀ a .
  Dd ('DdK 'SelAuto [PgPrimName, EnumColumn] a 'Prim)
enum :: forall a. Dd ('DdK 'SelAuto '[PgPrimName, EnumColumn] a 'Prim)
enum =
  forall (p :: [*]) a. Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column Mods '[PgPrimName, EnumColumn]
primEnumMods

readShow ::
  ∀ a .
  Dd ('DdK 'SelAuto [PgPrimName, ReadShowColumn] a 'Prim)
readShow :: forall a. Dd ('DdK 'SelAuto '[PgPrimName, ReadShowColumn] a 'Prim)
readShow =
  forall (p :: [*]) a. Mods p -> Dd ('DdK 'SelAuto p a 'Prim)
column Mods '[PgPrimName, ReadShowColumn]
primReadShowMods

primNullable ::
  ∀ a .
  Dd ('DdK 'SelAuto '[Nullable] (Maybe a) 'Prim)
primNullable :: forall a. Dd ('DdK 'SelAuto '[Nullable] (Maybe a) 'Prim)
primNullable =
  forall (s0 :: DdK) (s1 :: DdK) (s2 :: DdK).
(AddMod Nullable s0 s1, MkNullable s1 s2) =>
Dd s0 -> Dd s2
nullable (forall a. Dd ('DdK 'SelAuto '[] a 'Prim)
prim @a)

primAs ::
  ∀ name a .
  KnownSymbol name =>
  Dd ('DdK ('SelSymbol name) '[] a 'Prim)
primAs :: forall (name :: Symbol) a.
KnownSymbol name =>
Dd ('DdK ('SelSymbol name) '[] a 'Prim)
primAs =
  forall (name :: Symbol) (s0 :: DdK).
Rename s0 (SetName s0 name) =>
Dd s0 -> Dd (SetName s0 name)
named @name (forall a. Dd ('DdK 'SelAuto '[] a 'Prim)
prim @a)

-- TODO are composite arrays legal?
array ::
  ∀ f a p sel .
  Dd ('DdK sel p a 'Prim) ->
  Dd ('DdK sel (ArrayColumn f : p) (f a) 'Prim)
array :: forall (f :: * -> *) a (p :: [*]) (sel :: Sel).
Dd ('DdK sel p a 'Prim)
-> Dd ('DdK sel (ArrayColumn f : p) (f a) 'Prim)
array (Dd SelW sel
sel (Mods NP I mods
p) DdStruct s1
s) =
  forall (sel :: Sel) (mods :: [*]) (s1 :: Struct) a.
SelW sel -> Mods mods -> DdStruct s1 -> Dd ('DdK sel mods a s1)
Dd SelW sel
sel (forall (ps :: [*]). NP I ps -> Mods ps
Mods (forall a. a -> I a
I forall (f :: * -> *). ArrayColumn f
ArrayColumn forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* NP I mods
p)) DdStruct s1
s

migrateDef ::
  ∀ s0 s1 .
  MapMod (MigrationDefault (DdType s0)) s0 s1 =>
  DdType s0 ->
  Dd s0 ->
  Dd s1
migrateDef :: forall (s0 :: DdK) (s1 :: DdK).
MapMod (MigrationDefault (DdType s0)) s0 s1 =>
DdType s0 -> Dd s0 -> Dd s1
migrateDef DdType s0
a =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod (forall a. a -> MigrationDefault a
MigrationDefault DdType s0
a)

migrateRename ::
  ∀ name s0 s1 .
  MapMod (MigrationRename name) s0 s1 =>
  Dd s0 ->
  Dd s1
migrateRename :: forall (name :: Symbol) (s0 :: DdK) (s1 :: DdK).
MapMod (MigrationRename name) s0 s1 =>
Dd s0 -> Dd s1
migrateRename =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod (forall (name :: Symbol). MigrationRename name
MigrationRename @name)

migrateRenameType ::
  ∀ name s0 s1 .
  MapMod (MigrationRenameType name) s0 s1 =>
  Dd s0 ->
  Dd s1
migrateRenameType :: forall (name :: Symbol) (s0 :: DdK) (s1 :: DdK).
MapMod (MigrationRenameType name) s0 s1 =>
Dd s0 -> Dd s1
migrateRenameType =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod (forall (name :: Symbol). MigrationRenameType name
MigrationRenameType @name)

migrateDelete ::
  ∀ s0 s1 .
  MapMod MigrationDelete s0 s1 =>
  Dd s0 ->
  Dd s1
migrateDelete :: forall (s0 :: DdK) (s1 :: DdK).
MapMod MigrationDelete s0 s1 =>
Dd s0 -> Dd s1
migrateDelete =
  forall p (s0 :: DdK) (s1 :: DdK).
MapMod p s0 s1 =>
p -> Dd s0 -> Dd s1
setMod MigrationDelete
MigrationDelete

newtype Prims a s =
  Prims { forall {k} (a :: k) (s :: [DdK]). Prims a s -> NP Dd s
unPrims :: NP Dd s }
  deriving stock (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (a :: k) (s :: [DdK]) x. Rep (Prims a s) x -> Prims a s
forall k (a :: k) (s :: [DdK]) x. Prims a s -> Rep (Prims a s) x
$cto :: forall k (a :: k) (s :: [DdK]) x. Rep (Prims a s) x -> Prims a s
$cfrom :: forall k (a :: k) (s :: [DdK]) x. Prims a s -> Rep (Prims a s) x
Generic)

class MkPrims as s | as -> s where
  mkPrims :: NP Dd s

instance MkPrims '[] '[] where
  mkPrims :: NP Dd '[]
mkPrims = forall {k} (a :: k -> *). NP a '[]
Nil

instance (
    MkPrims as s
  ) => MkPrims (a : as) ('DdK 'SelAuto '[] a 'Prim : s) where
    mkPrims :: NP Dd ('DdK 'SelAuto '[] a 'Prim : s)
mkPrims = forall a. Dd ('DdK 'SelAuto '[] a 'Prim)
prim forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (as :: k) (s :: [DdK]). MkPrims as s => NP Dd s
mkPrims @as @s

type family PrimProd (a :: Type) :: [Type] where
  PrimProd (ConCol _ _ _ as) = as
  PrimProd a = ProductGCode a

prims ::
  ∀ (a :: Type) (s :: [DdK]) .
  MkPrims (PrimProd a) s =>
  Prims a s
prims :: forall a (s :: [DdK]). MkPrims (PrimProd a) s => Prims a s
prims =
  forall {k} (a :: k) (s :: [DdK]). NP Dd s -> Prims a s
Prims (forall {k} (as :: k) (s :: [DdK]). MkPrims as s => NP Dd s
mkPrims @(PrimProd a))

class MkPrimNewtypes as s | as -> s where
  mkPrimNewtypes :: NP Dd s

instance MkPrimNewtypes '[] '[] where
  mkPrimNewtypes :: NP Dd '[]
mkPrimNewtypes = forall {k} (a :: k -> *). NP a '[]
Nil

instance (
    MkPrimNewtypes as s,
    err ~ NewtypeError,
    UnwrapNewtype err a w
  ) => MkPrimNewtypes (a : as) ('DdK 'SelAuto '[Newtype a w] a 'Prim : s) where
    mkPrimNewtypes :: NP Dd ('DdK 'SelAuto '[Newtype a w] a 'Prim : s)
mkPrimNewtypes = forall a w (err :: ErrorMessage).
(err ~ NewtypeError, UnwrapNewtype err a w) =>
Dd ('DdK 'SelAuto '[Newtype a w] a 'Prim)
primNewtype forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (as :: k) (s :: [DdK]). MkPrimNewtypes as s => NP Dd s
mkPrimNewtypes @as @s

primNewtypes ::
  ∀ (a :: Type) (s :: [DdK]) .
  MkPrimNewtypes (PrimProd a) s =>
  Prims a s
primNewtypes :: forall a (s :: [DdK]). MkPrimNewtypes (PrimProd a) s => Prims a s
primNewtypes =
  forall {k} (a :: k) (s :: [DdK]). NP Dd s -> Prims a s
Prims (forall {k} (as :: k) (s :: [DdK]). MkPrimNewtypes as s => NP Dd s
mkPrimNewtypes @(PrimProd a))