git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Column/Either.hs
172 lines 5.0 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 Rel8.Schema.Insert ( Insert )
27import qualified Rel8.Schema.Kind as K
28import Rel8.Schema.Name ( Name(..) )
29import Rel8.Schema.Reify ( Reify, hreify, hunreify )
30import Rel8.Schema.Result ( Result )
31import Rel8.Table
32 ( Table, Columns, Context, fromColumns, toColumns
33 , Unreify, reify, unreify
34 )
35import Rel8.Table.Either ( EitherTable )
36import Rel8.Table.Recontextualize ( Recontextualize )
39type HEither :: K.Context -> Type -> Type -> Type
40type family HEither context where
41 HEither (Reify context) = AHEither context
42 HEither Aggregate = EitherTable
43 HEither Expr = EitherTable
44 HEither Insert = EitherTable
45 HEither Name = EitherTable
46 HEither Result = Either
49type AHEither :: K.Context -> Type -> Type -> Type
50newtype AHEither context a b = AHEither (HEither context a b)
53instance Reifiable context => Bifunctor (AHEither context) where
54 bimap = sbimapEither contextSing
57instance Reifiable context => Functor (AHEither context a) where
58 fmap = bimap id
61instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
62 => Table (Reify context) (AHEither context a b)
63 where
64 type Context (AHEither context a b) = Reify context
65 type Columns (AHEither context a b) = HEitherTable (Columns a) (Columns b)
66 type Unreify (AHEither context a b) = HEither context (Unreify a) (Unreify b)
68 fromColumns = sfromColumnsEither contextSing
69 toColumns = stoColumnsEither contextSing
70 reify proof = liftA2 bimap reify reify proof . AHEither
71 unreify proof = (\(AHEither a) -> a) . liftA2 bimap unreify unreify proof
74instance
75 ( Reifiable context, Reifiable context'
76 , Recontextualize (Reify context) (Reify context') a a'
77 , Recontextualize (Reify context) (Reify context') b b'
78 ) =>
79 Recontextualize
80 (Reify context)
81 (Reify context')
82 (AHEither context a b)
83 (AHEither context' a' b')
86sbimapEither :: ()
87 => SContext context
88 -> (a -> c)
89 -> (b -> d)
90 -> AHEither context a b
91 -> AHEither context c d
92sbimapEither = \case
93 SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)
94 SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)
95 SResult -> \f g (AHEither a) -> AHEither (bimap f g a)
96 SInsert -> \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 SInsert ->
122 AHEither .
123 bimap (fromColumns . hreify) (fromColumns . hreify) .
124 fromColumns .
125 hunreify
126 SName ->
127 AHEither .
128 bimap (fromColumns . hreify) (fromColumns . hreify) .
129 fromColumns .
130 hunreify
131 SReify context ->
132 AHEither .
133 sbimapEither context (fromColumns . hreify) (fromColumns . hreify) .
134 sfromColumnsEither context .
135 hunreify
138stoColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
139 => SContext context
140 -> AHEither context a b
141 -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
142stoColumnsEither = \case
143 SAggregate ->
144 hreify .
145 toColumns .
146 bimap (hunreify . toColumns) (hunreify . toColumns) .
147 (\(AHEither a) -> a)
148 SExpr ->
149 hreify .
150 toColumns .
151 bimap (hunreify . toColumns) (hunreify . toColumns) .
152 (\(AHEither a) -> a)
153 SResult ->
154 hreify .
155 toColumns .
156 bimap (hunreify . toColumns) (hunreify . toColumns) .
157 (\(AHEither a) -> a)
158 SInsert ->
159 hreify .
160 toColumns .
161 bimap (hunreify . toColumns) (hunreify . toColumns) .
162 (\(AHEither a) -> a)
163 SName ->
164 hreify .
165 toColumns .
166 bimap (hunreify . toColumns) (hunreify . toColumns) .
167 (\(AHEither a) -> a)
168 SReify context ->
169 hreify .
170 stoColumnsEither context .
171 sbimapEither context (hunreify . toColumns) (hunreify . toColumns) .
172 (\(AHEither a) -> a)