git.iko.soy/rel8
on master help sign in
Unfold Rel8.Schema.Field into Rel8.Column.*
95a2ebfShane O'Brien
rel8.cabal+8−2
compare with master
unifiedsplit
@@ -49,6 +49,14 @@ library
49 other-modules:
49 other-modules:
50 Rel8.Aggregate
50 Rel8.Aggregate
51
51
52+ Rel8.Column
53+ Rel8.Column.Either
54+ Rel8.Column.Field
55+ Rel8.Column.List
56+ Rel8.Column.Maybe
57+ Rel8.Column.NonEmpty
58+ Rel8.Column.These
59+
52 Rel8.Expr
60 Rel8.Expr
53 Rel8.Expr.Aggregate
61 Rel8.Expr.Aggregate
54 Rel8.Expr.Array
62 Rel8.Expr.Array
@@ -97,12 +105,10 @@ library
97 Rel8.Query.These
105 Rel8.Query.These
98 Rel8.Query.Values
106 Rel8.Query.Values
99
107
100− Rel8.Schema.Column
101 Rel8.Schema.Context
108 Rel8.Schema.Context
102 Rel8.Schema.Context.Label
109 Rel8.Schema.Context.Label
103 Rel8.Schema.Context.Nullify
110 Rel8.Schema.Context.Nullify
104 Rel8.Schema.Dict
111 Rel8.Schema.Dict
105− Rel8.Schema.Field
106 Rel8.Schema.HKD
112 Rel8.Schema.HKD
107 Rel8.Schema.HTable
113 Rel8.Schema.HTable
108 Rel8.Schema.HTable.Either
114 Rel8.Schema.HTable.Either
src/Rel8.hs+7−2
@@ -250,6 +250,13 @@ import Prelude ()
250
250
251-- rel8
251-- rel8
252import Rel8.Aggregate
252import Rel8.Aggregate
253+import Rel8.Column
254+import Rel8.Column.Either
255+import Rel8.Column.Field
256+import Rel8.Column.List
257+import Rel8.Column.Maybe
258+import Rel8.Column.NonEmpty
259+import Rel8.Column.These
253import Rel8.Expr
260import Rel8.Expr
254import Rel8.Expr.Aggregate
261import Rel8.Expr.Aggregate
255import Rel8.Expr.Bool
262import Rel8.Expr.Bool
@@ -279,9 +286,7 @@ import Rel8.Query.SQL (showQuery)
279import Rel8.Query.Set
286import Rel8.Query.Set
280import Rel8.Query.These
287import Rel8.Query.These
281import Rel8.Query.Values
288import Rel8.Query.Values
282−import Rel8.Schema.Column
283import Rel8.Schema.Context.Label
289import Rel8.Schema.Context.Label
284−import Rel8.Schema.Field
285import Rel8.Schema.HKD
290import Rel8.Schema.HKD
286import Rel8.Schema.HTable
291import Rel8.Schema.HTable
287import Rel8.Schema.Name
292import Rel8.Schema.Name
src/Rel8/Schema/Column.hs → src/Rel8/Column.hsrenamed+2−2
@@ -2,7 +2,7 @@
2{-# language TypeFamilies #-}
2{-# language TypeFamilies #-}
3{-# language StandaloneKindSignatures #-}
3{-# language StandaloneKindSignatures #-}
4
4
5−module Rel8.Schema.Column
5+module Rel8.Column
6 ( Column, Default
6 ( Column, Default
7 )
7 )
8where
8where
@@ -12,8 +12,8 @@ import Data.Kind ( Type )
12import Prelude ()
12import Prelude ()
13
13
14-- rel8
14-- rel8
15+import Rel8.Column.Field ( Field )
15import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
16import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
16−import Rel8.Schema.Field ( Field )
17import qualified Rel8.Schema.Kind as K
17import qualified Rel8.Schema.Kind as K
18
18
19
19
src/Rel8/Column/Either.hsnew file+172
@@ -0,0 +1,172 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleContexts #-}
3+{-# language LambdaCase #-}
4+{-# language MultiParamTypeClasses #-}
5+{-# language StandaloneKindSignatures #-}
6+{-# language TypeFamilies #-}
7+{-# language UndecidableInstances #-}
8+
9+module Rel8.Column.Either
10+ ( HEither, AHEither(..)
11+ )
12+where
13+
14+-- base
15+import Control.Applicative ( liftA2 )
16+import Data.Bifunctor ( Bifunctor, bimap )
17+import Data.Kind ( Type )
18+import Prelude
19+
20+-- rel8
21+import Rel8.Aggregate ( Aggregate )
22+import Rel8.Expr ( Expr )
23+import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
24+import Rel8.Schema.Context ( Col )
25+import Rel8.Schema.HTable.Either ( HEitherTable )
26+import Rel8.Schema.Insert ( Insert )
27+import qualified Rel8.Schema.Kind as K
28+import Rel8.Schema.Name ( Name(..) )
29+import Rel8.Schema.Reify ( Reify, hreify, hunreify )
30+import Rel8.Schema.Result ( Result )
31+import Rel8.Table
32+ ( Table, Columns, Context, fromColumns, toColumns
33+ , Unreify, reify, unreify
34+ )
35+import Rel8.Table.Either ( EitherTable )
36+import Rel8.Table.Recontextualize ( Recontextualize )
37+
38+
39+type HEither :: K.Context -> Type -> Type -> Type
40+type 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
47+
48+
49+type AHEither :: K.Context -> Type -> Type -> Type
50+newtype AHEither context a b = AHEither (HEither context a b)
51+
52+
53+instance Reifiable context => Bifunctor (AHEither context) where
54+ bimap = sbimapEither contextSing
55+
56+
57+instance Reifiable context => Functor (AHEither context a) where
58+ fmap = bimap id
59+
60+
61+instance (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)
67+
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
72+
73+
74+instance
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')
84+
85+
86+sbimapEither :: ()
87+ => SContext context
88+ -> (a -> c)
89+ -> (b -> d)
90+ -> AHEither context a b
91+ -> AHEither context c d
92+sbimapEither = \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)
99+
100+
101+sfromColumnsEither :: (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
105+sfromColumnsEither = \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
136+
137+
138+stoColumnsEither :: (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))
142+stoColumnsEither = \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)
src/Rel8/Column/Field.hsnew file+110
@@ -0,0 +1,110 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleContexts #-}
3+{-# language LambdaCase #-}
4+{-# language MultiParamTypeClasses #-}
5+{-# language StandaloneKindSignatures #-}
6+{-# language TypeFamilies #-}
7+
8+module Rel8.Column.Field
9+ ( Field, AField(..)
10+ )
11+where
12+
13+-- base
14+import Data.Kind ( Type )
15+import Prelude
16+
17+-- rel8
18+import Rel8.Aggregate ( Aggregate, Col(..) )
19+import Rel8.Expr ( Expr, Col(..) )
20+import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
21+import Rel8.Kind.Necessity
22+ ( Necessity( Required, Optional )
23+ , SNecessity( SRequired, SOptional )
24+ , KnownNecessity, necessitySing
25+ )
26+import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
27+import Rel8.Schema.Insert ( Insert, Col(..) )
28+import qualified Rel8.Schema.Kind as K
29+import Rel8.Schema.Name ( Name(..), Col(..) )
30+import Rel8.Schema.Null ( Sql )
31+import Rel8.Schema.Reify ( Reify, Col(..) )
32+import Rel8.Schema.Result ( Col( Result ), Result )
33+import Rel8.Schema.Spec ( Spec( Spec ) )
34+import Rel8.Table
35+ ( Table, Columns, Context, fromColumns, toColumns
36+ , Unreify, reify, unreify
37+ )
38+import Rel8.Table.Recontextualize ( Recontextualize )
39+import Rel8.Type ( DBType )
40+
41+
42+type Field :: K.Context -> Necessity -> Type -> Type
43+type family Field context necessity a where
44+ Field (Reify context) necessity a = AField context necessity a
45+ Field Aggregate _necessity a = Aggregate (Expr a)
46+ Field Expr _necessity a = Expr a
47+ Field Insert 'Required a = Expr a
48+ Field Insert 'Optional a = Maybe (Expr a)
49+ Field Name _necessity a = Name a
50+ Field Result _necessity a = a
51+
52+
53+type AField :: K.Context -> Necessity -> Type -> Type
54+newtype AField context necessity a = AField (Field context necessity a)
55+
56+
57+instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>
58+ Table (Reify context) (AField context necessity a)
59+ where
60+ type Context (AField context necessity a) = Reify context
61+ type Columns (AField context necessity a) = HIdentity ('Spec '[""] necessity a)
62+ type Unreify (AField context necessity a) = Field context necessity a
63+
64+ fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
65+ toColumns = HIdentity . Reify . stoColumn contextSing necessitySing
66+ reify _ = AField
67+ unreify _ (AField a) = a
68+
69+
70+instance
71+ ( Reifiable context, Reifiable context'
72+ , KnownNecessity necessity, Sql DBType a
73+ ) =>
74+ Recontextualize
75+ (Reify context)
76+ (Reify context')
77+ (AField context necessity a)
78+ (AField context' necessity a)
79+
80+
81+sfromColumn :: ()
82+ => SContext context
83+ -> Col context ('Spec labels necessity a)
84+ -> AField context necessity a
85+sfromColumn = \case
86+ SAggregate -> \(Aggregation a) -> AField a
87+ SExpr -> \(DB a) -> AField a
88+ SResult -> \(Result a) -> AField a
89+ SInsert -> \case
90+ RequiredInsert a -> AField a
91+ OptionalInsert a -> AField a
92+ SName -> \(NameCol a) -> AField (Name a)
93+ SReify context -> \(Reify a) -> AField (sfromColumn context a)
94+
95+
96+stoColumn :: ()
97+ => SContext context
98+ -> SNecessity necessity
99+ -> AField context necessity a
100+ -> Col context ('Spec labels necessity a)
101+stoColumn = \case
102+ SAggregate -> \_ (AField a) -> Aggregation a
103+ SExpr -> \_ (AField a) -> DB a
104+ SResult -> \_ (AField a) -> Result a
105+ SInsert -> \case
106+ SRequired -> \(AField a) -> RequiredInsert a
107+ SOptional -> \(AField a) -> OptionalInsert a
108+ SName -> \_ (AField (Name a)) -> NameCol a
109+ SReify context ->
110+ \necessity (AField a) -> Reify (stoColumn context necessity a)
src/Rel8/Column/List.hsnew file+133
@@ -0,0 +1,133 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleContexts #-}
3+{-# language GADTs #-}
4+{-# language LambdaCase #-}
5+{-# language MultiParamTypeClasses #-}
6+{-# language StandaloneKindSignatures #-}
7+{-# language TypeFamilies #-}
8+{-# language UndecidableInstances #-}
9+
10+module Rel8.Column.List
11+ ( HList, AHList(..)
12+ )
13+where
14+
15+-- base
16+import Data.Kind ( Type )
17+import Prelude
18+
19+-- rel8
20+import Rel8.Aggregate ( Aggregate )
21+import Rel8.Expr ( Expr )
22+import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
23+import Rel8.Schema.Context ( Col )
24+import Rel8.Schema.HTable.List ( HListTable )
25+import Rel8.Schema.Insert ( Insert )
26+import qualified Rel8.Schema.Kind as K
27+import Rel8.Schema.Name ( Name )
28+import Rel8.Schema.Reify ( Reify, hreify, hunreify )
29+import Rel8.Schema.Result ( Result )
30+import Rel8.Table
31+ ( Table, Columns, Congruent, Context, fromColumns, toColumns
32+ , Unreify, reify, unreify
33+ )
34+import Rel8.Table.List ( ListTable( ListTable ) )
35+import Rel8.Table.Recontextualize ( Recontextualize )
36+import Rel8.Table.Unreify ( Unreifiable )
37+
38+
39+type HList :: K.Context -> Type -> Type
40+type family HList context where
41+ HList (Reify context) = AHList context
42+ HList Aggregate = ListTable
43+ HList Expr = ListTable
44+ HList Insert = ListTable
45+ HList Name = ListTable
46+ HList Result = []
47+
48+
49+type AHList :: K.Context -> Type -> Type
50+newtype AHList context a = AHList (HList context a)
51+
52+
53+instance
54+ ( Reifiable context
55+ , Table (Reify context) a
56+ , Unreifiable (Reify context) a
57+ )
58+ => Table (Reify context) (AHList context a)
59+ where
60+ type Context (AHList context a) = Reify context
61+ type Columns (AHList context a) = HListTable (Columns a)
62+ type Unreify (AHList context a) = HList context (Unreify a)
63+
64+ fromColumns = sfromColumnsList contextSing
65+ toColumns = stoColumnsList contextSing
66+ reify proof =
67+ smapList contextSing (reify proof) hreify .
68+ AHList
69+ unreify proof =
70+ (\(AHList a) -> a) .
71+ smapList contextSing (unreify proof) hunreify
72+
73+
74+instance
75+ ( Reifiable context, Reifiable context'
76+ , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
77+ , Recontextualize (Reify context) (Reify context') a a'
78+ ) =>
79+ Recontextualize
80+ (Reify context)
81+ (Reify context')
82+ (AHList context a)
83+ (AHList context' a')
84+
85+
86+smapList :: Congruent a b
87+ => SContext context
88+ -> (a -> b)
89+ -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b)))
90+ -> AHList context a
91+ -> AHList context b
92+smapList = \case
93+ SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
94+ SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
95+ SResult -> \f _ (AHList as) -> AHList (fmap f as)
96+ SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
97+ SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
98+ SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
99+
100+
101+sfromColumnsList :: Table (Reify context) a
102+ => SContext context
103+ -> HListTable (Columns a) (Col (Reify context))
104+ -> AHList context a
105+sfromColumnsList = \case
106+ SAggregate -> AHList . ListTable
107+ SExpr -> AHList . ListTable
108+ SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
109+ SInsert -> AHList . ListTable
110+ SName -> AHList . ListTable
111+ SReify context ->
112+ AHList .
113+ smapList context (fromColumns . hreify) hreify .
114+ sfromColumnsList context .
115+ hunreify
116+
117+
118+stoColumnsList :: Table (Reify context) a
119+ => SContext context
120+ -> AHList context a
121+ -> HListTable (Columns a) (Col (Reify context))
122+stoColumnsList = \case
123+ SAggregate -> \(AHList (ListTable a)) -> a
124+ SExpr -> \(AHList (ListTable a)) -> a
125+ SResult ->
126+ hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
127+ SInsert -> \(AHList (ListTable a)) -> a
128+ SName -> \(AHList (ListTable a)) -> a
129+ SReify context ->
130+ hreify .
131+ stoColumnsList context .
132+ smapList context (hunreify . toColumns) hunreify .
133+ (\(AHList a) -> a)
src/Rel8/Column/Maybe.hsnew file+130
@@ -0,0 +1,130 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleContexts #-}
3+{-# language GADTs #-}
4+{-# language LambdaCase #-}
5+{-# language MultiParamTypeClasses #-}
6+{-# language StandaloneKindSignatures #-}
7+{-# language TypeFamilies #-}
8+{-# language UndecidableInstances #-}
9+
10+module Rel8.Column.Maybe
11+ ( HMaybe, AHMaybe(..)
12+ )
13+where
14+
15+-- base
16+import Data.Kind ( Type )
17+import Prelude
18+
19+-- rel8
20+import Rel8.Aggregate ( Aggregate )
21+import Rel8.Expr ( Expr )
22+import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
23+import Rel8.Schema.Context ( Col )
24+import Rel8.Schema.HTable.Maybe ( HMaybeTable )
25+import Rel8.Schema.Insert ( Insert )
26+import qualified Rel8.Schema.Kind as K
27+import Rel8.Schema.Name ( Name )
28+import Rel8.Schema.Reify ( Reify, hreify, hunreify )
29+import Rel8.Schema.Result ( Result )
30+import Rel8.Table
31+ ( Table, Columns, Context, fromColumns, toColumns
32+ , Unreify, reify, unreify
33+ )
34+import Rel8.Table.Maybe ( MaybeTable )
35+import Rel8.Table.Recontextualize ( Recontextualize )
36+
37+
38+type HMaybe :: K.Context -> Type -> Type
39+type family HMaybe context where
40+ HMaybe (Reify context) = AHMaybe context
41+ HMaybe Aggregate = MaybeTable
42+ HMaybe Expr = MaybeTable
43+ HMaybe Insert = MaybeTable
44+ HMaybe Name = MaybeTable
45+ HMaybe Result = Maybe
46+
47+
48+type AHMaybe :: K.Context -> Type -> Type
49+newtype AHMaybe context a = AHMaybe (HMaybe context a)
50+
51+
52+instance Reifiable context => Functor (AHMaybe context) where
53+ fmap = smapMaybe contextSing
54+
55+
56+instance (Reifiable context, Table (Reify context) a) =>
57+ Table (Reify context) (AHMaybe context a)
58+ where
59+ type Context (AHMaybe context a) = Reify context
60+ type Columns (AHMaybe context a) = HMaybeTable (Columns a)
61+ type Unreify (AHMaybe context a) = HMaybe context (Unreify a)
62+
63+ fromColumns = sfromColumnsMaybe contextSing
64+ toColumns = stoColumnsMaybe contextSing
65+ reify proof = fmap fmap reify proof . AHMaybe
66+ unreify proof = (\(AHMaybe a) -> a) . fmap fmap unreify proof
67+
68+
69+instance
70+ ( Reifiable context, Reifiable context'
71+ , Recontextualize (Reify context) (Reify context') a a'
72+ ) =>
73+ Recontextualize
74+ (Reify context)
75+ (Reify context')
76+ (AHMaybe context a)
77+ (AHMaybe context' a')
78+
79+
80+smapMaybe :: ()
81+ => SContext context
82+ -> (a -> b)
83+ -> AHMaybe context a
84+ -> AHMaybe context b
85+smapMaybe = \case
86+ SAggregate -> \f (AHMaybe a) -> AHMaybe (fmap f a)
87+ SExpr -> \f (AHMaybe a) -> AHMaybe (fmap f a)
88+ SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)
89+ SInsert -> \f (AHMaybe a) -> AHMaybe (fmap f a)
90+ SName -> \f (AHMaybe a) -> AHMaybe (fmap f a)
91+ SReify context -> \f (AHMaybe a) -> AHMaybe (smapMaybe context f a)
92+
93+
94+sfromColumnsMaybe :: Table (Reify context) a
95+ => SContext context
96+ -> HMaybeTable (Columns a) (Col (Reify context))
97+ -> AHMaybe context a
98+sfromColumnsMaybe = \case
99+ SAggregate -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
100+ SExpr -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
101+ SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
102+ SInsert -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
103+ SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
104+ SReify context ->
105+ AHMaybe .
106+ smapMaybe context (fromColumns . hreify) .
107+ sfromColumnsMaybe context .
108+ hunreify
109+
110+
111+stoColumnsMaybe :: Table (Reify context) a
112+ => SContext context
113+ -> AHMaybe context a
114+ -> HMaybeTable (Columns a) (Col (Reify context))
115+stoColumnsMaybe = \case
116+ SAggregate ->
117+ hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
118+ SExpr ->
119+ hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
120+ SResult ->
121+ hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
122+ SInsert ->
123+ hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
124+ SName ->
125+ hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
126+ SReify context ->
127+ hreify .
128+ stoColumnsMaybe context .
129+ smapMaybe context (hunreify . toColumns) .
130+ (\(AHMaybe a) -> a)
src/Rel8/Column/NonEmpty.hsnew file+135
@@ -0,0 +1,135 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleContexts #-}
3+{-# language GADTs #-}
4+{-# language LambdaCase #-}
5+{-# language MultiParamTypeClasses #-}
6+{-# language StandaloneKindSignatures #-}
7+{-# language TypeFamilies #-}
8+{-# language UndecidableInstances #-}
9+
10+module Rel8.Column.NonEmpty
11+ ( HNonEmpty, AHNonEmpty(..)
12+ )
13+where
14+
15+-- base
16+import Data.Kind ( Type )
17+import Data.List.NonEmpty ( NonEmpty )
18+import Prelude
19+
20+-- rel8
21+import Rel8.Aggregate ( Aggregate )
22+import Rel8.Expr ( Expr )
23+import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
24+import Rel8.Schema.Context ( Col )
25+import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
26+import Rel8.Schema.Insert ( Insert )
27+import qualified Rel8.Schema.Kind as K
28+import Rel8.Schema.Name ( Name )
29+import Rel8.Schema.Reify ( Reify, hreify, hunreify )
30+import Rel8.Schema.Result ( Result )
31+import Rel8.Table
32+ ( Table, Columns, Congruent, Context, fromColumns, toColumns
33+ , Unreify, reify, unreify
34+ )
35+import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
36+import Rel8.Table.Recontextualize ( Recontextualize )
37+import Rel8.Table.Unreify ( Unreifiable )
38+
39+
40+type HNonEmpty :: K.Context -> Type -> Type
41+type family HNonEmpty context where
42+ HNonEmpty (Reify context) = AHNonEmpty context
43+ HNonEmpty Aggregate = NonEmptyTable
44+ HNonEmpty Expr = NonEmptyTable
45+ HNonEmpty Insert = NonEmptyTable
46+ HNonEmpty Name = NonEmptyTable
47+ HNonEmpty Result = NonEmpty
48+
49+
50+type AHNonEmpty :: K.Context -> Type -> Type
51+newtype AHNonEmpty context a = AHNonEmpty (HNonEmpty context a)
52+
53+
54+instance
55+ ( Reifiable context
56+ , Table (Reify context) a
57+ , Unreifiable (Reify context) a
58+ )
59+ => Table (Reify context) (AHNonEmpty context a)
60+ where
61+ type Context (AHNonEmpty context a) = Reify context
62+ type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
63+ type Unreify (AHNonEmpty context a) = HNonEmpty context (Unreify a)
64+
65+ fromColumns = sfromColumnsNonEmpty contextSing
66+ toColumns = stoColumnsNonEmpty contextSing
67+ reify proof =
68+ smapNonEmpty contextSing (reify proof) hreify .
69+ AHNonEmpty
70+ unreify proof =
71+ (\(AHNonEmpty a) -> a) .
72+ smapNonEmpty contextSing (unreify proof) hunreify
73+
74+
75+instance
76+ ( Reifiable context, Reifiable context'
77+ , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
78+ , Recontextualize (Reify context) (Reify context') a a'
79+ ) =>
80+ Recontextualize
81+ (Reify context)
82+ (Reify context')
83+ (AHNonEmpty context a)
84+ (AHNonEmpty context' a')
85+
86+
87+smapNonEmpty :: Congruent a b
88+ => SContext context
89+ -> (a -> b)
90+ -> (HNonEmptyTable (Columns a) (Col (Context a)) -> HNonEmptyTable (Columns b) (Col (Context b)))
91+ -> AHNonEmpty context a
92+ -> AHNonEmpty context b
93+smapNonEmpty = \case
94+ SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
95+ SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
96+ SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
97+ SInsert -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
98+ SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
99+ SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)
100+
101+
102+sfromColumnsNonEmpty :: Table (Reify context) a
103+ => SContext context
104+ -> HNonEmptyTable (Columns a) (Col (Reify context))
105+ -> AHNonEmpty context a
106+sfromColumnsNonEmpty = \case
107+ SAggregate -> AHNonEmpty . NonEmptyTable
108+ SExpr -> AHNonEmpty . NonEmptyTable
109+ SResult ->
110+ AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify
111+ SInsert -> AHNonEmpty . NonEmptyTable
112+ SName -> AHNonEmpty . NonEmptyTable
113+ SReify context ->
114+ AHNonEmpty .
115+ smapNonEmpty context (fromColumns . hreify) hreify .
116+ sfromColumnsNonEmpty context .
117+ hunreify
118+
119+
120+stoColumnsNonEmpty :: Table (Reify context) a
121+ => SContext context
122+ -> AHNonEmpty context a
123+ -> HNonEmptyTable (Columns a) (Col (Reify context))
124+stoColumnsNonEmpty = \case
125+ SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
126+ SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
127+ SResult ->
128+ hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
129+ SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a
130+ SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
131+ SReify context ->
132+ hreify .
133+ stoColumnsNonEmpty context .
134+ smapNonEmpty context (hunreify . toColumns) hunreify .
135+ (\(AHNonEmpty a) -> a)
src/Rel8/Column/These.hsnew file+176
@@ -0,0 +1,176 @@
1+{-# language DataKinds #-}
2+{-# language FlexibleContexts #-}
3+{-# language GADTs #-}
4+{-# language LambdaCase #-}
5+{-# language MultiParamTypeClasses #-}
6+{-# language StandaloneKindSignatures #-}
7+{-# language TypeFamilies #-}
8+{-# language UndecidableInstances #-}
9+
10+module Rel8.Column.These
11+ ( HThese, AHThese(..)
12+ )
13+where
14+
15+-- base
16+import Control.Applicative ( liftA2 )
17+import Data.Bifunctor ( Bifunctor, bimap )
18+import Data.Kind ( Type )
19+import Prelude
20+
21+-- rel8
22+import Rel8.Aggregate ( Aggregate )
23+import Rel8.Expr ( Expr )
24+import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
25+import Rel8.Schema.Context ( Col )
26+import Rel8.Schema.HTable.These ( HTheseTable )
27+import Rel8.Schema.Insert ( Insert )
28+import qualified Rel8.Schema.Kind as K
29+import Rel8.Schema.Name ( Name )
30+import Rel8.Schema.Reify ( Reify, hreify, hunreify )
31+import Rel8.Schema.Result ( Result )
32+import Rel8.Table
33+ ( Table, Columns, Context, fromColumns, toColumns
34+ , Unreify, reify, unreify
35+ )
36+import Rel8.Table.Recontextualize ( Recontextualize )
37+import Rel8.Table.These ( TheseTable )
38+
39+-- these
40+import Data.These ( These )
41+
42+
43+type HThese :: K.Context -> Type -> Type -> Type
44+type 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
51+
52+
53+type AHThese :: K.Context -> Type -> Type -> Type
54+newtype AHThese context a b = AHThese (HThese context a b)
55+
56+
57+instance Reifiable context => Bifunctor (AHThese context) where
58+ bimap = sbimapThese contextSing
59+
60+
61+instance Reifiable context => Functor (AHThese context a) where
62+ fmap = bimap id
63+
64+
65+instance (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)
71+
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
76+
77+
78+instance
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')
88+
89+
90+sbimapThese :: ()
91+ => SContext context
92+ -> (a -> c)
93+ -> (b -> d)
94+ -> AHThese context a b
95+ -> AHThese context c d
96+sbimapThese = \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)
103+
104+
105+sfromColumnsThese :: (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
109+sfromColumnsThese = \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
140+
141+
142+stoColumnsThese :: (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))
146+stoColumnsThese = \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)
src/Rel8/Schema/Field.hsdeleted−695
@@ -1,695 +0,0 @@
1−{-# language DataKinds #-}
2−{-# language FlexibleContexts #-}
3−{-# language GADTs #-}
4−{-# language LambdaCase #-}
5−{-# language MultiParamTypeClasses #-}
6−{-# language RankNTypes #-}
7−{-# language StandaloneKindSignatures #-}
8−{-# language TypeFamilies #-}
9−{-# language UndecidableInstances #-}
10−
11−module Rel8.Schema.Field
12− ( Field
13− , HEither, HList, HMaybe, HNonEmpty, HThese
14− , AField(..)
15− , AHEither(..), AHList(..), AHMaybe(..), AHNonEmpty(..), AHThese(..)
16− )
17−where
18−
19−-- base
20−import Control.Applicative ( liftA2 )
21−import Data.Bifunctor ( Bifunctor, bimap )
22−import Data.Kind ( Type )
23−import Data.List.NonEmpty ( NonEmpty )
24−import Prelude
25−
26−-- rel8
27−import Rel8.Aggregate ( Aggregate, Col(..) )
28−import Rel8.Expr ( Expr, Col(..) )
29−import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
30−import Rel8.Kind.Necessity
31− ( Necessity( Required, Optional )
32− , SNecessity( SRequired, SOptional )
33− , KnownNecessity, necessitySing
34− )
35−import Rel8.Schema.HTable.Either ( HEitherTable )
36−import Rel8.Schema.HTable.List ( HListTable )
37−import Rel8.Schema.HTable.Maybe ( HMaybeTable )
38−import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
39−import Rel8.Schema.HTable.These ( HTheseTable )
40−import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
41−import Rel8.Schema.Insert ( Insert, Col(..) )
42−import qualified Rel8.Schema.Kind as K
43−import Rel8.Schema.Name ( Name(..), Col(..) )
44−import Rel8.Schema.Null ( Sql )
45−import Rel8.Schema.Reify ( Reify, Col(..), hreify, hunreify )
46−import Rel8.Schema.Result ( Col( Result ), Result )
47−import Rel8.Schema.Spec ( Spec( Spec ) )
48−import Rel8.Table
49− ( Table, Columns, Congruent, Context, fromColumns, toColumns
50− , Unreify, reify, unreify
51− )
52−import Rel8.Table.Either ( EitherTable )
53−import Rel8.Table.List ( ListTable( ListTable ) )
54−import Rel8.Table.Maybe ( MaybeTable )
55−import Rel8.Table.NonEmpty ( NonEmptyTable( NonEmptyTable ) )
56−import Rel8.Table.Recontextualize ( Recontextualize )
57−import Rel8.Table.These ( TheseTable )
58−import Rel8.Table.Unreify ( Unreifiable )
59−import Rel8.Type ( DBType )
60−
61−-- these
62−import Data.These ( These )
63−
64−
65−type Field :: K.Context -> Necessity -> Type -> Type
66−type family Field context necessity a where
67− Field (Reify context) necessity a = AField context necessity a
68− Field Aggregate _necessity a = Aggregate (Expr a)
69− Field Expr _necessity a = Expr a
70− Field Insert 'Required a = Expr a
71− Field Insert 'Optional a = Maybe (Expr a)
72− Field Name _necessity a = Name a
73− Field Result _necessity a = a
74−
75−
76−type HEither :: K.Context -> Type -> Type -> Type
77−type family HEither context where
78− HEither (Reify context) = AHEither context
79− HEither Aggregate = EitherTable
80− HEither Expr = EitherTable
81− HEither Insert = EitherTable
82− HEither Name = EitherTable
83− HEither Result = Either
84−
85−
86−type HList :: K.Context -> Type -> Type
87−type family HList context where
88− HList (Reify context) = AHList context
89− HList Aggregate = ListTable
90− HList Expr = ListTable
91− HList Insert = ListTable
92− HList Name = ListTable
93− HList Result = []
94−
95−
96−type HMaybe :: K.Context -> Type -> Type
97−type family HMaybe context where
98− HMaybe (Reify context) = AHMaybe context
99− HMaybe Aggregate = MaybeTable
100− HMaybe Expr = MaybeTable
101− HMaybe Insert = MaybeTable
102− HMaybe Name = MaybeTable
103− HMaybe Result = Maybe
104−
105−
106−type HNonEmpty :: K.Context -> Type -> Type
107−type family HNonEmpty context where
108− HNonEmpty (Reify context) = AHNonEmpty context
109− HNonEmpty Aggregate = NonEmptyTable
110− HNonEmpty Expr = NonEmptyTable
111− HNonEmpty Insert = NonEmptyTable
112− HNonEmpty Name = NonEmptyTable
113− HNonEmpty Result = NonEmpty
114−
115−
116−type HThese :: K.Context -> Type -> Type -> Type
117−type family HThese context where
118− HThese (Reify context) = AHThese context
119− HThese Aggregate = TheseTable
120− HThese Expr = TheseTable
121− HThese Insert = TheseTable
122− HThese Name = TheseTable
123− HThese Result = These
124−
125−
126−type AField :: K.Context -> Necessity -> Type -> Type
127−newtype AField context necessity a = AField (Field context necessity a)
128−
129−
130−instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>
131− Table (Reify context) (AField context necessity a)
132− where
133− type Context (AField context necessity a) = Reify context
134− type Columns (AField context necessity a) = HIdentity ('Spec '[""] necessity a)
135− type Unreify (AField context necessity a) = Field context necessity a
136−
137− fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a
138− toColumns = HIdentity . Reify . stoColumn contextSing necessitySing
139− reify _ = AField
140− unreify _ (AField a) = a
141−
142−
143−instance
144− ( Reifiable context, Reifiable context'
145− , KnownNecessity necessity, Sql DBType a
146− ) =>
147− Recontextualize
148− (Reify context)
149− (Reify context')
150− (AField context necessity a)
151− (AField context' necessity a)
152−
153−
154−type AHEither :: K.Context -> Type -> Type -> Type
155−newtype AHEither context a b = AHEither (HEither context a b)
156−
157−
158−instance Reifiable context => Bifunctor (AHEither context) where
159− bimap = sbimapEither contextSing
160−
161−
162−instance Reifiable context => Functor (AHEither context a) where
163− fmap = bimap id
164−
165−
166−instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
167− => Table (Reify context) (AHEither context a b)
168− where
169− type Context (AHEither context a b) = Reify context
170− type Columns (AHEither context a b) = HEitherTable (Columns a) (Columns b)
171− type Unreify (AHEither context a b) = HEither context (Unreify a) (Unreify b)
172−
173− fromColumns = sfromColumnsEither contextSing
174− toColumns = stoColumnsEither contextSing
175− reify proof = liftA2 bimap reify reify proof . AHEither
176− unreify proof = (\(AHEither a) -> a) . liftA2 bimap unreify unreify proof
177−
178−
179−instance
180− ( Reifiable context, Reifiable context'
181− , Recontextualize (Reify context) (Reify context') a a'
182− , Recontextualize (Reify context) (Reify context') b b'
183− ) =>
184− Recontextualize
185− (Reify context)
186− (Reify context')
187− (AHEither context a b)
188− (AHEither context' a' b')
189−
190−
191−type AHList :: K.Context -> Type -> Type
192−newtype AHList context a = AHList (HList context a)
193−
194−
195−instance
196− ( Reifiable context
197− , Table (Reify context) a
198− , Unreifiable (Reify context) a
199− )
200− => Table (Reify context) (AHList context a)
201− where
202− type Context (AHList context a) = Reify context
203− type Columns (AHList context a) = HListTable (Columns a)
204− type Unreify (AHList context a) = HList context (Unreify a)
205−
206− fromColumns = sfromColumnsList contextSing
207− toColumns = stoColumnsList contextSing
208− reify proof =
209− smapList contextSing (reify proof) hreify .
210− AHList
211− unreify proof =
212− (\(AHList a) -> a) .
213− smapList contextSing (unreify proof) hunreify
214−
215−
216−instance
217− ( Reifiable context, Reifiable context'
218− , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
219− , Recontextualize (Reify context) (Reify context') a a'
220− ) =>
221− Recontextualize
222− (Reify context)
223− (Reify context')
224− (AHList context a)
225− (AHList context' a')
226−
227−
228−type AHMaybe :: K.Context -> Type -> Type
229−newtype AHMaybe context a = AHMaybe (HMaybe context a)
230−
231−
232−instance Reifiable context => Functor (AHMaybe context) where
233− fmap = smapMaybe contextSing
234−
235−
236−instance (Reifiable context, Table (Reify context) a) =>
237− Table (Reify context) (AHMaybe context a)
238− where
239− type Context (AHMaybe context a) = Reify context
240− type Columns (AHMaybe context a) = HMaybeTable (Columns a)
241− type Unreify (AHMaybe context a) = HMaybe context (Unreify a)
242−
243− fromColumns = sfromColumnsMaybe contextSing
244− toColumns = stoColumnsMaybe contextSing
245− reify proof = fmap fmap reify proof . AHMaybe
246− unreify proof = (\(AHMaybe a) -> a) . fmap fmap unreify proof
247−
248−
249−instance
250− ( Reifiable context, Reifiable context'
251− , Recontextualize (Reify context) (Reify context') a a'
252− ) =>
253− Recontextualize
254− (Reify context)
255− (Reify context')
256− (AHMaybe context a)
257− (AHMaybe context' a')
258−
259−
260−type AHNonEmpty :: K.Context -> Type -> Type
261−newtype AHNonEmpty context a = AHNonEmpty (HNonEmpty context a)
262−
263−
264−instance
265− ( Reifiable context
266− , Table (Reify context) a
267− , Unreifiable (Reify context) a
268− )
269− => Table (Reify context) (AHNonEmpty context a)
270− where
271− type Context (AHNonEmpty context a) = Reify context
272− type Columns (AHNonEmpty context a) = HNonEmptyTable (Columns a)
273− type Unreify (AHNonEmpty context a) = HNonEmpty context (Unreify a)
274−
275− fromColumns = sfromColumnsNonEmpty contextSing
276− toColumns = stoColumnsNonEmpty contextSing
277− reify proof =
278− smapNonEmpty contextSing (reify proof) hreify .
279− AHNonEmpty
280− unreify proof =
281− (\(AHNonEmpty a) -> a) .
282− smapNonEmpty contextSing (unreify proof) hunreify
283−
284−
285−instance
286− ( Reifiable context, Reifiable context'
287− , Unreifiable (Reify context) a, Unreifiable (Reify context') a'
288− , Recontextualize (Reify context) (Reify context') a a'
289− ) =>
290− Recontextualize
291− (Reify context)
292− (Reify context')
293− (AHNonEmpty context a)
294− (AHNonEmpty context' a')
295−
296−
297−type AHThese :: K.Context -> Type -> Type -> Type
298−newtype AHThese context a b = AHThese (HThese context a b)
299−
300−
301−instance Reifiable context => Bifunctor (AHThese context) where
302− bimap = sbimapThese contextSing
303−
304−
305−instance Reifiable context => Functor (AHThese context a) where
306− fmap = bimap id
307−
308−
309−instance (Reifiable context, Table (Reify context) a, Table (Reify context) b)
310− => Table (Reify context) (AHThese context a b)
311− where
312− type Context (AHThese context a b) = Reify context
313− type Columns (AHThese context a b) = HTheseTable (Columns a) (Columns b)
314− type Unreify (AHThese context a b) = HThese context (Unreify a) (Unreify b)
315−
316− fromColumns = sfromColumnsThese contextSing
317− toColumns = stoColumnsThese contextSing
318− reify proof = liftA2 bimap reify reify proof . AHThese
319− unreify proof = (\(AHThese a) -> a) . liftA2 bimap unreify unreify proof
320−
321−
322−instance
323− ( Reifiable context, Reifiable context'
324− , Recontextualize (Reify context) (Reify context') a a'
325− , Recontextualize (Reify context) (Reify context') b b'
326− ) =>
327− Recontextualize
328− (Reify context)
329− (Reify context')
330− (AHThese context a b)
331− (AHThese context' a' b')
332−
333−
334−sfromColumn :: ()
335− => SContext context
336− -> Col context ('Spec labels necessity a)
337− -> AField context necessity a
338−sfromColumn = \case
339− SAggregate -> \(Aggregation a) -> AField a
340− SExpr -> \(DB a) -> AField a
341− SResult -> \(Result a) -> AField a
342− SInsert -> \case
343− RequiredInsert a -> AField a
344− OptionalInsert a -> AField a
345− SName -> \(NameCol a) -> AField (Name a)
346− SReify context -> \(Reify a) -> AField (sfromColumn context a)
347−
348−
349−stoColumn :: ()
350− => SContext context
351− -> SNecessity necessity
352− -> AField context necessity a
353− -> Col context ('Spec labels necessity a)
354−stoColumn = \case
355− SAggregate -> \_ (AField a) -> Aggregation a
356− SExpr -> \_ (AField a) -> DB a
357− SResult -> \_ (AField a) -> Result a
358− SInsert -> \case
359− SRequired -> \(AField a) -> RequiredInsert a
360− SOptional -> \(AField a) -> OptionalInsert a
361− SName -> \_ (AField (Name a)) -> NameCol a
362− SReify context ->
363− \necessity (AField a) -> Reify (stoColumn context necessity a)
364−
365−
366−sbimapEither :: ()
367− => SContext context
368− -> (a -> c)
369− -> (b -> d)
370− -> AHEither context a b
371− -> AHEither context c d
372−sbimapEither = \case
373− SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)
374− SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)
375− SResult -> \f g (AHEither a) -> AHEither (bimap f g a)
376− SInsert -> \f g (AHEither a) -> AHEither (bimap f g a)
377− SName -> \f g (AHEither a) -> AHEither (bimap f g a)
378− SReify context -> \f g (AHEither a) -> AHEither (sbimapEither context f g a)
379−
380−
381−sfromColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
382− => SContext context
383− -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
384− -> AHEither context a b
385−sfromColumnsEither = \case
386− SAggregate ->
387− AHEither .
388− bimap (fromColumns . hreify) (fromColumns . hreify) .
389− fromColumns .
390− hunreify
391− SExpr ->
392− AHEither .
393− bimap (fromColumns . hreify) (fromColumns . hreify) .
394− fromColumns .
395− hunreify
396− SResult ->
397− AHEither .
398− bimap (fromColumns . hreify) (fromColumns . hreify) .
399− fromColumns .
400− hunreify
401− SInsert ->
402− AHEither .
403− bimap (fromColumns . hreify) (fromColumns . hreify) .
404− fromColumns .
405− hunreify
406− SName ->
407− AHEither .
408− bimap (fromColumns . hreify) (fromColumns . hreify) .
409− fromColumns .
410− hunreify
411− SReify context ->
412− AHEither .
413− sbimapEither context (fromColumns . hreify) (fromColumns . hreify) .
414− sfromColumnsEither context .
415− hunreify
416−
417−
418−stoColumnsEither :: (Table (Reify context) a, Table (Reify context) b)
419− => SContext context
420− -> AHEither context a b
421− -> HEitherTable (Columns a) (Columns b) (Col (Reify context))
422−stoColumnsEither = \case
423− SAggregate ->
424− hreify .
425− toColumns .
426− bimap (hunreify . toColumns) (hunreify . toColumns) .
427− (\(AHEither a) -> a)
428− SExpr ->
429− hreify .
430− toColumns .
431− bimap (hunreify . toColumns) (hunreify . toColumns) .
432− (\(AHEither a) -> a)
433− SResult ->
434− hreify .
435− toColumns .
436− bimap (hunreify . toColumns) (hunreify . toColumns) .
437− (\(AHEither a) -> a)
438− SInsert ->
439− hreify .
440− toColumns .
441− bimap (hunreify . toColumns) (hunreify . toColumns) .
442− (\(AHEither a) -> a)
443− SName ->
444− hreify .
445− toColumns .
446− bimap (hunreify . toColumns) (hunreify . toColumns) .
447− (\(AHEither a) -> a)
448− SReify context ->
449− hreify .
450− stoColumnsEither context .
451− sbimapEither context (hunreify . toColumns) (hunreify . toColumns) .
452− (\(AHEither a) -> a)
453−
454−
455−smapList :: Congruent a b
456− => SContext context
457− -> (a -> b)
458− -> (HListTable (Columns a) (Col (Context a)) -> HListTable (Columns b) (Col (Context b)))
459− -> AHList context a
460− -> AHList context b
461−smapList = \case
462− SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
463− SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
464− SResult -> \f _ (AHList as) -> AHList (fmap f as)
465− SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
466− SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))
467− SReify context -> \f g (AHList as) -> AHList (smapList context f g as)
468−
469−
470−sfromColumnsList :: Table (Reify context) a
471− => SContext context
472− -> HListTable (Columns a) (Col (Reify context))
473− -> AHList context a
474−sfromColumnsList = \case
475− SAggregate -> AHList . ListTable
476− SExpr -> AHList . ListTable
477− SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify
478− SInsert -> AHList . ListTable
479− SName -> AHList . ListTable
480− SReify context ->
481− AHList .
482− smapList context (fromColumns . hreify) hreify .
483− sfromColumnsList context .
484− hunreify
485−
486−
487−stoColumnsList :: Table (Reify context) a
488− => SContext context
489− -> AHList context a
490− -> HListTable (Columns a) (Col (Reify context))
491−stoColumnsList = \case
492− SAggregate -> \(AHList (ListTable a)) -> a
493− SExpr -> \(AHList (ListTable a)) -> a
494− SResult ->
495− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)
496− SInsert -> \(AHList (ListTable a)) -> a
497− SName -> \(AHList (ListTable a)) -> a
498− SReify context ->
499− hreify .
500− stoColumnsList context .
501− smapList context (hunreify . toColumns) hunreify .
502− (\(AHList a) -> a)
503−
504−
505−smapMaybe :: ()
506− => SContext context
507− -> (a -> b)
508− -> AHMaybe context a
509− -> AHMaybe context b
510−smapMaybe = \case
511− SAggregate -> \f (AHMaybe a) -> AHMaybe (fmap f a)
512− SExpr -> \f (AHMaybe a) -> AHMaybe (fmap f a)
513− SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)
514− SInsert -> \f (AHMaybe a) -> AHMaybe (fmap f a)
515− SName -> \f (AHMaybe a) -> AHMaybe (fmap f a)
516− SReify context -> \f (AHMaybe a) -> AHMaybe (smapMaybe context f a)
517−
518−
519−sfromColumnsMaybe :: Table (Reify context) a
520− => SContext context
521− -> HMaybeTable (Columns a) (Col (Reify context))
522− -> AHMaybe context a
523−sfromColumnsMaybe = \case
524− SAggregate -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
525− SExpr -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
526− SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
527− SInsert -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
528− SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify
529− SReify context ->
530− AHMaybe .
531− smapMaybe context (fromColumns . hreify) .
532− sfromColumnsMaybe context .
533− hunreify
534−
535−
536−stoColumnsMaybe :: Table (Reify context) a
537− => SContext context
538− -> AHMaybe context a
539− -> HMaybeTable (Columns a) (Col (Reify context))
540−stoColumnsMaybe = \case
541− SAggregate ->
542− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
543− SExpr ->
544− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
545− SResult ->
546− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
547− SInsert ->
548− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
549− SName ->
550− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)
551− SReify context ->
552− hreify .
553− stoColumnsMaybe context .
554− smapMaybe context (hunreify . toColumns) .
555− (\(AHMaybe a) -> a)
556−
557−
558−smapNonEmpty :: Congruent a b
559− => SContext context
560− -> (a -> b)
561− -> (HNonEmptyTable (Columns a) (Col (Context a)) -> HNonEmptyTable (Columns b) (Col (Context b)))
562− -> AHNonEmpty context a
563− -> AHNonEmpty context b
564−smapNonEmpty = \case
565− SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
566− SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
567− SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)
568− SInsert -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
569− SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))
570− SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)
571−
572−
573−sfromColumnsNonEmpty :: Table (Reify context) a
574− => SContext context
575− -> HNonEmptyTable (Columns a) (Col (Reify context))
576− -> AHNonEmpty context a
577−sfromColumnsNonEmpty = \case
578− SAggregate -> AHNonEmpty . NonEmptyTable
579− SExpr -> AHNonEmpty . NonEmptyTable
580− SResult ->
581− AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify
582− SInsert -> AHNonEmpty . NonEmptyTable
583− SName -> AHNonEmpty . NonEmptyTable
584− SReify context ->
585− AHNonEmpty .
586− smapNonEmpty context (fromColumns . hreify) hreify .
587− sfromColumnsNonEmpty context .
588− hunreify
589−
590−
591−stoColumnsNonEmpty :: Table (Reify context) a
592− => SContext context
593− -> AHNonEmpty context a
594− -> HNonEmptyTable (Columns a) (Col (Reify context))
595−stoColumnsNonEmpty = \case
596− SAggregate -> \(AHNonEmpty (NonEmptyTable a)) -> a
597− SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a
598− SResult ->
599− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)
600− SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a
601− SName -> \(AHNonEmpty (NonEmptyTable a)) -> a
602− SReify context ->
603− hreify .
604− stoColumnsNonEmpty context .
605− smapNonEmpty context (hunreify . toColumns) hunreify .
606− (\(AHNonEmpty a) -> a)
607−
608−
609−sbimapThese :: ()
610− => SContext context
611− -> (a -> c)
612− -> (b -> d)
613− -> AHThese context a b
614− -> AHThese context c d
615−sbimapThese = \case
616− SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)
617− SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)
618− SResult -> \f g (AHThese a) -> AHThese (bimap f g a)
619− SInsert -> \f g (AHThese a) -> AHThese (bimap f g a)
620− SName -> \f g (AHThese a) -> AHThese (bimap f g a)
621− SReify context -> \f g (AHThese a) -> AHThese (sbimapThese context f g a)
622−
623−
624−sfromColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
625− => SContext context
626− -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
627− -> AHThese context a b
628−sfromColumnsThese = \case
629− SAggregate ->
630− AHThese .
631− bimap (fromColumns . hreify) (fromColumns . hreify) .
632− fromColumns .
633− hunreify
634− SExpr ->
635− AHThese .
636− bimap (fromColumns . hreify) (fromColumns . hreify) .
637− fromColumns .
638− hunreify
639− SResult ->
640− AHThese .
641− bimap (fromColumns . hreify) (fromColumns . hreify) .
642− fromColumns .
643− hunreify
644− SInsert ->
645− AHThese .
646− bimap (fromColumns . hreify) (fromColumns . hreify) .
647− fromColumns .
648− hunreify
649− SName ->
650− AHThese .
651− bimap (fromColumns . hreify) (fromColumns . hreify) .
652− fromColumns .
653− hunreify
654− SReify context ->
655− AHThese .
656− sbimapThese context (fromColumns . hreify) (fromColumns . hreify) .
657− sfromColumnsThese context .
658− hunreify
659−
660−
661−stoColumnsThese :: (Table (Reify context) a, Table (Reify context) b)
662− => SContext context
663− -> AHThese context a b
664− -> HTheseTable (Columns a) (Columns b) (Col (Reify context))
665−stoColumnsThese = \case
666− SAggregate ->
667− hreify .
668− toColumns .
669− bimap (hunreify . toColumns) (hunreify . toColumns) .
670− (\(AHThese a) -> a)
671− SExpr ->
672− hreify .
673− toColumns .
674− bimap (hunreify . toColumns) (hunreify . toColumns) .
675− (\(AHThese a) -> a)
676− SResult ->
677− hreify .
678− toColumns .
679− bimap (hunreify . toColumns) (hunreify . toColumns) .
680− (\(AHThese a) -> a)
681− SInsert ->
682− hreify .
683− toColumns .
684− bimap (hunreify . toColumns) (hunreify . toColumns) .
685− (\(AHThese a) -> a)
686− SName ->
687− hreify .
688− toColumns .
689− bimap (hunreify . toColumns) (hunreify . toColumns) .
690− (\(AHThese a) -> a)
691− SReify context ->
692− hreify .
693− stoColumnsThese context .
694− sbimapThese context (hunreify . toColumns) (hunreify . toColumns) .
695− (\(AHThese a) -> a)