git.iko.soy/rel8
on 17c67ad help sign in
rel8/src/Rel8/Column/Either.hs
159 lines 4.6 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 )
38type HEither :: K.Context -> Type -> Type -> Type
39type family HEither context where
40 HEither (Reify context) = AHEither context
41 HEither Aggregate = EitherTable
42 HEither Expr = EitherTable
43 HEither Name = EitherTable
44 HEither Result = Either
47type AHEither :: K.Context -> Type -> Type -> Type
48newtype AHEither context a b = AHEither (HEither context a b)
51instance Reifiable context => Bifunctor (AHEither context) where
52 bimap = sbimapEither contextSing
55instance Reifiable context => Functor (AHEither context a) where
56 fmap = bimap id
59instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
60 => Table (Reify context) (AHEither context a b)
61 where
62 type Context (AHEither context a b) = Reify context
63 type Columns (AHEither context a b) = HEitherTable (Columns a) (Columns b)
64 type Unreify (AHEither context a b) = HEither context (Unreify a) (Unreify b)
66 fromColumns = sfromColumnsEither contextSing
67 toColumns = stoColumnsEither contextSing
68 reify proof = liftA2 bimap reify reify proof . AHEither
69 unreify proof = (\(AHEither a) -> a) . liftA2 bimap unreify unreify proof
72instance
73 ( Reifiable context, Reifiable context'
74 , Recontextualize (Reify context) (Reify context') a a'
75 , Recontextualize (Reify context) (Reify context') b b'
76 ) =>
77 Recontextualize
78 (Reify context)
79 (Reify context')
80 (AHEither context a b)
81 (AHEither context' a' b')
84sbimapEither :: ()
85 => SContext context
86 -> (a -> c)
87 -> (b -> d)
88 -> AHEither context a b
89 -> AHEither context c d
90sbimapEither = \case
91 SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)
92 SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)
93 SResult -> \f g (AHEither a) -> AHEither (bimap f g a)
94 SName -> \f g (AHEither a) -> AHEither (bimap f g a)
95 SReify context -> \f g (AHEither a) -> AHEither (sbimapEither context f g a)
98sfromColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
99 => SContext context
100 -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
101 -> AHEither context a b
102sfromColumnsEither = \case
103 SAggregate ->
104 AHEither .
105 bimap (fromColumns . hreify) (fromColumns . hreify) .
106 fromColumns .
107 hunreify
108 SExpr ->
109 AHEither .
110 bimap (fromColumns . hreify) (fromColumns . hreify) .
111 fromColumns .
112 hunreify
113 SResult ->
114 AHEither .
115 bimap (fromColumns . hreify) (fromColumns . hreify) .
116 fromColumns .
117 hunreify
118 SName ->
119 AHEither .
120 bimap (fromColumns . hreify) (fromColumns . hreify) .
121 fromColumns .
122 hunreify
123 SReify context ->
124 AHEither .
125 sbimapEither context (fromColumns . hreify) (fromColumns . hreify) .
126 sfromColumnsEither context .
127 hunreify
130stoColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
131 => SContext context
132 -> AHEither context a b
133 -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
134stoColumnsEither = \case
135 SAggregate ->
136 hreify .
137 toColumns .
138 bimap (hunreify . toColumns) (hunreify . toColumns) .
139 (\(AHEither a) -> a)
140 SExpr ->
141 hreify .
142 toColumns .
143 bimap (hunreify . toColumns) (hunreify . toColumns) .
144 (\(AHEither a) -> a)
145 SResult ->
146 hreify .
147 toColumns .
148 bimap (hunreify . toColumns) (hunreify . toColumns) .
149 (\(AHEither a) -> a)
150 SName ->
151 hreify .
152 toColumns .
153 bimap (hunreify . toColumns) (hunreify . toColumns) .
154 (\(AHEither a) -> a)
155 SReify context ->
156 hreify .
157 stoColumnsEither context .
158 sbimapEither context (hunreify . toColumns) (hunreify . toColumns) .
159 (\(AHEither a) -> a)