{-# language DataKinds #-}
{-# language GADTs #-}
{-# language PatternSynonyms #-}
{-# language StandaloneKindSignatures #-}
{-# language TypeFamilies #-}

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

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

-- rel8
import Rel8.Kind.Necessity ( Necessity( Required ) )
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.Spec ( Spec( Spec ), KnownSpec, specSing )


type HType :: Type -> K.HTable
type HType a = HIdentity ('Spec '[] 'Required a)


pattern HType :: context ('Spec '[] 'Required a) -> HType a context
pattern $bHType :: context ('Spec '[] 'Required a) -> HType a context
$mHType :: forall r (context :: Spec -> *) a.
HType a context
-> (context ('Spec '[] 'Required a) -> r) -> (Void# -> r) -> r
HType a = HIdentity a
{-# COMPLETE HType #-}


type HIdentity :: Spec -> K.HTable
newtype HIdentity spec context = HIdentity
  { HIdentity spec context -> context spec
unHIdentity :: context spec
  }


type HIdentityField :: Spec -> Spec -> Type
data HIdentityField _spec spec where
  HIdentityField :: HIdentityField spec spec


instance KnownSpec spec => HTable (HIdentity spec) where
  type HConstrainTable (HIdentity spec) c = c spec
  type HField (HIdentity spec) = HIdentityField spec

  hfield :: HIdentity spec context
-> HField (HIdentity spec) spec -> context spec
hfield (HIdentity context spec
a) HField (HIdentity spec) spec
HIdentityField = context spec
context spec
a
  htabulate :: (forall (spec :: Spec).
 HField (HIdentity spec) spec -> context spec)
-> HIdentity spec context
htabulate forall (spec :: Spec). HField (HIdentity spec) spec -> context spec
f = context spec -> HIdentity spec context
forall (spec :: Spec) (context :: Spec -> *).
context spec -> HIdentity spec context
HIdentity (context spec -> HIdentity spec context)
-> context spec -> HIdentity spec context
forall a b. (a -> b) -> a -> b
$ HField (HIdentity spec) spec -> context spec
forall (spec :: Spec). HField (HIdentity spec) spec -> context spec
f HField (HIdentity spec) spec
forall (spec :: Spec). HIdentityField spec spec
HIdentityField
  htraverse :: (forall (spec :: Spec). f spec -> m (g spec))
-> HIdentity spec f -> m (HIdentity spec g)
htraverse forall (spec :: Spec). f spec -> m (g spec)
f (HIdentity f spec
a) = g spec -> HIdentity spec g
forall (spec :: Spec) (context :: Spec -> *).
context spec -> HIdentity spec context
HIdentity (g spec -> HIdentity spec g) -> m (g spec) -> m (HIdentity spec g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f spec -> m (g spec)
forall (spec :: Spec). f spec -> m (g spec)
f f spec
a
  hdicts :: HIdentity spec (Dict c)
hdicts = Dict c spec -> HIdentity spec (Dict c)
forall (spec :: Spec) (context :: Spec -> *).
context spec -> HIdentity spec context
HIdentity Dict c spec
forall a (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
  hspecs :: HIdentity spec SSpec
hspecs = SSpec spec -> HIdentity spec SSpec
forall (spec :: Spec) (context :: Spec -> *).
context spec -> HIdentity spec context
HIdentity SSpec spec
forall (spec :: Spec). KnownSpec spec => SSpec spec
specSing