{-# language FlexibleContexts #-}
{-# language FlexibleInstances #-}
{-# language MonoLocalBinds #-}
{-# language MultiParamTypeClasses #-}
{-# language StandaloneKindSignatures #-}
{-# language UndecidableInstances #-}
module Rel8.Table.Projection
( Projection
, Projectable( project )
, Biprojectable( biproject )
, Projecting
, apply
)
where
import Data.Kind ( Constraint, Type )
import Prelude
import Rel8.Schema.Field ( Field( Field ), fields )
import Rel8.Schema.HTable ( hfield, htabulate )
import Rel8.Table ( Columns, Context, Transpose, toColumns )
import Rel8.Table.Transpose ( Transposes )
type Projecting :: Type -> Type -> Constraint
class
( Transposes (Context a) (Field a) a (Transpose (Field a) a)
, Transposes (Context a) (Field a) b (Transpose (Field a) b)
)
=> Projecting a b
instance
( Transposes (Context a) (Field a) a (Transpose (Field a) a)
, Transposes (Context a) (Field a) b (Transpose (Field a) b)
)
=> Projecting a b
type Projection :: Type -> Type -> Type
type Projection a b = Transpose (Field a) a -> Transpose (Field a) b
type Projectable :: (Type -> Type) -> Constraint
class Projectable f where
project :: Projecting a b
=> Projection a b -> f a -> f b
type Biprojectable :: (Type -> Type -> Type) -> Constraint
class Biprojectable p where
biproject :: (Projecting a b, Projecting c d)
=> Projection a b -> Projection c d -> p a c -> p b d
apply :: Projecting a b
=> Projection a b -> Columns a context -> Columns b context
apply :: forall a b (context :: Context).
Projecting a b =>
Projection a b -> Columns a context -> Columns b context
apply Projection a b
f Columns a context
a = case forall (context :: Context) a.
Table context a =>
a -> Columns a context
toColumns (Projection a b
f forall (context :: Context) table fields.
Transposes context (Field table) table fields =>
fields
fields) of
Columns (Transpose (Field a) b) (Field a)
bs -> forall (t :: HTable) (context :: Context).
HTable t =>
(forall a. HField t a -> context a) -> t context
htabulate forall a b. (a -> b) -> a -> b
$ \HField (Columns b) a
field -> case forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns (Transpose (Field a) b) (Field a)
bs HField (Columns b) a
field of
Field HField (Columns a) a
field' -> forall (t :: HTable) (context :: Context) a.
HTable t =>
t context -> HField t a -> context a
hfield Columns a context
a HField (Columns a) a
field'