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,
    Constraints -> [Sql]
extra :: [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