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

module Rel8.Schema.Field
  ( Field(..)
  , fields
  )
where

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

-- rel8
import Rel8.Schema.HTable ( HField, htabulate )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import Rel8.Schema.Kind as K
import Rel8.Schema.Null ( Sql )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  , FromExprs, fromResult, toResult
  , Transpose
  )
import Rel8.Table.Transpose ( Transposes )
import Rel8.Type ( DBType )


-- | A special context used in the construction of 'Rel8.Projection's.
type Field :: Type -> K.Context
newtype Field table a = Field (HField (Columns table) a)


instance Sql DBType a => Table (Field table) (Field table a) where
  type Columns (Field table a) = HIdentity a
  type Context (Field table a) = Field table
  type FromExprs (Field table a) = a
  type Transpose to (Field table a) = to a

  toColumns :: Field table a -> Columns (Field table a) (Field table)
toColumns = Field table a -> Columns (Field table a) (Field table)
forall a (context :: Context). context a -> HIdentity a context
HIdentity
  fromColumns :: Columns (Field table a) (Field table) -> Field table a
fromColumns (HIdentity a) = Field table a
a
  toResult :: FromExprs (Field table a) -> Columns (Field table a) Result
toResult FromExprs (Field table a)
a = Identity a -> HIdentity a Result
forall a (context :: Context). context a -> HIdentity a context
HIdentity (a -> Identity a
forall a. a -> Identity a
Identity a
FromExprs (Field table a)
a)
  fromResult :: Columns (Field table a) Result -> FromExprs (Field table a)
fromResult (HIdentity (Identity a)) = a
FromExprs (Field table a)
a


fields :: Transposes context (Field table) table fields => fields
fields :: fields
fields = Columns fields (Field table) -> fields
forall (context :: Context) a.
Table context a =>
Columns a context -> a
fromColumns (Columns fields (Field table) -> fields)
-> Columns fields (Field table) -> fields
forall a b. (a -> b) -> a -> b
$ (forall a. HField (Columns fields) a -> Field table a)
-> Columns fields (Field table)
forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate forall a. HField (Columns fields) a -> Field table a
forall table a. HField (Columns table) a -> Field table a
Field