Column.hs

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

module Rel8.Column
  ( Column, AColumn(..)
  , TColumn
  )
where

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

-- rel8
import Rel8.Aggregate ( Aggregate, Col( A ) )
import Rel8.Expr ( Expr, Col( E ) )
import Rel8.FCF ( Eval, Exp )
import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
import qualified Rel8.Schema.Kind as K
import Rel8.Schema.Name ( Name(..), Col( N ) )
import Rel8.Schema.Null ( Sql )
import Rel8.Schema.Reify ( Reify, Col(..) )
import Rel8.Schema.Result ( Col( R ), Result )
import Rel8.Schema.Spec ( Spec( Spec ) )
import Rel8.Table
  ( Table, Columns, Context, fromColumns, toColumns
  , Unreify, reify, unreify
  )
import Rel8.Table.Recontextualize ( Recontextualize )
import Rel8.Type ( DBType )


-- | This type family is used to specify columns in 'Rel8able's. In @Column f
-- a@, @f@ is the context of the column (which should be left polymorphic in
-- 'Rel8able' definitions), and @a@ is the type of the column.
type Column :: K.Context -> Type -> Type
type family Column context a where
  Column (Reify context) a = AColumn context a
  Column Aggregate       a = Aggregate a
  Column Expr            a = Expr a
  Column Name            a = Name a
  Column Result          a = a


type AColumn :: K.Context -> Type -> Type
newtype AColumn context a = AColumn (Column context a)


instance (Reifiable context, Sql DBType a) =>
  Table (Reify context) (AColumn context a)
 where
  type Context (AColumn context a) = Reify context
  type Columns (AColumn context a) = HIdentity ('Spec '[] a)
  type Unreify (AColumn context a) = Column context a

  fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
  toColumns = HIdentity . Reify . stoColumn contextSing
  reify _ = AColumn
  unreify _ (AColumn a) = a


instance
  ( Reifiable context, Reifiable context'
  , Sql DBType a
  ) =>
  Recontextualize
    (Reify context)
    (Reify context')
    (AColumn context a)
    (AColumn context' a)


sfromColumn :: ()
  => SContext context
  -> Col context ('Spec labels a)
  -> AColumn context a
sfromColumn = \case
  SAggregate -> \(A a) -> AColumn a
  SExpr -> \(E a) -> AColumn a
  SName -> \(N a) -> AColumn a
  SResult -> \(R a) -> AColumn a
  SReify context -> \(Reify a) -> AColumn (sfromColumn context a)


stoColumn :: ()
  => SContext context
  -> AColumn context a
  -> Col context ('Spec labels a)
stoColumn = \case
  SAggregate -> \(AColumn a) -> A a
  SExpr -> \(AColumn a) -> E a
  SName -> \(AColumn a) -> N a
  SResult -> \(AColumn a) -> R a
  SReify context -> \(AColumn a) -> Reify (stoColumn context a)


data TColumn :: K.Context -> Type -> Exp Type
type instance Eval (TColumn f a) = Column f a