{-# language ConstraintKinds #-}
{-# language DataKinds #-}
{-# language FlexibleInstances #-}
{-# language MultiParamTypeClasses #-}
{-# language NamedFieldPuns #-}
{-# language QuantifiedConstraints #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Schema.Spec.ConstrainDBType
  ( ConstrainDBType
  , dbTypeNullity, dbTypeDict
  , nullifier, unnullifier
  )
where

-- base
import Data.Kind ( Constraint, Type )
import Prelude

-- rel8
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.Null
  ( Nullify, Unnullify
  , Nullity( Null, NotNull )
  , Sql, nullable
  )
import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec, nullity ) )


type ConstrainDBType :: (Type -> Constraint) -> Spec -> Constraint
class
  ( forall c labels a. ()
     => (spec ~ 'Spec labels a)
     => (forall x. (constraint x => c x)) => Sql c a
  )
  => ConstrainDBType constraint spec
instance
  ( spec ~ 'Spec labels a
  , Sql constraint a
  )
  => ConstrainDBType constraint spec


dbTypeNullity :: Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity :: Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity = Dict (Sql c) a -> Nullity a
forall (c :: * -> Constraint) a. Dict (Sql c) a -> Nullity a
step2 (Dict (Sql c) a -> Nullity a)
-> (Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a)
-> Dict (ConstrainDBType c) ('Spec l a)
-> Nullity a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
step1
  where
    step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
    step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
step1 Dict (ConstrainDBType c) ('Spec l a)
Dict = Dict (Sql c) a
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict

    step2 :: Dict (Sql c) a -> Nullity a
    step2 :: Dict (Sql c) a -> Nullity a
step2 Dict (Sql c) a
Dict = Nullity a
forall a. Nullable a => Nullity a
nullable


dbTypeDict :: Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict :: Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict = Dict (Sql c) a -> Dict c (Unnullify a)
forall (c :: * -> Constraint) a.
Dict (Sql c) a -> Dict c (Unnullify a)
step2 (Dict (Sql c) a -> Dict c (Unnullify a))
-> (Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a)
-> Dict (ConstrainDBType c) ('Spec l a)
-> Dict c (Unnullify a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
step1
  where
    step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
    step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a
step1 Dict (ConstrainDBType c) ('Spec l a)
Dict = Dict (Sql c) a
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict

    step2 :: Dict (Sql c) a -> Dict c (Unnullify a)
    step2 :: Dict (Sql c) a -> Dict c (Unnullify a)
step2 Dict (Sql c) a
Dict = Dict c (Unnullify a)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict


fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l a)
fromNullityDict :: Nullity a
-> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l a)
fromNullityDict Nullity a
Null Dict c (Unnullify a)
Dict = Dict (ConstrainDBType c) ('Spec l a)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
fromNullityDict Nullity a
NotNull Dict c (Unnullify a)
Dict = Dict (ConstrainDBType c) ('Spec l a)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict


nullifier :: ()
  => SSpec ('Spec labels a)
  -> Dict (ConstrainDBType c) ('Spec labels a)
  -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
nullifier :: SSpec ('Spec labels a)
-> Dict (ConstrainDBType c) ('Spec labels a)
-> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
nullifier SSpec {} Dict (ConstrainDBType c) ('Spec labels a)
dict = case Dict (ConstrainDBType c) ('Spec labels a) -> Dict c (Unnullify a)
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType c) ('Spec labels a)
dict of
  Dict c (Unnullify a)
Dict -> case Dict (ConstrainDBType c) ('Spec labels a) -> Nullity a
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType c) ('Spec labels a)
dict of
    Nullity a
Null -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
    Nullity a
NotNull -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict


unnullifier :: ()
  => SSpec ('Spec labels a)
  -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
  -> Dict (ConstrainDBType c) ('Spec labels a)
unnullifier :: SSpec ('Spec labels a)
-> Dict (ConstrainDBType c) ('Spec labels (Nullify a))
-> Dict (ConstrainDBType c) ('Spec labels a)
unnullifier SSpec {Nullity a
nullity :: Nullity a
nullity :: forall (labels :: Labels) a. SSpec ('Spec labels a) -> Nullity a
nullity} Dict (ConstrainDBType c) ('Spec labels (Nullify a))
dict = case Dict (ConstrainDBType c) ('Spec labels (Nullify a))
-> Dict c (Unnullify (Nullify a))
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)
dbTypeDict Dict (ConstrainDBType c) ('Spec labels (Nullify a))
dict of
  Dict c (Unnullify (Nullify a))
Dict -> case Nullity a
nullity of
    Nullity a
Null -> Dict (ConstrainDBType c) ('Spec labels a)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
    Nullity a
NotNull -> case Dict (ConstrainDBType c) ('Spec labels (Maybe a))
-> Nullity (Maybe a)
forall (c :: * -> Constraint) (l :: Labels) a.
Dict (ConstrainDBType c) ('Spec l a) -> Nullity a
dbTypeNullity Dict (ConstrainDBType c) ('Spec labels (Maybe a))
Dict (ConstrainDBType c) ('Spec labels (Nullify a))
dict of
      Nullity (Maybe a)
Null -> Nullity a
-> Dict c (Unnullify a)
-> Dict (ConstrainDBType c) ('Spec labels a)
forall a (c :: * -> Constraint) (l :: Labels).
Nullity a
-> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l a)
fromNullityDict Nullity a
nullity Dict c (Unnullify a)
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict