git.iko.soy/rel8
on db148ff help sign in
rel8/src/Rel8/Column/These.hs
176 lines 4.9 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language GADTs #-}
4{-# language LambdaCase #-}
5{-# language MultiParamTypeClasses #-}
6{-# language StandaloneKindSignatures #-}
7{-# language TypeFamilies #-}
8{-# language UndecidableInstances #-}
10module Rel8.Column.These
11 ( HThese, AHThese(..)
12 )
13where
15-- base
16import Control.Applicative ( liftA2 )
17import Data.Bifunctor ( Bifunctor, bimap )
18import Data.Kind ( Type )
19import Prelude
21-- rel8
22import Rel8.Aggregate ( Aggregate )
23import Rel8.Expr ( Expr )
24import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
25import Rel8.Schema.Context ( Col )
26import Rel8.Schema.HTable.These ( HTheseTable )
27import Rel8.Schema.Insert ( Insert )
28import qualified Rel8.Schema.Kind as K
29import Rel8.Schema.Name ( Name )
30import Rel8.Schema.Reify ( Reify, hreify, hunreify )
31import Rel8.Schema.Result ( Result )
32import Rel8.Table
33 ( Table, Columns, Context, fromColumns, toColumns
34 , Unreify, reify, unreify
35 )
36import Rel8.Table.Recontextualize ( Recontextualize )
37import Rel8.Table.These ( TheseTable )
39-- these
40import Data.These ( These )
43type HThese :: K.Context -> Type -> Type -> Type
44type family HThese context where
45 HThese (Reify context) = AHThese context
46 HThese Aggregate = TheseTable
47 HThese Expr = TheseTable
48 HThese Insert = TheseTable
49 HThese Name = TheseTable
50 HThese Result = These
53type AHThese :: K.Context -> Type -> Type -> Type
54newtype AHThese context a b = AHThese (HThese context a b)
57instance Reifiable context => Bifunctor (AHThese context) where
58 bimap = sbimapThese contextSing
61instance Reifiable context => Functor (AHThese context a) where
62 fmap = bimap id
65instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
66 => Table (Reify context) (AHThese context a b)
67 where
68 type Context (AHThese context a b) = Reify context
69 type Columns (AHThese context a b) = HTheseTable (Columns a) (Columns b)
70 type Unreify (AHThese context a b) = HThese context (Unreify a) (Unreify b)
72 fromColumns = sfromColumnsThese contextSing
73 toColumns = stoColumnsThese contextSing
74 reify proof = liftA2 bimap reify reify proof . AHThese
75 unreify proof = (\(AHThese a) -> a) . liftA2 bimap unreify unreify proof
78instance
79 ( Reifiable context, Reifiable context'
80 , Recontextualize (Reify context) (Reify context') a a'
81 , Recontextualize (Reify context) (Reify context') b b'
82 ) =>
83 Recontextualize
84 (Reify context)
85 (Reify context')
86 (AHThese context a b)
87 (AHThese context' a' b')
90sbimapThese :: ()
91 => SContext context
92 -> (a -> c)
93 -> (b -> d)
94 -> AHThese context a b
95 -> AHThese context c d
96sbimapThese = \case
97 SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)
98 SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)
99 SResult -> \f g (AHThese a) -> AHThese (bimap f g a)
100 SInsert -> \f g (AHThese a) -> AHThese (bimap f g a)
101 SName -> \f g (AHThese a) -> AHThese (bimap f g a)
102 SReify context -> \f g (AHThese a) -> AHThese (sbimapThese context f g a)
105sfromColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
106 => SContext context
107 -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
108 -> AHThese context a b
109sfromColumnsThese = \case
110 SAggregate ->
111 AHThese .
112 bimap (fromColumns . hreify) (fromColumns . hreify) .
113 fromColumns .
114 hunreify
115 SExpr ->
116 AHThese .
117 bimap (fromColumns . hreify) (fromColumns . hreify) .
118 fromColumns .
119 hunreify
120 SResult ->
121 AHThese .
122 bimap (fromColumns . hreify) (fromColumns . hreify) .
123 fromColumns .
124 hunreify
125 SInsert ->
126 AHThese .
127 bimap (fromColumns . hreify) (fromColumns . hreify) .
128 fromColumns .
129 hunreify
130 SName ->
131 AHThese .
132 bimap (fromColumns . hreify) (fromColumns . hreify) .
133 fromColumns .
134 hunreify
135 SReify context ->
136 AHThese .
137 sbimapThese context (fromColumns . hreify) (fromColumns . hreify) .
138 sfromColumnsThese context .
139 hunreify
142stoColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
143 => SContext context
144 -> AHThese context a b
145 -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
146stoColumnsThese = \case
147 SAggregate ->
148 hreify .
149 toColumns .
150 bimap (hunreify . toColumns) (hunreify . toColumns) .
151 (\(AHThese a) -> a)
152 SExpr ->
153 hreify .
154 toColumns .
155 bimap (hunreify . toColumns) (hunreify . toColumns) .
156 (\(AHThese a) -> a)
157 SResult ->
158 hreify .
159 toColumns .
160 bimap (hunreify . toColumns) (hunreify . toColumns) .
161 (\(AHThese a) -> a)
162 SInsert ->
163 hreify .
164 toColumns .
165 bimap (hunreify . toColumns) (hunreify . toColumns) .
166 (\(AHThese a) -> a)
167 SName ->
168 hreify .
169 toColumns .
170 bimap (hunreify . toColumns) (hunreify . toColumns) .
171 (\(AHThese a) -> a)
172 SReify context ->
173 hreify .
174 stoColumnsThese context .
175 sbimapThese context (hunreify . toColumns) (hunreify . toColumns) .
176 (\(AHThese a) -> a)