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

module Rel8.Schema.HTable.Type
  ( HType(..)
  )
where

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

-- rel8
import Rel8.Kind.Labels ( SLabels( SLabel ) )
import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )
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, nullable )
import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
import Rel8.Type ( DBType, typeInformation )


type HType :: Type -> K.HTable
newtype HType a context = HType
  { forall a (context :: HContext).
HType a context -> context ('Spec '[""] 'Required a)
unHType :: context ('Spec '[""] 'Required a)
  }


type HTypeField :: Type -> Spec -> Type
data HTypeField a spec where
  HTypeField :: HTypeField a ('Spec '[""] 'Required a)


instance Sql DBType a => HTable (HType a) where
  type HConstrainTable (HType a) c = c ('Spec '[""] 'Required a)
  type HField (HType a) = HTypeField a

  hfield :: forall (context :: HContext) (spec :: Spec).
HType a context -> HField (HType a) spec -> context spec
hfield (HType context ('Spec '[""] 'Required a)
a) HField (HType a) spec
HTypeField a spec
HTypeField = context spec
context ('Spec '[""] 'Required a)
a
  htabulate :: forall (context :: HContext).
(forall (spec :: Spec). HField (HType a) spec -> context spec)
-> HType a context
htabulate forall (spec :: Spec). HField (HType a) spec -> context spec
f = context ('Spec '[""] 'Required a) -> HType a context
forall a (context :: HContext).
context ('Spec '[""] 'Required a) -> HType a context
HType (context ('Spec '[""] 'Required a) -> HType a context)
-> context ('Spec '[""] 'Required a) -> HType a context
forall a b. (a -> b) -> a -> b
$ HField (HType a) ('Spec '[""] 'Required a)
-> context ('Spec '[""] 'Required a)
forall (spec :: Spec). HField (HType a) spec -> context spec
f HField (HType a) ('Spec '[""] 'Required a)
forall a. HTypeField a ('Spec '[""] 'Required a)
HTypeField
  htraverse :: forall (m :: * -> *) (f :: HContext) (g :: HContext).
Apply m =>
(forall (spec :: Spec). f spec -> m (g spec))
-> HType a f -> m (HType a g)
htraverse forall (spec :: Spec). f spec -> m (g spec)
f (HType f ('Spec '[""] 'Required a)
a) = g ('Spec '[""] 'Required a) -> HType a g
forall a (context :: HContext).
context ('Spec '[""] 'Required a) -> HType a context
HType (g ('Spec '[""] 'Required a) -> HType a g)
-> m (g ('Spec '[""] 'Required a)) -> m (HType a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f ('Spec '[""] 'Required a) -> m (g ('Spec '[""] 'Required a))
forall (spec :: Spec). f spec -> m (g spec)
f f ('Spec '[""] 'Required a)
a
  hdicts :: forall (c :: Spec -> Constraint).
HConstrainTable (HType a) c =>
HType a (Dict c)
hdicts = Dict c ('Spec '[""] 'Required a) -> HType a (Dict c)
forall a (context :: HContext).
context ('Spec '[""] 'Required a) -> HType a context
HType Dict c ('Spec '[""] 'Required a)
forall {a} (c :: a -> Constraint) (a :: a). c a => Dict c a
Dict
  hspecs :: HType a SSpec
hspecs = SSpec ('Spec '[""] 'Required a) -> HType a SSpec
forall a (context :: HContext).
context ('Spec '[""] 'Required a) -> HType a context
HType SSpec :: forall (label :: Labels) (necessity :: Necessity) a.
SLabels label
-> SNecessity necessity
-> TypeInformation (Unnullify a)
-> Nullity a
-> SSpec ('Spec label necessity a)
SSpec
    { labels :: SLabels '[""]
labels = Proxy "" -> SLabels '[""]
forall (label :: Symbol).
KnownSymbol label =>
Proxy label -> SLabels '[label]
SLabel Proxy ""
forall {k} (t :: k). Proxy t
Proxy
    , necessity :: SNecessity 'Required
necessity = SNecessity 'Required
SRequired
    , info :: TypeInformation (Unnullify a)
info = TypeInformation (Unnullify a)
forall a. DBType a => TypeInformation a
typeInformation
    , nullity :: Nullity a
nullity = Nullity a
forall a. Nullable a => Nullity a
nullable
    }

  {-# INLINABLE hfield #-}
  {-# INLINABLE htabulate #-}
  {-# INLINABLE htraverse #-}
  {-# INLINABLE hdicts #-}
  {-# INLINABLE hspecs #-}