module Sqel.ColumnConstraints where
import Generics.SOP (I (I), NP (Nil, (:*)))
import Lens.Micro ((%~), (.~))
import Sqel.Data.Mods (
Mods (Mods),
Nullable (Nullable),
PgDefault (PgDefault),
PrimaryKey (PrimaryKey),
Unique (Unique),
)
import Sqel.Data.Sql (Sql, sql)
data Constraints =
Constraints {
Constraints -> Bool
unique :: Bool,
Constraints -> Bool
nullable :: Bool,
:: [Sql]
}
deriving stock (Constraints -> Constraints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Constraints -> Constraints -> Bool
$c/= :: Constraints -> Constraints -> Bool
== :: Constraints -> Constraints -> Bool
$c== :: Constraints -> Constraints -> Bool
Eq, Int -> Constraints -> ShowS
[Constraints] -> ShowS
Constraints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Constraints] -> ShowS
$cshowList :: [Constraints] -> ShowS
show :: Constraints -> String
$cshow :: Constraints -> String
showsPrec :: Int -> Constraints -> ShowS
$cshowsPrec :: Int -> Constraints -> ShowS
Show, forall x. Rep Constraints x -> Constraints
forall x. Constraints -> Rep Constraints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Constraints x -> Constraints
$cfrom :: forall x. Constraints -> Rep Constraints x
Generic)
class ColumnConstraint mod where
columnConstraint :: mod -> Constraints -> Constraints
instance {-# overlappable #-} ColumnConstraint mod where
columnConstraint :: mod -> Constraints -> Constraints
columnConstraint mod
_ = forall a. a -> a
id
instance ColumnConstraint Nullable where
columnConstraint :: Nullable -> Constraints -> Constraints
columnConstraint Nullable
Nullable =
#nullable .~ True
instance ColumnConstraint PrimaryKey where
columnConstraint :: PrimaryKey -> Constraints -> Constraints
columnConstraint PrimaryKey
PrimaryKey Constraints {Bool
[Sql]
extra :: [Sql]
nullable :: Bool
unique :: Bool
$sel:extra:Constraints :: Constraints -> [Sql]
$sel:nullable:Constraints :: Constraints -> Bool
$sel:unique:Constraints :: Constraints -> Bool
..} =
Constraints {
$sel:unique:Constraints :: Bool
unique = Bool
True,
$sel:extra:Constraints :: [Sql]
extra = Sql
"primary key" forall a. a -> [a] -> [a]
: [Sql]
extra,
Bool
nullable :: Bool
$sel:nullable:Constraints :: Bool
..
}
instance ColumnConstraint PgDefault where
columnConstraint :: PgDefault -> Constraints -> Constraints
columnConstraint (PgDefault Sql
val) =
#extra %~ ([sql|default ##{val}|] :)
instance ColumnConstraint Unique where
columnConstraint :: Unique -> Constraints -> Constraints
columnConstraint Unique
Unique Constraints {Bool
[Sql]
extra :: [Sql]
nullable :: Bool
unique :: Bool
$sel:extra:Constraints :: Constraints -> [Sql]
$sel:nullable:Constraints :: Constraints -> Bool
$sel:unique:Constraints :: Constraints -> Bool
..} =
Constraints {
$sel:unique:Constraints :: Bool
unique = Bool
True,
$sel:extra:Constraints :: [Sql]
extra = Sql
"unique" forall a. a -> [a] -> [a]
: [Sql]
extra,
Bool
nullable :: Bool
$sel:nullable:Constraints :: Bool
..
}
class ColumnConstraints mods where
collectConstraints :: NP I mods -> Constraints
instance ColumnConstraints '[] where
collectConstraints :: NP I '[] -> Constraints
collectConstraints NP I '[]
Nil = Bool -> Bool -> [Sql] -> Constraints
Constraints Bool
False Bool
False []
instance (
ColumnConstraint mod,
ColumnConstraints mods
) => ColumnConstraints (mod : mods) where
collectConstraints :: NP I (mod : mods) -> Constraints
collectConstraints (I x
h :* NP I xs
t) =
forall mod.
ColumnConstraint mod =>
mod -> Constraints -> Constraints
columnConstraint x
h (forall (mods :: [*]).
ColumnConstraints mods =>
NP I mods -> Constraints
collectConstraints NP I xs
t)
columnConstraints ::
ColumnConstraints mods =>
Mods mods ->
(Bool, [Sql])
columnConstraints :: forall (mods :: [*]).
ColumnConstraints mods =>
Mods mods -> (Bool, [Sql])
columnConstraints (Mods NP I mods
mods) =
(Bool
unique, [Sql]
notNull forall a. Semigroup a => a -> a -> a
<> [Sql]
extra)
where
notNull :: [Sql]
notNull | Bool
nullable = []
| Bool
otherwise = [Sql
"not null"]
Constraints {Bool
[Sql]
nullable :: Bool
extra :: [Sql]
unique :: Bool
$sel:extra:Constraints :: Constraints -> [Sql]
$sel:nullable:Constraints :: Constraints -> Bool
$sel:unique:Constraints :: Constraints -> Bool
..} = forall (mods :: [*]).
ColumnConstraints mods =>
NP I mods -> Constraints
collectConstraints NP I mods
mods