git.iko.soy/rel8
on 137ebed help sign in
rel8/src/Rel8/Column/Either.hs
162 lines 4.8 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language LambdaCase #-}
4{-# language MultiParamTypeClasses #-}
5{-# language StandaloneKindSignatures #-}
6{-# language TypeFamilies #-}
7{-# language UndecidableInstances #-}
9module Rel8.Column.Either
10 ( HEither, AHEither(..)
11 )
12where
14-- base
15import Control.Applicative ( liftA2 )
16import Data.Bifunctor ( Bifunctor, bimap )
17import Data.Kind ( Type )
18import Prelude
20-- rel8
21import Rel8.Aggregate ( Aggregate )
22import Rel8.Expr ( Expr )
23import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
24import Rel8.Schema.Context ( Col )
25import Rel8.Schema.HTable.Either ( HEitherTable )
26import qualified Rel8.Schema.Kind as K
27import Rel8.Schema.Name ( Name(..) )
28import Rel8.Schema.Reify ( Reify, hreify, hunreify )
29import Rel8.Schema.Result ( Result )
30import Rel8.Table
31 ( Table, Columns, Context, fromColumns, toColumns
32 , Unreify, reify, unreify
33 )
34import Rel8.Table.Either ( EitherTable )
35import Rel8.Table.Recontextualize ( Recontextualize )
38-- | Nest an 'Either' value within a 'Rel8able'. @HEither f a b@ will produce a
39-- 'EitherTable' @a b@ in the 'Expr' context, and a 'Either' @a b@ in the
40-- 'Result' context.
41type HEither :: K.Context -> Type -> Type -> Type
42type family HEither context where
43 HEither (Reify context) = AHEither context
44 HEither Aggregate = EitherTable
45 HEither Expr = EitherTable
46 HEither Name = EitherTable
47 HEither Result = Either
50type AHEither :: K.Context -> Type -> Type -> Type
51newtype AHEither context a b = AHEither (HEither context a b)
54instance Reifiable context => Bifunctor (AHEither context) where
55 bimap = sbimapEither contextSing
58instance Reifiable context => Functor (AHEither context a) where
59 fmap = bimap id
62instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
63 => Table (Reify context) (AHEither context a b)
64 where
65 type Context (AHEither context a b) = Reify context
66 type Columns (AHEither context a b) = HEitherTable (Columns a) (Columns b)
67 type Unreify (AHEither context a b) = HEither context (Unreify a) (Unreify b)
69 fromColumns = sfromColumnsEither contextSing
70 toColumns = stoColumnsEither contextSing
71 reify proof = liftA2 bimap reify reify proof . AHEither
72 unreify proof = (\(AHEither a) -> a) . liftA2 bimap unreify unreify proof
75instance
76 ( Reifiable context, Reifiable context'
77 , Recontextualize (Reify context) (Reify context') a a'
78 , Recontextualize (Reify context) (Reify context') b b'
79 ) =>
80 Recontextualize
81 (Reify context)
82 (Reify context')
83 (AHEither context a b)
84 (AHEither context' a' b')
87sbimapEither :: ()
88 => SContext context
89 -> (a -> c)
90 -> (b -> d)
91 -> AHEither context a b
92 -> AHEither context c d
93sbimapEither = \case
94 SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)
95 SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)
96 SResult -> \f g (AHEither a) -> AHEither (bimap f g a)
97 SName -> \f g (AHEither a) -> AHEither (bimap f g a)
98 SReify context -> \f g (AHEither a) -> AHEither (sbimapEither context f g a)
101sfromColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
102 => SContext context
103 -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
104 -> AHEither context a b
105sfromColumnsEither = \case
106 SAggregate ->
107 AHEither .
108 bimap (fromColumns . hreify) (fromColumns . hreify) .
109 fromColumns .
110 hunreify
111 SExpr ->
112 AHEither .
113 bimap (fromColumns . hreify) (fromColumns . hreify) .
114 fromColumns .
115 hunreify
116 SResult ->
117 AHEither .
118 bimap (fromColumns . hreify) (fromColumns . hreify) .
119 fromColumns .
120 hunreify
121 SName ->
122 AHEither .
123 bimap (fromColumns . hreify) (fromColumns . hreify) .
124 fromColumns .
125 hunreify
126 SReify context ->
127 AHEither .
128 sbimapEither context (fromColumns . hreify) (fromColumns . hreify) .
129 sfromColumnsEither context .
130 hunreify
133stoColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
134 => SContext context
135 -> AHEither context a b
136 -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
137stoColumnsEither = \case
138 SAggregate ->
139 hreify .
140 toColumns .
141 bimap (hunreify . toColumns) (hunreify . toColumns) .
142 (\(AHEither a) -> a)
143 SExpr ->
144 hreify .
145 toColumns .
146 bimap (hunreify . toColumns) (hunreify . toColumns) .
147 (\(AHEither a) -> a)
148 SResult ->
149 hreify .
150 toColumns .
151 bimap (hunreify . toColumns) (hunreify . toColumns) .
152 (\(AHEither a) -> a)
153 SName ->
154 hreify .
155 toColumns .
156 bimap (hunreify . toColumns) (hunreify . toColumns) .
157 (\(AHEither a) -> a)
158 SReify context ->
159 hreify .
160 stoColumnsEither context .
161 sbimapEither context (hunreify . toColumns) (hunreify . toColumns) .
162 (\(AHEither a) -> a)