{-# language DataKinds #-}
{-# language FlexibleContexts #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}
{-# language UndecidableInstances #-}

module Rel8.Schema.HTable.Identity
  ( HIdentity( HIdentity, unHIdentity )
  )
where

-- base
import Data.Kind ( Type )
import Data.Type.Equality ( (:~:)( Refl ) )
import Prelude

-- rel8
import Rel8.Schema.Dict ( Dict( Dict ) )
import Rel8.Schema.HTable
  ( HTable, HConstrainTable, HField
  , hfield, htabulate, htraverse, hdicts, hspecs
  )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Sql )
import Rel8.Schema.Spec ( specification )
import Rel8.Type ( DBType )


type HIdentity :: Type -> K.HTable
newtype HIdentity a context = HIdentity
  { forall a (context :: Context). HIdentity a context -> context a
unHIdentity :: context a
  }


instance Sql DBType a => HTable (HIdentity a) where
  type HConstrainTable (HIdentity a) constraint = constraint a
  type HField (HIdentity a) = (:~:) a

  hfield :: forall (context :: Context) a.
HIdentity a context -> HField (HIdentity a) a -> context a
hfield (HIdentity context a
a) a :~: a
HField (HIdentity a) a
Refl = context a
context a
a
  htabulate :: forall (context :: Context).
(forall a. HField (HIdentity a) a -> context a)
-> HIdentity a context
htabulate forall a. HField (HIdentity a) a -> context a
f = context a -> HIdentity a context
forall a (context :: Context). context a -> HIdentity a context
HIdentity (context a -> HIdentity a context)
-> context a -> HIdentity a context
forall a b. (a -> b) -> a -> b
$ HField (HIdentity a) a -> context a
forall a. HField (HIdentity a) a -> context a
f a :~: a
HField (HIdentity a) a
forall {k} (a :: k). a :~: a
Refl
  htraverse :: forall (m :: Context) (f :: Context) (g :: Context).
Apply m =>
(forall a. f a -> m (g a)) -> HIdentity a f -> m (HIdentity a g)
htraverse forall a. f a -> m (g a)
f (HIdentity f a
a) = g a -> HIdentity a g
forall a (context :: Context). context a -> HIdentity a context
HIdentity (g a -> HIdentity a g) -> m (g a) -> m (HIdentity a g)
forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> m (g a)
forall a. f a -> m (g a)
f f a
a
  hdicts :: forall (c :: * -> Constraint).
HConstrainTable (HIdentity a) c =>
HIdentity a (Dict c)
hdicts = Dict c a -> HIdentity a (Dict c)
forall a (context :: Context). context a -> HIdentity a context
HIdentity Dict c a
forall {a} (c :: a -> Constraint) (a1 :: a). c a1 => Dict c a1
Dict
  hspecs :: HIdentity a Spec
hspecs = Spec a -> HIdentity a Spec
forall a (context :: Context). context a -> HIdentity a context
HIdentity Spec a
forall a. Sql DBType a => Spec a
specification