module Sqel.ReifyDd where
import Generics.SOP (I (I), NP (Nil, (:*)), tl)
import Sqel.Class.Mods (MaybeMod (maybeMod))
import Sqel.Codec (PrimColumn (pgType))
import Sqel.ColumnConstraints (ColumnConstraints, columnConstraints)
import Sqel.Data.Dd (Dd (Dd), DdK (DdK), DdStruct (DdComp, DdPrim), Struct (Comp, Prim))
import Sqel.Data.Mods (
ArrayColumn (ArrayColumn),
Mods (Mods),
Newtype (Newtype),
Nullable (Nullable),
SetTableName,
unSetTableName,
)
import Sqel.Data.PgType (PgPrimName, pgColumnName)
import Sqel.Data.Sel (ReifySel (reifySel), SelW (SelWSymbol), TSelW (TSelW))
import qualified Sqel.Data.Term as Term
import Sqel.Data.Term (DdTerm (DdTerm), demoteComp, demoteInc)
import Sqel.SOP.Constraint (symbolText)
class ReifyPrimName a mods where
reifyPrimName :: NP I mods -> PgPrimName
instance {-# overlappable #-} (
ReifyPrimName a mods
) => ReifyPrimName a (p : mods) where
reifyPrimName :: NP I (p : mods) -> PgPrimName
reifyPrimName = forall {k} (a :: k) (mods :: [*]).
ReifyPrimName a mods =>
NP I mods -> PgPrimName
reifyPrimName @a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (x :: k) (xs :: [k]).
NP f (x : xs) -> NP f xs
tl
instance (
PrimColumn a
) => ReifyPrimName a '[] where
reifyPrimName :: NP I '[] -> PgPrimName
reifyPrimName NP I '[]
Nil = forall a. PrimColumn a => PgPrimName
pgType @a
instance (
ReifyPrimName a mods
) => ReifyPrimName (Maybe a) (Nullable : mods) where
reifyPrimName :: NP I (Nullable : mods) -> PgPrimName
reifyPrimName (I x
Nullable
Nullable :* NP I xs
mods) = forall {k} (a :: k) (mods :: [*]).
ReifyPrimName a mods =>
NP I mods -> PgPrimName
reifyPrimName @a NP I xs
mods
instance (
ReifyPrimName a mods
) => ReifyPrimName (f a) (ArrayColumn f : mods) where
reifyPrimName :: NP I (ArrayColumn f : mods) -> PgPrimName
reifyPrimName (I x
ArrayColumn f
ArrayColumn :* NP I xs
mods) = forall {k} (a :: k) (mods :: [*]).
ReifyPrimName a mods =>
NP I mods -> PgPrimName
reifyPrimName @a NP I xs
mods forall a. Semigroup a => a -> a -> a
<> PgPrimName
"[]"
instance (
ReifyPrimName w mods
) => ReifyPrimName a (Newtype a w : mods) where
reifyPrimName :: NP I (Newtype a w : mods) -> PgPrimName
reifyPrimName (I (Newtype a -> w
_ w -> a
_) :* NP I xs
mods) = forall {k} (a :: k) (mods :: [*]).
ReifyPrimName a mods =>
NP I mods -> PgPrimName
reifyPrimName @w NP I xs
mods
instance ReifyPrimName a (PgPrimName : mods) where
reifyPrimName :: NP I (PgPrimName : mods) -> PgPrimName
reifyPrimName (I x
t :* NP I xs
_) = x
t
class ReifyDd s where
reifyDd :: Dd s -> DdTerm
instance (
ColumnConstraints mods,
MaybeMod SetTableName mods,
ReifyPrimName a mods,
ReifySel sel name
) => ReifyDd ('DdK sel mods a 'Prim) where
reifyDd :: Dd ('DdK sel mods a 'Prim) -> DdTerm
reifyDd (Dd SelW sel
sel mods :: Mods mods
mods@(Mods NP I mods
ms) DdStruct s1
DdPrim) =
PgColumnName
-> Maybe PgTableName -> Bool -> [Sql] -> Struct -> DdTerm
DdTerm (Text -> PgColumnName
pgColumnName Text
name) (SetTableName -> PgTableName
unSetTableName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p (ps :: [*]). MaybeMod p ps => Mods ps -> Maybe p
maybeMod Mods mods
mods) Bool
unique [Sql]
constraints (PgPrimName -> Struct
Term.Prim (forall {k} (a :: k) (mods :: [*]).
ReifyPrimName a mods =>
NP I mods -> PgPrimName
reifyPrimName @a NP I mods
ms))
where
(Bool
unique, [Sql]
constraints) = forall (mods :: [*]).
ColumnConstraints mods =>
Mods mods -> (Bool, [Sql])
columnConstraints Mods mods
mods
name :: Text
name = forall (sel :: Sel) (name :: Symbol).
ReifySel sel name =>
SelW sel -> Text
reifySel SelW sel
sel
instance (
ColumnConstraints mods,
MaybeMod SetTableName mods,
ReifyDdComp sub
) => ReifyDd ('DdK sel mods a ('Comp tsel c i sub)) where
reifyDd :: Dd ('DdK sel mods a ('Comp tsel c i sub)) -> DdTerm
reifyDd (Dd SelW sel
sel Mods mods
mods (DdComp (TSelW (Proxy '(tpe, name)
Proxy :: Proxy '(tname, tpe))) DdSort c
c DdInc i
i NP Dd sub
sub)) =
PgColumnName
-> Maybe PgTableName -> Bool -> [Sql] -> Struct -> DdTerm
DdTerm (Text -> PgColumnName
pgColumnName Text
name) (SetTableName -> PgTableName
unSetTableName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall p (ps :: [*]). MaybeMod p ps => Mods ps -> Maybe p
maybeMod Mods mods
mods) Bool
unique [Sql]
constraints Struct
struct
where
(Bool
unique, [Sql]
constraints) = forall (mods :: [*]).
ColumnConstraints mods =>
Mods mods -> (Bool, [Sql])
columnConstraints Mods mods
mods
struct :: Struct
struct = Text -> Comp -> CompInc -> [DdTerm] -> Struct
Term.Comp Text
typeName (forall (c :: Comp). DdSort c -> Comp
demoteComp DdSort c
c) (forall (i :: CompInc). DdInc i -> CompInc
demoteInc DdInc i
i) (forall (s :: [DdK]). ReifyDdComp s => NP Dd s -> [DdTerm]
reifyDdComp NP Dd sub
sub)
name :: Text
name = case SelW sel
sel of
SelWSymbol (Proxy name
Proxy :: Proxy name) -> forall (name :: Symbol). KnownSymbol name => Text
symbolText @name
SelW sel
_ -> forall (name :: Symbol). KnownSymbol name => Text
symbolText @tname
typeName :: Text
typeName = forall (name :: Symbol). KnownSymbol name => Text
symbolText @tpe
class ReifyDdComp s where
reifyDdComp :: NP Dd s -> [DdTerm]
instance ReifyDdComp '[] where
reifyDdComp :: NP Dd '[] -> [DdTerm]
reifyDdComp NP Dd '[]
Nil = []
instance (
ReifyDd s,
ReifyDdComp ss
) => ReifyDdComp (s : ss) where
reifyDdComp :: NP Dd (s : ss) -> [DdTerm]
reifyDdComp (Dd x
s :* NP Dd xs
ss) = forall (s :: DdK). ReifyDd s => Dd s -> DdTerm
reifyDd Dd x
s forall a. a -> [a] -> [a]
: forall (s :: [DdK]). ReifyDdComp s => NP Dd s -> [DdTerm]
reifyDdComp NP Dd xs
ss