git.iko.soy/rel8
on da86165 help sign in
rel8/src/Rel8/Column/These.hs
163 lines 4.6 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 )
42type HThese :: K.Context -> Type -> Type -> Type
43type family HThese context where
44 HThese (Reify context) = AHThese context
45 HThese Aggregate = TheseTable
46 HThese Expr = TheseTable
47 HThese Name = TheseTable
48 HThese Result = These
51type AHThese :: K.Context -> Type -> Type -> Type
52newtype AHThese context a b = AHThese (HThese context a b)
55instance Reifiable context => Bifunctor (AHThese context) where
56 bimap = sbimapThese contextSing
59instance Reifiable context => Functor (AHThese context a) where
60 fmap = bimap id
63instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
64 => Table (Reify context) (AHThese context a b)
65 where
66 type Context (AHThese context a b) = Reify context
67 type Columns (AHThese context a b) = HTheseTable (Columns a) (Columns b)
68 type Unreify (AHThese context a b) = HThese context (Unreify a) (Unreify b)
70 fromColumns = sfromColumnsThese contextSing
71 toColumns = stoColumnsThese contextSing
72 reify proof = liftA2 bimap reify reify proof . AHThese
73 unreify proof = (\(AHThese a) -> a) . liftA2 bimap unreify unreify proof
76instance
77 ( Reifiable context, Reifiable context'
78 , Recontextualize (Reify context) (Reify context') a a'
79 , Recontextualize (Reify context) (Reify context') b b'
80 ) =>
81 Recontextualize
82 (Reify context)
83 (Reify context')
84 (AHThese context a b)
85 (AHThese context' a' b')
88sbimapThese :: ()
89 => SContext context
90 -> (a -> c)
91 -> (b -> d)
92 -> AHThese context a b
93 -> AHThese context c d
94sbimapThese = \case
95 SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)
96 SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)
97 SResult -> \f g (AHThese a) -> AHThese (bimap f g a)
98 SName -> \f g (AHThese a) -> AHThese (bimap f g a)
99 SReify context -> \f g (AHThese a) -> AHThese (sbimapThese context f g a)
102sfromColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
103 => SContext context
104 -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
105 -> AHThese context a b
106sfromColumnsThese = \case
107 SAggregate ->
108 AHThese .
109 bimap (fromColumns . hreify) (fromColumns . hreify) .
110 fromColumns .
111 hunreify
112 SExpr ->
113 AHThese .
114 bimap (fromColumns . hreify) (fromColumns . hreify) .
115 fromColumns .
116 hunreify
117 SResult ->
118 AHThese .
119 bimap (fromColumns . hreify) (fromColumns . hreify) .
120 fromColumns .
121 hunreify
122 SName ->
123 AHThese .
124 bimap (fromColumns . hreify) (fromColumns . hreify) .
125 fromColumns .
126 hunreify
127 SReify context ->
128 AHThese .
129 sbimapThese context (fromColumns . hreify) (fromColumns . hreify) .
130 sfromColumnsThese context .
131 hunreify
134stoColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
135 => SContext context
136 -> AHThese context a b
137 -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
138stoColumnsThese = \case
139 SAggregate ->
140 hreify .
141 toColumns .
142 bimap (hunreify . toColumns) (hunreify . toColumns) .
143 (\(AHThese a) -> a)
144 SExpr ->
145 hreify .
146 toColumns .
147 bimap (hunreify . toColumns) (hunreify . toColumns) .
148 (\(AHThese a) -> a)
149 SResult ->
150 hreify .
151 toColumns .
152 bimap (hunreify . toColumns) (hunreify . toColumns) .
153 (\(AHThese a) -> a)
154 SName ->
155 hreify .
156 toColumns .
157 bimap (hunreify . toColumns) (hunreify . toColumns) .
158 (\(AHThese a) -> a)
159 SReify context ->
160 hreify .
161 stoColumnsThese context .
162 sbimapThese context (hunreify . toColumns) (hunreify . toColumns) .
163 (\(AHThese a) -> a)