git.iko.soy/rel8
on 137ebed help sign in
rel8/src/Rel8/Column/These.hs
166 lines 4.7 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 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.Recontextualize ( Recontextualize )
36import Rel8.Table.These ( TheseTable )
38-- these
39import Data.These ( These )
42-- | Nest an 'These' value within a 'Rel8able'. @HThese f a b@ will produce a
43-- 'TheseTable' @a b@ in the 'Expr' context, and a 'These' @a b@ in the
44-- 'Result' context.
45type HThese :: K.Context -> Type -> Type -> Type
46type family HThese context where
47 HThese (Reify context) = AHThese context
48 HThese Aggregate = TheseTable
49 HThese Expr = TheseTable
50 HThese Name = TheseTable
51 HThese Result = These
54type AHThese :: K.Context -> Type -> Type -> Type
55newtype AHThese context a b = AHThese (HThese context a b)
58instance Reifiable context => Bifunctor (AHThese context) where
59 bimap = sbimapThese contextSing
62instance Reifiable context => Functor (AHThese context a) where
63 fmap = bimap id
66instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
67 => Table (Reify context) (AHThese context a b)
68 where
69 type Context (AHThese context a b) = Reify context
70 type Columns (AHThese context a b) = HTheseTable (Columns a) (Columns b)
71 type Unreify (AHThese context a b) = HThese context (Unreify a) (Unreify b)
73 fromColumns = sfromColumnsThese contextSing
74 toColumns = stoColumnsThese contextSing
75 reify proof = liftA2 bimap reify reify proof . AHThese
76 unreify proof = (\(AHThese a) -> a) . liftA2 bimap unreify unreify proof
79instance
80 ( Reifiable context, Reifiable context'
81 , Recontextualize (Reify context) (Reify context') a a'
82 , Recontextualize (Reify context) (Reify context') b b'
83 ) =>
84 Recontextualize
85 (Reify context)
86 (Reify context')
87 (AHThese context a b)
88 (AHThese context' a' b')
91sbimapThese :: ()
92 => SContext context
93 -> (a -> c)
94 -> (b -> d)
95 -> AHThese context a b
96 -> AHThese context c d
97sbimapThese = \case
98 SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)
99 SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)
100 SResult -> \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 SName ->
126 AHThese .
127 bimap (fromColumns . hreify) (fromColumns . hreify) .
128 fromColumns .
129 hunreify
130 SReify context ->
131 AHThese .
132 sbimapThese context (fromColumns . hreify) (fromColumns . hreify) .
133 sfromColumnsThese context .
134 hunreify
137stoColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
138 => SContext context
139 -> AHThese context a b
140 -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
141stoColumnsThese = \case
142 SAggregate ->
143 hreify .
144 toColumns .
145 bimap (hunreify . toColumns) (hunreify . toColumns) .
146 (\(AHThese a) -> a)
147 SExpr ->
148 hreify .
149 toColumns .
150 bimap (hunreify . toColumns) (hunreify . toColumns) .
151 (\(AHThese a) -> a)
152 SResult ->
153 hreify .
154 toColumns .
155 bimap (hunreify . toColumns) (hunreify . toColumns) .
156 (\(AHThese a) -> a)
157 SName ->
158 hreify .
159 toColumns .
160 bimap (hunreify . toColumns) (hunreify . toColumns) .
161 (\(AHThese a) -> a)
162 SReify context ->
163 hreify .
164 stoColumnsThese context .
165 sbimapThese context (hunreify . toColumns) (hunreify . toColumns) .
166 (\(AHThese a) -> a)