{-# 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
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 = forall a (context :: Context). context a -> HIdentity a context
HIdentity forall a b. (a -> b) -> a -> b
$ forall a. HField (HIdentity a) a -> context a
f 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) = forall a (context :: Context). context a -> HIdentity a context
HIdentity forall (f :: Context) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. f a -> m (g a)
f f a
a
  hdicts :: forall (c :: * -> Constraint).
HConstrainTable (HIdentity a) c =>
HIdentity a (Dict c)
hdicts = forall a (context :: Context). context a -> HIdentity a context
HIdentity forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
  hspecs :: HIdentity a Spec
hspecs = forall a (context :: Context). context a -> HIdentity a context
HIdentity forall a. Sql DBType a => Spec a
specification