git.iko.soy/rel8
on da76712 help sign in
rel8/src/Rel8/Table/Projection.hs
73 lines 2.3 kB history raw
1{-# language FlexibleContexts #-}
2{-# language FlexibleInstances #-}
3{-# language MonoLocalBinds #-}
4{-# language MultiParamTypeClasses #-}
5{-# language StandaloneKindSignatures #-}
6{-# language UndecidableInstances #-}
8module Rel8.Table.Projection
9 ( Projection
10 , Projectable( project )
11 , Biprojectable( biproject )
12 , Projecting
13 , apply
14 )
15where
17-- base
18import Data.Kind ( Constraint, Type )
19import Prelude
21-- rel8
22import Rel8.Schema.Field ( Field( Field ), fields )
23import Rel8.Schema.HTable ( hfield, htabulate )
24import Rel8.Table ( Columns, Context, Transpose, toColumns )
25import Rel8.Table.Transpose ( Transposes )
28-- | The constraint @'Projecting' a b@ ensures that @'Projection' a b@ is a
29-- usable 'Projection'.
30type Projecting :: Type -> Type -> Constraint
31class
32 ( Transposes (Context a) (Field a) a (Transpose (Field a) a)
33 , Transposes (Context a) (Field a) b (Transpose (Field a) b)
34 )
35 => Projecting a b
36instance
37 ( Transposes (Context a) (Field a) a (Transpose (Field a) a)
38 , Transposes (Context a) (Field a) b (Transpose (Field a) b)
39 )
40 => Projecting a b
43-- | A @'Projection' a b@s is a special type of function @a -> b@ whereby the
44-- resulting @b@ is guaranteed to be composed only from columns contained in
45-- @a@.
46type Projection :: Type -> Type -> Type
47type Projection a b = Transpose (Field a) a -> Transpose (Field a) b
50-- | @'Projectable' f@ means that @f@ is a kind of functor on 'Rel8.Table's
51-- that allows the mapping of a 'Projection' over its underlying columns.
52type Projectable :: (Type -> Type) -> Constraint
53class Projectable f where
54 -- | Map a 'Projection' over @f@.
55 project :: Projecting a b
56 => Projection a b -> f a -> f b
59-- | @'Biprojectable' p@ means that @p@ is a kind of bifunctor on
60-- 'Rel8.Table's that allows the mapping of a pair of 'Projection's over its
61-- underlying columns.
62type Biprojectable :: (Type -> Type -> Type) -> Constraint
63class Biprojectable p where
64 -- | Map a pair of 'Projection's over @p@.
65 biproject :: (Projecting a b, Projecting c d)
66 => Projection a b -> Projection c d -> p a c -> p b d
69apply :: Projecting a b
70 => Projection a b -> Columns a context -> Columns b context
71apply f a = case toColumns (f fields) of
72 bs -> htabulate $ \field -> case hfield bs field of
73 Field field' -> hfield a field'