content: {-# language FlexibleContexts #-}
  {-# language FlexibleInstances #-}
  {-# language MonoLocalBinds #-}
  {-# language MultiParamTypeClasses #-}
  {-# language StandaloneKindSignatures #-}
  {-# language UndecidableInstances #-}
  
  module Rel8.Table.Projection
    ( Projection
    , Projectable( project )
    , Biprojectable( biproject )
    , Projecting
    , apply
    )
  where
  
  -- base
  import Data.Kind ( Constraint, Type )
  import Prelude
  
  -- rel8
  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 )
  
  
  -- | The constraint @'Projecting' a b@ ensures that @'Projection' a b@ is a
  -- usable 'Projection'.
  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
  
  
  -- | A @'Projection' a b@s is a special type of function @a -> b@ whereby the
  -- resulting @b@ is guaranteed to be composed only from columns contained in
  -- @a@.
  type Projection :: Type -> Type -> Type
  type Projection a b = Transpose (Field a) a -> Transpose (Field a) b
  
  
  -- | @'Projectable' f@ means that @f@ is a kind of functor on 'Rel8.Table's
  -- that allows the mapping of a 'Projection' over its underlying columns.
  type Projectable :: (Type -> Type) -> Constraint
  class Projectable f where
    -- | Map a 'Projection' over @f@.
    project :: Projecting a b
      => Projection a b -> f a -> f b
  
  
  -- | @'Biprojectable' p@ means that @p@ is a kind of bifunctor on
  -- 'Rel8.Table's that allows the mapping of a pair of 'Projection's  over its
  -- underlying columns.
  type Biprojectable :: (Type -> Type -> Type) -> Constraint
  class Biprojectable p where
    -- | Map a pair of 'Projection's over @p@.
    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 f a = case toColumns (f fields) of
    bs -> htabulate $ \field -> case hfield bs field of
      Field field' -> hfield a field'
  