{-# 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
  { 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 :: HIdentity a context -> HField (HIdentity a) a -> context a
hfield (HIdentity context a
a) HField (HIdentity a) a
Refl = context a
context a
a
  htabulate :: (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 HField (HIdentity a) a
forall k (a :: k). a :~: a
Refl
  htraverse :: (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 :: 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) (a :: a). c a => Dict c a
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