git.iko.soy/rel8
on master help sign in
Make all Col constructors single letter wrappers
0f76861Shane O'Brien
src/Rel8/Aggregate.hs+8−8
compare with master
unifiedsplit
@@ -15,7 +15,7 @@ module Rel8.Aggregate
15 ( Aggregate(..), foldInputs, mapInputs
15 ( Aggregate(..), foldInputs, mapInputs
16 , Aggregator(..), unsafeMakeAggregate
16 , Aggregator(..), unsafeMakeAggregate
17 , Aggregates
17 , Aggregates
18− , Col( Aggregation )
18+ , Col( A, unA )
19 )
19 )
20where
20where
21
21
@@ -31,7 +31,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
31import qualified Opaleye.Internal.PackMap as Opaleye
31import qualified Opaleye.Internal.PackMap as Opaleye
32
32
33-- rel8
33-- rel8
34−import Rel8.Expr ( Expr, Col(..) )
34+import Rel8.Expr ( Expr, Col( E, unE ) )
35import Rel8.Schema.Context ( Interpretation(..) )
35import Rel8.Schema.Context ( Interpretation(..) )
36import Rel8.Schema.Context.Label ( Labelable(..) )
36import Rel8.Schema.Context.Label ( Labelable(..) )
37import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )
37import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )
@@ -71,8 +71,8 @@ instance Apply Aggregate where
71
71
72instance Interpretation Aggregate where
72instance Interpretation Aggregate where
73 data Col Aggregate _spec where
73 data Col Aggregate _spec where
74− Aggregation :: ()
74+ A :: ()
75− => Aggregate (Expr a)
75+ => { unA :: !(Aggregate (Expr a)) }
76 -> Col Aggregate ('Spec labels necessity a)
76 -> Col Aggregate ('Spec labels necessity a)
77
77
78
78
@@ -81,10 +81,10 @@ instance Table Expr a => Table Aggregate (Aggregate a) where
81 type Context (Aggregate a) = Aggregate
81 type Context (Aggregate a) = Aggregate
82
82
83 toColumns a = htabulate $ \field -> case hfield hspecs field of
83 toColumns a = htabulate $ \field -> case hfield hspecs field of
84− SSpec {} -> Aggregation $ unDB . (`hfield` field) . toColumns <$> a
84+ SSpec {} -> A $ unE . (`hfield` field) . toColumns <$> a
85 fromColumns as = fmap fromColumns $ htabulateA $ \field ->
85 fromColumns as = fmap fromColumns $ htabulateA $ \field ->
86 case hfield as field of
86 case hfield as field of
87− Aggregation a -> DB <$> a
87+ A a -> E <$> a
88
88
89 reify = notReify
89 reify = notReify
90 unreify = notReify
90 unreify = notReify
@@ -119,8 +119,8 @@ instance Sql DBType a =>
119
119
120
120
121instance Labelable Aggregate where
121instance Labelable Aggregate where
122− labeler (Aggregation aggregate) = Aggregation aggregate
122+ labeler (A aggregate) = A aggregate
123− unlabeler (Aggregation aggregate) = Aggregation aggregate
123+ unlabeler (A aggregate) = A aggregate
124
124
125
125
126-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
126-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
src/Rel8/Aggregate/Legacy.hs+5−5
@@ -31,8 +31,8 @@ import Prelude
31import qualified Opaleye.Aggregate as Opaleye
31import qualified Opaleye.Aggregate as Opaleye
32
32
33-- rel8
33-- rel8
34−import Rel8.Aggregate ( Aggregate, Aggregates, Col(..) )
34+import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )
35−import Rel8.Expr ( Col(..), Expr )
35+import Rel8.Expr ( Col( E ), Expr )
36import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
36import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )
37import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )
37import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )
38import Rel8.Generic.Table ( GAlgebra )
38import Rel8.Generic.Table ( GAlgebra )
@@ -73,7 +73,7 @@ groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)
73groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
73groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
74 case hfield (eqTable @exprs) field of
74 case hfield (eqTable @exprs) field of
75 Dict -> case hfield exprs field of
75 Dict -> case hfield exprs field of
76− DB expr -> Aggregation $ groupByExpr expr
76+ E expr -> A $ groupByExpr expr
77
77
78
78
79-- | Aggregate rows into a single row containing an array of all aggregated
79-- | Aggregate rows into a single row containing an array of all aggregated
@@ -95,7 +95,7 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
95listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates
95listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates
96listAgg (toColumns -> exprs) = fromColumns $
96listAgg (toColumns -> exprs) = fromColumns $
97 hvectorize
97 hvectorize
98− (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
98+ (\_ (Identity (E a)) -> A $ listAggExpr a)
99 (pure exprs)
99 (pure exprs)
100
100
101
101
@@ -103,7 +103,7 @@ listAgg (toColumns -> exprs) = fromColumns $
103nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
103nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates
104nonEmptyAgg (toColumns -> exprs) = fromColumns $
104nonEmptyAgg (toColumns -> exprs) = fromColumns $
105 hvectorize
105 hvectorize
106− (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
106+ (\_ (Identity (E a)) -> A $ nonEmptyAggExpr a)
107 (pure exprs)
107 (pure exprs)
108
108
109
109
src/Rel8/Column/Field.hs+18−18
@@ -15,8 +15,8 @@ import Data.Kind ( Type )
15import Prelude
15import Prelude
16
16
17-- rel8
17-- rel8
18−import Rel8.Aggregate ( Aggregate, Col(..) )
18+import Rel8.Aggregate ( Aggregate, Col( A ) )
19−import Rel8.Expr ( Expr, Col(..) )
19+import Rel8.Expr ( Expr, Col( E ) )
20import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
20import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )
21import Rel8.Kind.Necessity
21import Rel8.Kind.Necessity
22 ( Necessity( Required, Optional )
22 ( Necessity( Required, Optional )
@@ -24,12 +24,12 @@ import Rel8.Kind.Necessity
24 , KnownNecessity, necessitySing
24 , KnownNecessity, necessitySing
25 )
25 )
26import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
26import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )
27−import Rel8.Schema.Insert ( Insert, Insertion(..), Col(..) )
27+import Rel8.Schema.Insert ( Insert, Insertion(..), Col( I ) )
28import qualified Rel8.Schema.Kind as K
28import qualified Rel8.Schema.Kind as K
29−import Rel8.Schema.Name ( Name(..), Col(..) )
29+import Rel8.Schema.Name ( Name(..), Col( N ) )
30import Rel8.Schema.Null ( Sql )
30import Rel8.Schema.Null ( Sql )
31import Rel8.Schema.Reify ( Reify, Col(..) )
31import Rel8.Schema.Reify ( Reify, Col(..) )
32−import Rel8.Schema.Result ( Col( Result ), Result )
32+import Rel8.Schema.Result ( Col( R ), Result )
33import Rel8.Schema.Spec ( Spec( Spec ) )
33import Rel8.Schema.Spec ( Spec( Spec ) )
34import Rel8.Table
34import Rel8.Table
35 ( Table, Columns, Context, fromColumns, toColumns
35 ( Table, Columns, Context, fromColumns, toColumns
@@ -84,16 +84,16 @@ sfromColumn :: ()
84 -> Col context ('Spec labels necessity a)
84 -> Col context ('Spec labels necessity a)
85 -> AField context necessity a
85 -> AField context necessity a
86sfromColumn = \case
86sfromColumn = \case
87− SAggregate -> \_ (Aggregation a) -> AField a
87+ SAggregate -> \_ (A a) -> AField a
88− SExpr -> \_ (DB a) -> AField a
89− SResult -> \_ (Result a) -> AField a
88+ SExpr -> \_ (E a) -> AField a
90 SInsert -> \case
89 SInsert -> \case
91 SRequired -> \case
90 SRequired -> \case
92− InsertCol (Insertion a) -> AField a
91+ I (Insertion a) -> AField a
93 SOptional -> \case
92 SOptional -> \case
94− InsertCol Default -> AField Nothing
93+ I Default -> AField Nothing
95− InsertCol (Insertion a) -> AField (Just a)
94+ I (Insertion a) -> AField (Just a)
96− SName -> \_ (NameCol a) -> AField (Name a)
95+ SName -> \_ (N a) -> AField a
96+ SResult -> \_ (R a) -> AField a
97 SReify context ->
97 SReify context ->
98 \necessity (Reify a) -> AField (sfromColumn context necessity a)
98 \necessity (Reify a) -> AField (sfromColumn context necessity a)
99
99
@@ -104,12 +104,12 @@ stoColumn :: ()
104 -> AField context necessity a
104 -> AField context necessity a
105 -> Col context ('Spec labels necessity a)
105 -> Col context ('Spec labels necessity a)
106stoColumn = \case
106stoColumn = \case
107− SAggregate -> \_ (AField a) -> Aggregation a
107+ SAggregate -> \_ (AField a) -> A a
108− SExpr -> \_ (AField a) -> DB a
108+ SExpr -> \_ (AField a) -> E a
109− SResult -> \_ (AField a) -> Result a
110 SInsert -> \case
109 SInsert -> \case
111− SRequired -> \(AField a) -> InsertCol (Insertion a)
110+ SRequired -> \(AField a) -> I (Insertion a)
112− SOptional -> \(AField ma) -> InsertCol $ maybe Default Insertion ma
111+ SOptional -> \(AField ma) -> I $ maybe Default Insertion ma
113− SName -> \_ (AField (Name a)) -> NameCol a
112+ SName -> \_ (AField a) -> N a
113+ SResult -> \_ (AField a) -> R a
114 SReify context ->
114 SReify context ->
115 \necessity (AField a) -> Reify (stoColumn context necessity a)
115 \necessity (AField a) -> Reify (stoColumn context necessity a)
src/Rel8/Expr.hs+6−6
@@ -15,7 +15,7 @@
15
15
16module Rel8.Expr
16module Rel8.Expr
17 ( Expr(..)
17 ( Expr(..)
18− , Col( DB, unDB )
18+ , Col( E, unE )
19 )
19 )
20where
20where
21
21
@@ -128,15 +128,15 @@ instance Sql DBFloating a => Floating (Expr a) where
128
128
129instance Interpretation Expr where
129instance Interpretation Expr where
130 data Col Expr _spec where
130 data Col Expr _spec where
131− DB :: {unDB :: Expr a} -> Col Expr ('Spec labels necessity a)
131+ E :: {unE :: !(Expr a)} -> Col Expr ('Spec labels necessity a)
132
132
133
133
134instance Sql DBType a => Table Expr (Expr a) where
134instance Sql DBType a => Table Expr (Expr a) where
135 type Columns (Expr a) = HType a
135 type Columns (Expr a) = HType a
136 type Context (Expr a) = Expr
136 type Context (Expr a) = Expr
137
137
138− toColumns a = HType (DB a)
138+ toColumns a = HType (E a)
139− fromColumns (HType (DB a)) = a
139+ fromColumns (HType (E a)) = a
140 reify = notReify
140 reify = notReify
141 unreify = notReify
141 unreify = notReify
142
142
@@ -151,5 +151,5 @@ instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)
151
151
152
152
153instance Labelable Expr where
153instance Labelable Expr where
154− labeler (DB a) = DB a
154+ labeler (E a) = E a
155− unlabeler (DB a) = DB a
155+ unlabeler (E a) = E a
src/Rel8/Generic/Construction.hs+28−28
@@ -35,8 +35,8 @@ import GHC.TypeLits ( Symbol )
35import Prelude
35import Prelude
36
36
37-- rel8
37-- rel8
38−import Rel8.Aggregate ( Col( Aggregation ), Aggregate )
38+import Rel8.Aggregate ( Col( A ), Aggregate )
39−import Rel8.Expr ( Col( DB ), Expr )
39+import Rel8.Expr ( Col( E ), Expr )
40import Rel8.Expr.Aggregate ( groupByExpr )
40import Rel8.Expr.Aggregate ( groupByExpr )
41import Rel8.Expr.Eq ( (==.) )
41import Rel8.Expr.Eq ( (==.) )
42import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )
42import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )
@@ -64,9 +64,9 @@ import qualified Rel8.Kind.Algebra as K
64import Rel8.Schema.Context.Nullify ( runTag )
64import Rel8.Schema.Context.Nullify ( runTag )
65import Rel8.Schema.HTable ( HTable )
65import Rel8.Schema.HTable ( HTable )
66import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
66import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
67−import Rel8.Schema.Insert ( Col( InsertCol ), Insert, Insertion(..) )
67+import Rel8.Schema.Insert ( Col( I ), Insert, Insertion(..) )
68import qualified Rel8.Schema.Kind as K
68import qualified Rel8.Schema.Kind as K
69−import Rel8.Schema.Name ( Col( NameCol ), Name( Name ) )
69+import Rel8.Schema.Name ( Col( N ), Name( Name ) )
70import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
70import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
71import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
71import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
72import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )
72import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )
@@ -147,11 +147,11 @@ ggbuild gfromColumns = case algebraSing @algebra of
147 @name
147 @name
148 @(Eval (rep (Reify Expr)))
148 @(Eval (rep (Reify Expr)))
149 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
149 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
150− (\SSpec {info} -> Reify (DB (snull info)))
150+ (\SSpec {info} -> Reify (E (snull info)))
151 (\SSpec {nullity} -> case nullity of
151 (\SSpec {nullity} -> case nullity of
152 Null -> id
152 Null -> id
153− NotNull -> \(Reify (DB a)) -> Reify (DB (nullify a)))
153+ NotNull -> \(Reify (E a)) -> Reify (E (nullify a)))
154− (HType . Reify . DB . litExpr)
154+ (HType . Reify . E . litExpr)
155
155
156
156
157type GGInsert :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
157type GGInsert :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
@@ -189,13 +189,13 @@ gginsert gfromColumns = case algebraSing @algebra of
189 @name
189 @name
190 @(Eval (rep (Reify Insert)))
190 @(Eval (rep (Reify Insert)))
191 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
191 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
192− (\SSpec {info} -> Reify $ InsertCol (Insertion (snull info)))
192+ (\SSpec {info} -> Reify $ I (Insertion (snull info)))
193 (\SSpec {nullity} -> case nullity of
193 (\SSpec {nullity} -> case nullity of
194 Null -> id
194 Null -> id
195 NotNull -> \case
195 NotNull -> \case
196− Reify (InsertCol Default) -> Reify (InsertCol Default)
196+ Reify (I Default) -> Reify (I Default)
197− Reify (InsertCol (Insertion a)) -> Reify (InsertCol (Insertion (nullify a))))
197+ Reify (I (Insertion a)) -> Reify (I (Insertion (nullify a))))
198− (HType . Reify . InsertCol . Insertion . litExpr)
198+ (HType . Reify . I . Insertion . litExpr)
199
199
200
200
201type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
201type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint
@@ -273,11 +273,11 @@ ggconstruct gfromColumns f = case algebraSing @algebra of
273 @(Col (Reify Expr))
273 @(Col (Reify Expr))
274 @(Eval (rep (Reify Expr)))
274 @(Eval (rep (Reify Expr)))
275 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
275 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
276− (\SSpec {info} -> Reify (DB (snull info)))
276+ (\SSpec {info} -> Reify (E (snull info)))
277 (\SSpec {nullity} -> case nullity of
277 (\SSpec {nullity} -> case nullity of
278 Null -> id
278 Null -> id
279− NotNull -> \(Reify (DB a)) -> Reify (DB (nullify a)))
279+ NotNull -> \(Reify (E a)) -> Reify (E (nullify a)))
280− (HType . Reify . DB . litExpr)
280+ (HType . Reify . E . litExpr)
281
281
282
282
283type GGDeconstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type -> Type
283type GGDeconstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type -> Type
@@ -306,7 +306,7 @@ ggdeconstruct gtoColumns = case algebraSing @algebra of
306 SSum ->
306 SSum ->
307 gctabulate @TUnreify @(Eval (rep (Reify Expr))) @r @(a -> r) $ \constructors as ->
307 gctabulate @TUnreify @(Eval (rep (Reify Expr))) @r @(a -> r) $ \constructors as ->
308 let
308 let
309− (HType (Reify (DB tag)), cases) =
309+ (HType (Reify (E tag)), cases) =
310 gdeconstructADT
310 gdeconstructADT
311 @(TTable (Reify Expr))
311 @(TTable (Reify Expr))
312 @TColumns
312 @TColumns
@@ -316,7 +316,7 @@ ggdeconstruct gtoColumns = case algebraSing @algebra of
316 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
316 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
317 (\SSpec {nullity} -> case nullity of
317 (\SSpec {nullity} -> case nullity of
318 Null -> id
318 Null -> id
319− NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a)))
319+ NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a)))
320 constructors $
320 constructors $
321 hreify $
321 hreify $
322 gtoColumns as
322 gtoColumns as
@@ -358,8 +358,8 @@ ggname gfromColumns = case algebraSing @algebra of
358 @(Col (Reify Name))
358 @(Col (Reify Name))
359 @(Eval (rep (Reify Name)))
359 @(Eval (rep (Reify Name)))
360 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
360 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
361− (\_ _ (Reify (NameCol a)) -> Reify (NameCol a))
361+ (\_ _ (Reify (N (Name a))) -> Reify (N (Name a)))
362− (HType ((\(Name a) -> Reify (NameCol a)) tag))
362+ (HType (Reify (N tag)))
363
363
364
364
365type GGAggregate :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
365type GGAggregate :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type
@@ -418,9 +418,9 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
418 @(Col (Reify Expr))
418 @(Col (Reify Expr))
419 @(Eval (rep (Reify Expr)))
419 @(Eval (rep (Reify Expr)))
420 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
420 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
421− (\tag'' SSpec {nullity} (Reify (DB a)) ->
421+ (\tag'' SSpec {nullity} (Reify (E a)) ->
422− Reify $ DB $ runTag nullity (tag ==. litExpr tag'') a)
422+ Reify $ E $ runTag nullity (tag ==. litExpr tag'') a)
423− (HType (Reify (DB tag'))))
423+ (HType (Reify (E tag'))))
424 (groupByExpr tag) .
424 (groupByExpr tag) .
425 gftraverse @TUnreify @(Eval (rep (Reify Expr))) @_ @Aggregate (MaybeApply . Left)
425 gftraverse @TUnreify @(Eval (rep (Reify Expr))) @_ @Aggregate (MaybeApply . Left)
426 where
426 where
@@ -428,7 +428,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
428 gfindex @TUnreify @(Eval (rep (Reify Expr))) @(Aggregate a) .
428 gfindex @TUnreify @(Eval (rep (Reify Expr))) @(Aggregate a) .
429 agg .
429 agg .
430 gftabulate @(Compose Aggregate TUnreify) @(Eval (rep (Reify Expr))) @(Aggregate a)
430 gftabulate @(Compose Aggregate TUnreify) @(Eval (rep (Reify Expr))) @(Aggregate a)
431− (HType (Reify (DB tag)), exprs) =
431+ (HType (Reify (E tag)), exprs) =
432 gunbuildADT
432 gunbuildADT
433 @(TTable (Reify Expr))
433 @(TTable (Reify Expr))
434 @TColumns
434 @TColumns
@@ -438,7 +438,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of
438 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
438 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
439 (\SSpec {nullity} -> case nullity of
439 (\SSpec {nullity} -> case nullity of
440 Null -> id
440 Null -> id
441− NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a))) $
441+ NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a))) $
442 hreify $
442 hreify $
443 gtoColumns es
443 gtoColumns es
444
444
@@ -493,15 +493,15 @@ ggaggregate' gfromColumns gtoColumns agg es = case algebraSing @algebra of
493 @(Col (Reify Aggregate))
493 @(Col (Reify Aggregate))
494 @(Eval (rep (Reify Aggregate)))
494 @(Eval (rep (Reify Aggregate)))
495 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
495 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)
496− (\tag' SSpec {nullity} (Reify (Aggregation a)) ->
496+ (\tag' SSpec {nullity} (Reify (A a)) ->
497− Reify $ Aggregation $ runTag nullity (tag ==. litExpr tag') <$> a)
497+ Reify $ A $ runTag nullity (tag ==. litExpr tag') <$> a)
498− (HType (Reify (Aggregation (groupByExpr tag))))
498+ (HType (Reify (A (groupByExpr tag))))
499 where
499 where
500 f =
500 f =
501 gfindex @TUnreify @(Eval (rep (Reify Expr))) @agg .
501 gfindex @TUnreify @(Eval (rep (Reify Expr))) @agg .
502 agg .
502 agg .
503 gftabulate @TUnreify @(Eval (rep (Reify Aggregate))) @agg
503 gftabulate @TUnreify @(Eval (rep (Reify Aggregate))) @agg
504− (HType (Reify (DB tag)), exprs) =
504+ (HType (Reify (E tag)), exprs) =
505 gunbuildADT
505 gunbuildADT
506 @(TTable (Reify Expr))
506 @(TTable (Reify Expr))
507 @TColumns
507 @TColumns
@@ -511,7 +511,7 @@ ggaggregate' gfromColumns gtoColumns agg es = case algebraSing @algebra of
511 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
511 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)
512 (\SSpec {nullity} -> case nullity of
512 (\SSpec {nullity} -> case nullity of
513 Null -> id
513 Null -> id
514− NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a))) $
514+ NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a))) $
515 hreify $
515 hreify $
516 gtoColumns es
516 gtoColumns es
517
517
src/Rel8/Generic/Table/ADT.hs+3−3
@@ -47,7 +47,7 @@ import qualified Rel8.Schema.Kind as K
47import Rel8.Schema.Null ( Nullify )
47import Rel8.Schema.Null ( Nullify )
48import Rel8.Schema.Spec ( Spec( Spec ), SSpec )
48import Rel8.Schema.Spec ( Spec( Spec ), SSpec )
49import Rel8.Schema.Result
49import Rel8.Schema.Result
50− ( Col( Result ), Result
50+ ( Col( R ), Result
51 , null, nullifier, unnullifier
51 , null, nullifier, unnullifier
52 )
52 )
53import Rel8.Type.Tag ( Tag( Tag ) )
53import Rel8.Type.Tag ( Tag( Tag ) )
@@ -219,12 +219,12 @@ instance
219 Just rep -> M1 rep
219 Just rep -> M1 rep
220 _ -> error "ADT.fromColumns: mismatch between tag and data"
220 _ -> error "ADT.fromColumns: mismatch between tag and data"
221 where
221 where
222− tag = (\(HType (Result a)) -> a) . hunlabel @_ @"tag" unlabeler
222+ tag = (\(HType (R a)) -> a) . hunlabel @_ @"tag" unlabeler
223
223
224 gtoResultADT toResult (M1 rep) =
224 gtoResultADT toResult (M1 rep) =
225 gtoResultADT' @_ToExprs @_Columns @_ @exprs toResult tag (Just rep)
225 gtoResultADT' @_ToExprs @_Columns @_ @exprs toResult tag (Just rep)
226 where
226 where
227− tag = hlabel @_ @"tag" labeler . HType . Result
227+ tag = hlabel @_ @"tag" labeler . HType . R
228
228
229
229
230type GToExprsADT'
230type GToExprsADT'
src/Rel8/Query/SQL.hs+4−4
@@ -23,11 +23,11 @@ import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
23import qualified Opaleye.Internal.Sql as Opaleye
23import qualified Opaleye.Internal.Sql as Opaleye
24
24
25-- rel8
25-- rel8
26−import Rel8.Expr ( Expr, Col(..) )
26+import Rel8.Expr ( Expr, Col( E ) )
27import Rel8.Expr.Opaleye ( toPrimExpr )
27import Rel8.Expr.Opaleye ( toPrimExpr )
28import Rel8.Query ( Query )
28import Rel8.Query ( Query )
29import Rel8.Query.Opaleye ( toOpaleye )
29import Rel8.Query.Opaleye ( toOpaleye )
30−import Rel8.Schema.Name ( Selects, Col(..) )
30+import Rel8.Schema.Name ( Name( Name ), Selects, Col( N ) )
31import Rel8.Schema.HTable ( htabulateA, hfield )
31import Rel8.Schema.HTable ( htabulateA, hfield )
32import Rel8.Table ( Table, toColumns )
32import Rel8.Table ( Table, toColumns )
33import Rel8.Table.Name ( namesFromLabels )
33import Rel8.Table.Name ( namesFromLabels )
@@ -68,7 +68,7 @@ selectFrom (toColumns -> names) (toColumns . castTable -> exprs) query =
68 where
68 where
69 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query
69 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query
70 attributes = getConst $ htabulateA $ \field -> case hfield names field of
70 attributes = getConst $ htabulateA $ \field -> case hfield names field of
71− NameCol name -> case hfield exprs field of
71+ N (Name name) -> case hfield exprs field of
72− DB (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))
72+ E (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))
73 makeAttr label expr =
73 makeAttr label expr =
74 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))
74 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))
src/Rel8/Schema/Context/Label.hs+3−3
@@ -19,7 +19,7 @@ import Rel8.Schema.Context ( Interpretation )
19import Rel8.Schema.Dict ( Dict( Dict ) )
19import Rel8.Schema.Dict ( Dict( Dict ) )
20import Rel8.Schema.Kind ( Context, HContext )
20import Rel8.Schema.Kind ( Context, HContext )
21import Rel8.Schema.Spec ( Spec( Spec ) )
21import Rel8.Schema.Spec ( Spec( Spec ) )
22−import Rel8.Schema.Result ( Col( Result ), Result )
22+import Rel8.Schema.Result ( Col( R ), Result )
23import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
23import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )
24
24
25
25
@@ -35,8 +35,8 @@ class Interpretation context => Labelable context where
35
35
36
36
37instance Labelable Result where
37instance Labelable Result where
38− labeler (Result a) = Result a
38+ labeler (R a) = R a
39− unlabeler (Result a) = Result a
39+ unlabeler (R a) = R a
40
40
41
41
42type HLabelable :: HContext -> Constraint
42type HLabelable :: HContext -> Constraint
src/Rel8/Schema/Context/Nullify.hs+18−18
@@ -25,18 +25,18 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
25
25
26-- rel8
26-- rel8
27import Rel8.Aggregate
27import Rel8.Aggregate
28− ( Aggregate, Col(..)
28+ ( Aggregate, Col( A )
29 , mapInputs
29 , mapInputs
30 , unsafeMakeAggregate
30 , unsafeMakeAggregate
31 )
31 )
32−import Rel8.Expr ( Expr, Col(..) )
32+import Rel8.Expr ( Expr, Col( E ) )
33import Rel8.Expr.Bool ( boolExpr )
33import Rel8.Expr.Bool ( boolExpr )
34import Rel8.Expr.Null ( nullify, unsafeUnnullify )
34import Rel8.Expr.Null ( nullify, unsafeUnnullify )
35import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
35import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
36import Rel8.Kind.Necessity ( Necessity( Required ) )
36import Rel8.Kind.Necessity ( Necessity( Required ) )
37import Rel8.Schema.Context ( Interpretation )
37import Rel8.Schema.Context ( Interpretation )
38import qualified Rel8.Schema.Kind as K
38import qualified Rel8.Schema.Kind as K
39−import Rel8.Schema.Name ( Name( Name ), Col(..) )
39+import Rel8.Schema.Name ( Name( Name ), Col( N ) )
40import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql )
40import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql )
41import Rel8.Schema.Dict ( Dict( Dict ) )
41import Rel8.Schema.Dict ( Dict( Dict ) )
42import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
42import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
@@ -81,19 +81,19 @@ class Interpretation context => Nullifiable context where
81
81
82instance Nullifiable Aggregate where
82instance Nullifiable Aggregate where
83 encodeTag Tag {aggregator, expr} =
83 encodeTag Tag {aggregator, expr} =
84− Aggregation $ unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr
84+ A $ unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr
85
85
86− decodeTag (Aggregation aggregate) = fromAggregate aggregate
86+ decodeTag (A aggregate) = fromAggregate aggregate
87
87
88− nullifier Tag {expr} test SSpec {nullity} (Aggregation aggregate) =
88+ nullifier Tag {expr} test SSpec {nullity} (A aggregate) =
89− Aggregation $
89+ A $
90 mapInputs (toPrimExpr . runTag nullity condition . fromPrimExpr) $
90 mapInputs (toPrimExpr . runTag nullity condition . fromPrimExpr) $
91 runTag nullity condition <$> aggregate
91 runTag nullity condition <$> aggregate
92 where
92 where
93 condition = test expr
93 condition = test expr
94
94
95− unnullifier SSpec {nullity} (Aggregation aggregate) =
95+ unnullifier SSpec {nullity} (A aggregate) =
96− Aggregation $ unnull nullity <$> aggregate
96+ A $ unnull nullity <$> aggregate
97
97
98 {-# INLINABLE encodeTag #-}
98 {-# INLINABLE encodeTag #-}
99 {-# INLINABLE decodeTag #-}
99 {-# INLINABLE decodeTag #-}
@@ -102,11 +102,11 @@ instance Nullifiable Aggregate where
102
102
103
103
104instance Nullifiable Expr where
104instance Nullifiable Expr where
105− encodeTag Tag {expr} = DB expr
105+ encodeTag Tag {expr} = E expr
106− decodeTag (DB a) = fromExpr a
106+ decodeTag (E a) = fromExpr a
107− nullifier Tag {expr} test SSpec {nullity} (DB a) =
107+ nullifier Tag {expr} test SSpec {nullity} (E a) =
108− DB $ runTag nullity (test expr) a
108+ E $ runTag nullity (test expr) a
109− unnullifier SSpec {nullity} (DB a) = DB $ unnull nullity a
109+ unnullifier SSpec {nullity} (E a) = E $ unnull nullity a
110
110
111 {-# INLINABLE encodeTag #-}
111 {-# INLINABLE encodeTag #-}
112 {-# INLINABLE decodeTag #-}
112 {-# INLINABLE decodeTag #-}
@@ -115,10 +115,10 @@ instance Nullifiable Expr where
115
115
116
116
117instance Nullifiable Name where
117instance Nullifiable Name where
118− encodeTag Tag {name = Name name} = NameCol name
118+ encodeTag Tag {name} = N name
119− decodeTag (NameCol name) = fromName (Name name)
119+ decodeTag (N name) = fromName name
120− nullifier _ _ _ (NameCol name) = NameCol name
120+ nullifier _ _ _ (N (Name name)) = N (Name name)
121− unnullifier _ (NameCol name) = NameCol name
121+ unnullifier _ (N (Name name)) = N (Name name)
122
122
123 {-# INLINABLE encodeTag #-}
123 {-# INLINABLE encodeTag #-}
124 {-# INLINABLE decodeTag #-}
124 {-# INLINABLE decodeTag #-}
src/Rel8/Schema/Insert.hs+13−13
@@ -15,7 +15,7 @@
15module Rel8.Schema.Insert
15module Rel8.Schema.Insert
16 ( Insert(..)
16 ( Insert(..)
17 , OnConflict(..)
17 , OnConflict(..)
18− , Col( InsertCol )
18+ , Col( I, unI )
19 , Inserts
19 , Inserts
20 , Insertion(..)
20 , Insertion(..)
21 )
21 )
@@ -79,7 +79,7 @@ data Insert a where
79
79
80instance Interpretation Insert where
80instance Interpretation Insert where
81 data Col Insert _spec where
81 data Col Insert _spec where
82− InsertCol :: Insertion necessity a -> Col Insert ('Spec labels necessity a)
82+ I :: {unI :: !(Insertion necessity a)} -> Col Insert ('Spec labels necessity a)
83
83
84
84
85type Insertion :: Necessity -> Type -> Type
85type Insertion :: Necessity -> Type -> Type
@@ -94,8 +94,8 @@ instance (KnownNecessity necessity, Sql DBType a) =>
94 type Columns (Insertion necessity a) = HIdentity ('Spec '[] necessity a)
94 type Columns (Insertion necessity a) = HIdentity ('Spec '[] necessity a)
95 type Context (Insertion necessity a) = Insert
95 type Context (Insertion necessity a) = Insert
96
96
97− toColumns = HIdentity . InsertCol
97+ toColumns = HIdentity . I
98− fromColumns (HIdentity (InsertCol a)) = a
98+ fromColumns (HIdentity (I a)) = a
99 reify = notReify
99 reify = notReify
100 unreify = notReify
100 unreify = notReify
101
101
@@ -132,25 +132,25 @@ instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion 'Requir
132
132
133
133
134instance Labelable Insert where
134instance Labelable Insert where
135− labeler (InsertCol a) = InsertCol a
135+ labeler (I a) = I a
136− unlabeler (InsertCol a) = InsertCol a
136+ unlabeler (I a) = I a
137
137
138
138
139instance Nullifiable Insert where
139instance Nullifiable Insert where
140− encodeTag = InsertCol . Insertion . expr
140+ encodeTag = I . Insertion . expr
141
141
142− decodeTag (InsertCol (Insertion a)) = fromExpr a
142+ decodeTag (I (Insertion a)) = fromExpr a
143
143
144 nullifier Tag {expr} test SSpec {nullity} = \case
144 nullifier Tag {expr} test SSpec {nullity} = \case
145− InsertCol Default -> InsertCol Default
145+ I Default -> I Default
146− InsertCol (Insertion a) ->
146+ I (Insertion a) ->
147− InsertCol $ Insertion $ runTag nullity condition a
147+ I $ Insertion $ runTag nullity condition a
148 where
148 where
149 condition = test expr
149 condition = test expr
150
150
151 unnullifier SSpec {nullity} = \case
151 unnullifier SSpec {nullity} = \case
152− InsertCol Default -> InsertCol Default
152+ I Default -> I Default
153− InsertCol (Insertion a) -> InsertCol $ Insertion $ unnull nullity a
153+ I (Insertion a) -> I $ Insertion $ unnull nullity a
154
154
155 {-# INLINABLE encodeTag #-}
155 {-# INLINABLE encodeTag #-}
156 {-# INLINABLE decodeTag #-}
156 {-# INLINABLE decodeTag #-}
src/Rel8/Schema/Name.hs+8−6
@@ -14,7 +14,7 @@
14
14
15module Rel8.Schema.Name
15module Rel8.Schema.Name
16 ( Name(..)
16 ( Name(..)
17− , Col( NameCol )
17+ , Col( N, unN )
18 , Selects
18 , Selects
19 )
19 )
20where
20where
@@ -33,6 +33,7 @@ import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )
33import Rel8.Schema.Null ( Sql )
33import Rel8.Schema.Null ( Sql )
34import Rel8.Schema.Reify ( notReify )
34import Rel8.Schema.Reify ( notReify )
35import Rel8.Schema.Result ( Result )
35import Rel8.Schema.Result ( Result )
36+import Rel8.Schema.Spec ( Spec( Spec ) )
36import Rel8.Table
37import Rel8.Table
37 ( Table, Columns, Context, fromColumns, toColumns, reify, unreify
38 ( Table, Columns, Context, fromColumns, toColumns, reify, unreify
38 )
39 )
@@ -60,8 +61,8 @@ instance Sql DBType a => Table Name (Name a) where
60 type Columns (Name a) = HType a
61 type Columns (Name a) = HType a
61 type Context (Name a) = Name
62 type Context (Name a) = Name
62
63
63− toColumns (Name a) = HType (NameCol a)
64+ toColumns a = HType (N a)
64− fromColumns (HType (NameCol a)) = Name a
65+ fromColumns (HType (N a)) = a
65 reify = notReify
66 reify = notReify
66 unreify = notReify
67 unreify = notReify
67
68
@@ -82,12 +83,13 @@ instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)
82
83
83
84
84instance Interpretation Name where
85instance Interpretation Name where
85− newtype Col Name _spec = NameCol String
86+ data Col Name _spec where
87+ N :: {unN :: !(Name a)} -> Col Name ('Spec labels necessity a)
86
88
87
89
88instance Labelable Name where
90instance Labelable Name where
89− labeler (NameCol a) = NameCol a
91+ labeler (N a) = N a
90− unlabeler (NameCol a) = NameCol a
92+ unlabeler (N a) = N a
91
93
92
94
93-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
95-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
src/Rel8/Schema/Result.hs+10−10
@@ -5,7 +5,7 @@
5{-# language TypeFamilies #-}
5{-# language TypeFamilies #-}
6
6
7module Rel8.Schema.Result
7module Rel8.Schema.Result
8− ( Col( Result ), Result
8+ ( Col( R, unR ), Result
9 , relabel
9 , relabel
10 , null, nullifier, unnullifier
10 , null, nullifier, unnullifier
11 , vectorizer, unvectorizer
11 , vectorizer, unvectorizer
@@ -30,24 +30,24 @@ data Result a
30
30
31instance Interpretation Result where
31instance Interpretation Result where
32 data Col Result _spec where
32 data Col Result _spec where
33− Result :: a -> Col Result ('Spec labels necessity a)
33+ R :: {unR :: !a} -> Col Result ('Spec labels necessity a)
34
34
35
35
36relabel :: ()
36relabel :: ()
37 => HIdentity ('Spec labels necessity a) (Col Result)
37 => HIdentity ('Spec labels necessity a) (Col Result)
38 -> HIdentity ('Spec relabels necessity a) (Col Result)
38 -> HIdentity ('Spec relabels necessity a) (Col Result)
39−relabel (HIdentity (Result a)) = HIdentity (Result a)
39+relabel (HIdentity (R a)) = HIdentity (R a)
40
40
41
41
42null :: Col Result ('Spec labels necessity (Maybe a))
42null :: Col Result ('Spec labels necessity (Maybe a))
43−null = Result Nothing
43+null = R Nothing
44
44
45
45
46nullifier :: ()
46nullifier :: ()
47 => SSpec ('Spec labels necessity a)
47 => SSpec ('Spec labels necessity a)
48 -> Col Result ('Spec labels necessity a)
48 -> Col Result ('Spec labels necessity a)
49 -> Col Result ('Spec labels necessity (Nullify a))
49 -> Col Result ('Spec labels necessity (Nullify a))
50−nullifier SSpec {nullity} (Result a) = Result $ case nullity of
50+nullifier SSpec {nullity} (R a) = R $ case nullity of
51 Null -> a
51 Null -> a
52 NotNull -> Just a
52 NotNull -> Just a
53
53
@@ -56,21 +56,21 @@ unnullifier :: ()
56 => SSpec ('Spec labels necessity a)
56 => SSpec ('Spec labels necessity a)
57 -> Col Result ('Spec labels necessity (Nullify a))
57 -> Col Result ('Spec labels necessity (Nullify a))
58 -> Maybe (Col Result ('Spec labels necessity a))
58 -> Maybe (Col Result ('Spec labels necessity a))
59−unnullifier SSpec {nullity} (Result a) =
59+unnullifier SSpec {nullity} (R a) =
60 case nullity of
60 case nullity of
61− Null -> pure $ Result a
61+ Null -> pure $ R a
62− NotNull -> Result <$> a
62+ NotNull -> R <$> a
63
63
64
64
65vectorizer :: Functor f
65vectorizer :: Functor f
66 => SSpec ('Spec labels necessity a)
66 => SSpec ('Spec labels necessity a)
67 -> f (Col Result ('Spec labels necessity a))
67 -> f (Col Result ('Spec labels necessity a))
68 -> Col Result ('Spec labels 'Required (f a))
68 -> Col Result ('Spec labels 'Required (f a))
69−vectorizer _ = Result . fmap (\(Result a) -> a)
69+vectorizer _ = R . fmap unR
70
70
71
71
72unvectorizer :: Functor f
72unvectorizer :: Functor f
73 => SSpec ('Spec labels necessity a)
73 => SSpec ('Spec labels necessity a)
74 -> Col Result ('Spec labels 'Required (f a))
74 -> Col Result ('Spec labels 'Required (f a))
75 -> f (Col Result ('Spec labels necessity a))
75 -> f (Col Result ('Spec labels necessity a))
76−unvectorizer _ (Result results) = Result <$> results
76+unvectorizer _ (R results) = R <$> results
src/Rel8/Table.hs+9−9
@@ -60,7 +60,7 @@ import Rel8.Schema.Reify
60 , notReify
60 , notReify
61 )
61 )
62import Rel8.Schema.Result
62import Rel8.Schema.Result
63− ( Col( Result ), Result
63+ ( Col( R ), Result
64 , relabel
64 , relabel
65 , null, nullifier, unnullifier
65 , null, nullifier, unnullifier
66 , vectorizer, unvectorizer
66 , vectorizer, unvectorizer
@@ -234,8 +234,8 @@ instance Sql DBType a => Table Result (Identity a) where
234 type Columns (Identity a) = HType a
234 type Columns (Identity a) = HType a
235 type Context (Identity a) = Result
235 type Context (Identity a) = Result
236
236
237− toColumns (Identity a) = HType (Result a)
237+ toColumns (Identity a) = HType (R a)
238− fromColumns (HType (Result a)) = Identity a
238+ fromColumns (HType (R a)) = Identity a
239
239
240 reify = notReify
240 reify = notReify
241 unreify = notReify
241 unreify = notReify
@@ -247,18 +247,18 @@ instance (Table Result a, Table Result b) => Table Result (Either a b) where
247
247
248 toColumns = \case
248 toColumns = \case
249 Left table -> HEitherTable
249 Left table -> HEitherTable
250− { htag = HIdentity (Result IsLeft)
250+ { htag = HIdentity (R IsLeft)
251 , hleft = hlabel labeler (hnullify nullifier (toColumns table))
251 , hleft = hlabel labeler (hnullify nullifier (toColumns table))
252 , hright = hlabel labeler (hnulls (const null))
252 , hright = hlabel labeler (hnulls (const null))
253 }
253 }
254 Right table -> HEitherTable
254 Right table -> HEitherTable
255− { htag = HIdentity (Result IsRight)
255+ { htag = HIdentity (R IsRight)
256 , hleft = hlabel labeler (hnulls (const null))
256 , hleft = hlabel labeler (hnulls (const null))
257 , hright = hlabel labeler (hnullify nullifier (toColumns table))
257 , hright = hlabel labeler (hnullify nullifier (toColumns table))
258 }
258 }
259
259
260 fromColumns HEitherTable {htag, hleft, hright} = case htag of
260 fromColumns HEitherTable {htag, hleft, hright} = case htag of
261− HIdentity (Result tag) -> case tag of
261+ HIdentity (R tag) -> case tag of
262 IsLeft -> maybe err (Left . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hleft)
262 IsLeft -> maybe err (Left . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hleft)
263 IsRight -> maybe err (Right . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hright)
263 IsRight -> maybe err (Right . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hright)
264 where
264 where
@@ -279,16 +279,16 @@ instance Table Result a => Table Result (Maybe a) where
279
279
280 toColumns = \case
280 toColumns = \case
281 Nothing -> HMaybeTable
281 Nothing -> HMaybeTable
282− { htag = HIdentity (Result Nothing)
282+ { htag = HIdentity (R Nothing)
283 , hjust = hlabel labeler (hnulls (const null))
283 , hjust = hlabel labeler (hnulls (const null))
284 }
284 }
285 Just table -> HMaybeTable
285 Just table -> HMaybeTable
286− { htag = HIdentity (Result (Just IsJust))
286+ { htag = HIdentity (R (Just IsJust))
287 , hjust = hlabel labeler (hnullify nullifier (toColumns table))
287 , hjust = hlabel labeler (hnullify nullifier (toColumns table))
288 }
288 }
289
289
290 fromColumns HMaybeTable {htag, hjust} = case htag of
290 fromColumns HMaybeTable {htag, hjust} = case htag of
291− HIdentity (Result tag) -> tag $>
291+ HIdentity (R tag) -> tag $>
292 case hunnullify unnullifier (hunlabel unlabeler hjust) of
292 case hunnullify unnullifier (hunlabel unlabeler hjust) of
293 Nothing -> error "Maybe.fromColumns: mismatch between tag and data"
293 Nothing -> error "Maybe.fromColumns: mismatch between tag and data"
294 Just just -> fromColumns just
294 Just just -> fromColumns just
src/Rel8/Table/Aggregate.hs+7−7
@@ -16,8 +16,8 @@ import Data.Functor.Identity ( Identity( Identity ) )
16import Prelude
16import Prelude
17
17
18-- rel8
18-- rel8
19−import Rel8.Aggregate ( Aggregate, Col(..) )
19+import Rel8.Aggregate ( Aggregate, Col( A ) )
20−import Rel8.Expr ( Expr, Col(..) )
20+import Rel8.Expr ( Expr, Col( E ) )
21import Rel8.Expr.Aggregate
21import Rel8.Expr.Aggregate
22 ( groupByExpr
22 ( groupByExpr
23 , listAggExpr
23 , listAggExpr
@@ -41,7 +41,7 @@ groupBy :: forall exprs. EqTable exprs => exprs -> Aggregate exprs
41groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
41groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
42 case hfield (eqTable @exprs) field of
42 case hfield (eqTable @exprs) field of
43 Dict -> case hfield exprs field of
43 Dict -> case hfield exprs field of
44− DB expr -> Aggregation $ groupByExpr expr
44+ E expr -> A $ groupByExpr expr
45
45
46
46
47-- | Aggregate rows into a single row containing an array of all aggregated
47-- | Aggregate rows into a single row containing an array of all aggregated
@@ -63,7 +63,7 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
63listAgg :: Table Expr a => a -> Aggregate (ListTable a)
63listAgg :: Table Expr a => a -> Aggregate (ListTable a)
64listAgg (toColumns -> exprs) = fromColumns $
64listAgg (toColumns -> exprs) = fromColumns $
65 hvectorize
65 hvectorize
66− (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)
66+ (\_ (Identity (E a)) -> A $ listAggExpr a)
67 (pure exprs)
67 (pure exprs)
68
68
69
69
@@ -71,7 +71,7 @@ listAgg (toColumns -> exprs) = fromColumns $
71nonEmptyAgg :: Table Expr a => a -> Aggregate (NonEmptyTable a)
71nonEmptyAgg :: Table Expr a => a -> Aggregate (NonEmptyTable a)
72nonEmptyAgg (toColumns -> exprs) = fromColumns $
72nonEmptyAgg (toColumns -> exprs) = fromColumns $
73 hvectorize
73 hvectorize
74− (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)
74+ (\_ (Identity (E a)) -> A $ nonEmptyAggExpr a)
75 (pure exprs)
75 (pure exprs)
76
76
77
77
@@ -79,7 +79,7 @@ listAggWithOrder :: Table Expr a
79 => Order o -> o -> a -> Aggregate (ListTable a)
79 => Order o -> o -> a -> Aggregate (ListTable a)
80listAggWithOrder order o (toColumns -> exprs) = fromColumns $
80listAggWithOrder order o (toColumns -> exprs) = fromColumns $
81 hvectorize
81 hvectorize
82− (\_ (Identity (DB x)) -> Aggregation $ listAggExprWithOrder order o x)
82+ (\_ (Identity (E x)) -> A $ listAggExprWithOrder order o x)
83 (pure exprs)
83 (pure exprs)
84
84
85
85
@@ -87,5 +87,5 @@ nonEmptyAggWithOrder :: Table Expr a
87 => Order o -> o -> a -> Aggregate (NonEmptyTable a)
87 => Order o -> o -> a -> Aggregate (NonEmptyTable a)
88nonEmptyAggWithOrder order o (toColumns -> exprs) = fromColumns $
88nonEmptyAggWithOrder order o (toColumns -> exprs) = fromColumns $
89 hvectorize
89 hvectorize
90− (\_ (Identity (DB x)) -> Aggregation $ nonEmptyAggExprWithOrder order o x)
90+ (\_ (Identity (E x)) -> A $ nonEmptyAggExprWithOrder order o x)
91 (pure exprs)
91 (pure exprs)
src/Rel8/Table/Bool.hs+6−6
@@ -13,7 +13,7 @@ where
13import Prelude
13import Prelude
14
14
15-- rel8
15-- rel8
16−import Rel8.Expr ( Expr, Col(..) )
16+import Rel8.Expr ( Expr, Col( E, unE ) )
17import Rel8.Expr.Bool ( boolExpr, caseExpr )
17import Rel8.Expr.Bool ( boolExpr, caseExpr )
18import Rel8.Expr.Null ( isNull, unsafeUnnullify )
18import Rel8.Expr.Null ( isNull, unsafeUnnullify )
19import Rel8.Schema.HTable ( htabulate, hfield )
19import Rel8.Schema.HTable ( htabulate, hfield )
@@ -28,8 +28,8 @@ bool :: Table Expr a => a -> a -> Expr Bool -> a
28bool (toColumns -> false) (toColumns -> true) condition =
28bool (toColumns -> false) (toColumns -> true) condition =
29 fromColumns $ htabulate $ \field ->
29 fromColumns $ htabulate $ \field ->
30 case (hfield false field, hfield true field) of
30 case (hfield false field, hfield true field) of
31− (DB falseExpr, DB trueExpr) ->
31+ (E falseExpr, E trueExpr) ->
32− DB (boolExpr falseExpr trueExpr condition)
32+ E (boolExpr falseExpr trueExpr condition)
33{-# INLINABLE bool #-}
33{-# INLINABLE bool #-}
34
34
35
35
@@ -39,9 +39,9 @@ bool (toColumns -> false) (toColumns -> true) condition =
39case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a
39case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a
40case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =
40case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =
41 fromColumns $ htabulate $ \field -> case hfield fallback field of
41 fromColumns $ htabulate $ \field -> case hfield fallback field of
42− DB fallbackExpr ->
42+ E fallbackExpr ->
43− case map (fmap (unDB . (`hfield` field))) branches of
43+ case map (fmap (unE . (`hfield` field))) branches of
44− branchExprs -> DB (caseExpr branchExprs fallbackExpr)
44+ branchExprs -> E (caseExpr branchExprs fallbackExpr)
45
45
46
46
47-- | Like 'maybe', but to eliminate @null@.
47-- | Like 'maybe', but to eliminate @null@.
src/Rel8/Table/Eq.hs+3−3
@@ -28,7 +28,7 @@ import GHC.Generics ( Rep )
28import Prelude
28import Prelude
29
29
30-- rel8
30-- rel8
31−import Rel8.Expr ( Expr, Col(..) )
31+import Rel8.Expr ( Expr, Col( E ) )
32import Rel8.Expr.Bool ( (||.), (&&.) )
32import Rel8.Expr.Bool ( (||.), (&&.) )
33import Rel8.Expr.Eq ( (==.), (/=.) )
33import Rel8.Expr.Eq ( (==.), (/=.) )
34import Rel8.FCF ( Eval, Exp )
34import Rel8.FCF ( Eval, Exp )
@@ -124,7 +124,7 @@ instance
124(toColumns -> as) ==: (toColumns -> bs) =
124(toColumns -> as) ==: (toColumns -> bs) =
125 foldl1' (&&.) $ getConst $ htabulateA $ \field ->
125 foldl1' (&&.) $ getConst $ htabulateA $ \field ->
126 case (hfield as field, hfield bs field) of
126 case (hfield as field, hfield bs field) of
127− (DB a, DB b) -> case hfield (eqTable @a) field of
127+ (E a, E b) -> case hfield (eqTable @a) field of
128 Dict -> Const (pure (a ==. b))
128 Dict -> Const (pure (a ==. b))
129infix 4 ==:
129infix 4 ==:
130
130
@@ -136,7 +136,7 @@ infix 4 ==:
136(toColumns -> as) /=: (toColumns -> bs) =
136(toColumns -> as) /=: (toColumns -> bs) =
137 foldl1' (||.) $ getConst $ htabulateA $ \field ->
137 foldl1' (||.) $ getConst $ htabulateA $ \field ->
138 case (hfield as field, hfield bs field) of
138 case (hfield as field, hfield bs field) of
139− (DB a, DB b) -> case hfield (eqTable @a) field of
139+ (E a, E b) -> case hfield (eqTable @a) field of
140 Dict -> Const (pure (a /=. b))
140 Dict -> Const (pure (a /=. b))
141infix 4 /=:
141infix 4 /=:
142
142
src/Rel8/Table/Insert.hs+5−5
@@ -13,10 +13,10 @@ where
13import Prelude
13import Prelude
14
14
15-- rel8
15-- rel8
16−import Rel8.Expr ( Col(..) )
16+import Rel8.Expr ( Col( E ) )
17import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )
17import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )
18import Rel8.Schema.HTable ( hfield, htabulate, hspecs )
18import Rel8.Schema.HTable ( hfield, htabulate, hspecs )
19−import Rel8.Schema.Insert ( Inserts, Col( InsertCol ), Insertion(..) )
19+import Rel8.Schema.Insert ( Inserts, Col( I ), Insertion(..) )
20import Rel8.Schema.Spec ( SSpec(..) )
20import Rel8.Schema.Spec ( SSpec(..) )
21import Rel8.Table ( fromColumns, toColumns )
21import Rel8.Table ( fromColumns, toColumns )
22
22
@@ -28,8 +28,8 @@ import Rel8.Table ( fromColumns, toColumns )
28toInsert :: Inserts exprs inserts => exprs -> inserts
28toInsert :: Inserts exprs inserts => exprs -> inserts
29toInsert (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
29toInsert (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
30 case hfield hspecs field of
30 case hfield hspecs field of
31− SSpec {} -> InsertCol $ case hfield exprs field of
31+ SSpec {} -> I $ case hfield exprs field of
32− DB expr -> Insertion expr
32+ E expr -> Insertion expr
33
33
34
34
35-- | @toInsertDefaults@ converts a 'Table' of 'Expr's into a 'Table' that can
35-- | @toInsertDefaults@ converts a 'Table' of 'Expr's into a 'Table' that can
@@ -44,6 +44,6 @@ toInsertDefaults :: Inserts exprs inserts => exprs -> inserts
44toInsertDefaults (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
44toInsertDefaults (toColumns -> exprs) = fromColumns $ htabulate $ \field ->
45 case hfield hspecs field of
45 case hfield hspecs field of
46 SSpec {necessity} -> case hfield exprs field of
46 SSpec {necessity} -> case hfield exprs field of
47− DB expr -> InsertCol $ case necessity of
47+ E expr -> I $ case necessity of
48 SRequired -> Insertion expr
48 SRequired -> Insertion expr
49 SOptional -> Default
49 SOptional -> Default
src/Rel8/Table/List.hs+6−6
@@ -21,13 +21,13 @@ import Data.Type.Equality ( (:~:)( Refl ) )
21import Prelude
21import Prelude
22
22
23-- rel8
23-- rel8
24−import Rel8.Expr ( Expr, Col(..) )
24+import Rel8.Expr ( Expr, Col( E, unE ) )
25import Rel8.Expr.Array ( sappend, sempty, slistOf )
25import Rel8.Expr.Array ( sappend, sempty, slistOf )
26import Rel8.Schema.Dict ( Dict( Dict ) )
26import Rel8.Schema.Dict ( Dict( Dict ) )
27import Rel8.Schema.HTable.List ( HListTable )
27import Rel8.Schema.HTable.List ( HListTable )
28import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
28import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize )
29import Rel8.Schema.Insert ( Inserts )
29import Rel8.Schema.Insert ( Inserts )
30−import Rel8.Schema.Name ( Col( NameCol ), Name )
30+import Rel8.Schema.Name ( Col( N ), Name( Name ) )
31import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
31import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
32import Rel8.Schema.Spec ( SSpec(..) )
32import Rel8.Schema.Spec ( SSpec(..) )
33import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
33import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )
@@ -112,18 +112,18 @@ instance AlternativeTable ListTable where
112
112
113instance Table Expr a => Semigroup (ListTable a) where
113instance Table Expr a => Semigroup (ListTable a) where
114 ListTable as <> ListTable bs = ListTable $
114 ListTable as <> ListTable bs = ListTable $
115− happend (\_ _ (DB a) (DB b) -> DB (sappend a b)) as bs
115+ happend (\_ _ (E a) (E b) -> E (sappend a b)) as bs
116
116
117
117
118instance Table Expr a => Monoid (ListTable a) where
118instance Table Expr a => Monoid (ListTable a) where
119 mempty = ListTable $ hempty $ \nullability info ->
119 mempty = ListTable $ hempty $ \nullability info ->
120− DB (sempty nullability info)
120+ E (sempty nullability info)
121
121
122
122
123listTable :: Table Expr a => [a] -> ListTable a
123listTable :: Table Expr a => [a] -> ListTable a
124listTable =
124listTable =
125 ListTable .
125 ListTable .
126− hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .
126+ hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) .
127 fmap toColumns
127 fmap toColumns
128
128
129
129
@@ -134,6 +134,6 @@ insertListTable = toInsert . listTable
134nameListTable :: Table Name a => a -> ListTable a
134nameListTable :: Table Name a => a -> ListTable a
135nameListTable =
135nameListTable =
136 ListTable .
136 ListTable .
137− hvectorize (\_ (Identity (NameCol a)) -> NameCol a) .
137+ hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
138 pure .
138 pure .
139 toColumns
139 toColumns
src/Rel8/Table/Name.hs+5−5
@@ -24,11 +24,11 @@ import Prelude
24import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
24import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
25
25
26-- rel8
26-- rel8
27−import Rel8.Expr ( Expr, Col(..) )
27+import Rel8.Expr ( Expr, Col( E ) )
28import Rel8.Expr.Opaleye ( toPrimExpr )
28import Rel8.Expr.Opaleye ( toPrimExpr )
29import Rel8.Kind.Labels ( renderLabels )
29import Rel8.Kind.Labels ( renderLabels )
30import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
30import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
31−import Rel8.Schema.Name ( Name, Col(..) )
31+import Rel8.Schema.Name ( Name( Name ), Col( N ) )
32import Rel8.Schema.Spec ( SSpec(..) )
32import Rel8.Schema.Spec ( SSpec(..) )
33import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
33import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
34
34
@@ -43,14 +43,14 @@ namesFromLabelsWith :: Table Name a
43 => (NonEmpty String -> String) -> a
43 => (NonEmpty String -> String) -> a
44namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
44namesFromLabelsWith f = fromColumns $ htabulate $ \field ->
45 case hfield hspecs field of
45 case hfield hspecs field of
46− SSpec {labels} -> NameCol (f (renderLabels labels))
46+ SSpec {labels} -> N (Name (f (renderLabels labels)))
47
47
48
48
49showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]
49showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]
50showExprs as = case (namesFromLabels, toColumns as) of
50showExprs as = case (namesFromLabels, toColumns as) of
51 (names, exprs) -> getConst $ htabulateA $ \field ->
51 (names, exprs) -> getConst $ htabulateA $ \field ->
52 case (hfield names field, hfield exprs field) of
52 case (hfield names field, hfield exprs field) of
53− (NameCol name, DB expr) -> Const [(name, toPrimExpr expr)]
53+ (N (Name name), E expr) -> Const [(name, toPrimExpr expr)]
54
54
55
55
56showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
56showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]
@@ -62,4 +62,4 @@ showLabels _ = getConst $
62showNames :: forall a. Table Name a => a -> [String]
62showNames :: forall a. Table Name a => a -> [String]
63showNames (toColumns -> names) = getConst $
63showNames (toColumns -> names) = getConst $
64 htabulateA @(Columns a) $ \field -> case hfield names field of
64 htabulateA @(Columns a) $ \field -> case hfield names field of
65− NameCol name -> Const [name]
65+ N (Name name) -> Const [name]
src/Rel8/Table/NonEmpty.hs+5−5
@@ -22,13 +22,13 @@ import Data.Type.Equality ( (:~:)( Refl ) )
22import Prelude
22import Prelude
23
23
24-- rel8
24-- rel8
25−import Rel8.Expr ( Expr, Col(..) )
25+import Rel8.Expr ( Expr, Col( E, unE ) )
26import Rel8.Expr.Array ( sappend1, snonEmptyOf )
26import Rel8.Expr.Array ( sappend1, snonEmptyOf )
27import Rel8.Schema.Dict ( Dict( Dict ) )
27import Rel8.Schema.Dict ( Dict( Dict ) )
28import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
28import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
29import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
29import Rel8.Schema.HTable.Vectorize ( happend, hvectorize )
30import Rel8.Schema.Insert ( Inserts )
30import Rel8.Schema.Insert ( Inserts )
31−import Rel8.Schema.Name ( Col( NameCol ), Name )
31+import Rel8.Schema.Name ( Col( N ), Name( Name ) )
32import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
32import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
33import Rel8.Schema.Reify ( hreify, hunreify )
33import Rel8.Schema.Reify ( hreify, hunreify )
34import Rel8.Schema.Spec ( SSpec(..) )
34import Rel8.Schema.Spec ( SSpec(..) )
@@ -108,13 +108,13 @@ instance AltTable NonEmptyTable where
108
108
109instance Table Expr a => Semigroup (NonEmptyTable a) where
109instance Table Expr a => Semigroup (NonEmptyTable a) where
110 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
110 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $
111− happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs
111+ happend (\_ _ (E a) (E b) -> E (sappend1 a b)) as bs
112
112
113
113
114nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
114nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a
115nonEmptyTable =
115nonEmptyTable =
116 NonEmptyTable .
116 NonEmptyTable .
117− hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .
117+ hvectorize (\SSpec {info} -> E . snonEmptyOf info . fmap unE) .
118 fmap toColumns
118 fmap toColumns
119
119
120
120
@@ -126,6 +126,6 @@ insertNonEmptyTable = toInsert . nonEmptyTable
126nameNonEmptyTable :: Table Name a => a -> NonEmptyTable a
126nameNonEmptyTable :: Table Name a => a -> NonEmptyTable a
127nameNonEmptyTable =
127nameNonEmptyTable =
128 NonEmptyTable .
128 NonEmptyTable .
129− hvectorize (\_ (Identity (NameCol a)) -> NameCol a) .
129+ hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .
130 pure .
130 pure .
131 toColumns
131 toColumns
src/Rel8/Table/Opaleye.hs+14−14
@@ -45,8 +45,8 @@ import Rel8.Expr.Opaleye
45 )
45 )
46import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )
46import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )
47import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )
47import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )
48−import Rel8.Schema.Insert ( Insert, Inserts, Col( InsertCol ), Insertion(..) )
48+import Rel8.Schema.Insert ( Insert, Inserts, Col( I ), Insertion(..) )
49−import Rel8.Schema.Name ( Name, Selects, Col(..) )
49+import Rel8.Schema.Name ( Name( Name ), Selects, Col( N ) )
50import Rel8.Schema.Spec ( SSpec(..) )
50import Rel8.Schema.Spec ( SSpec(..) )
51import Rel8.Schema.Table ( TableSchema(..) )
51import Rel8.Schema.Table ( TableSchema(..) )
52import Rel8.Table ( Table, fromColumns, toColumns )
52import Rel8.Table ( Table, fromColumns, toColumns )
@@ -66,7 +66,7 @@ binaryspec = Opaleye.Binaryspec $ Opaleye.PackMap $ \f (as, bs) ->
66 fmap fromColumns $ unwrapApplicative $ htabulateA $ \field ->
66 fmap fromColumns $ unwrapApplicative $ htabulateA $ \field ->
67 WrapApplicative $
67 WrapApplicative $
68 case (hfield (toColumns as) field, hfield (toColumns bs) field) of
68 case (hfield (toColumns as) field, hfield (toColumns bs) field) of
69− (DB a, DB b) -> DB . fromPrimExpr <$> f (toPrimExpr a, toPrimExpr b)
69+ (E a, E b) -> E . fromPrimExpr <$> f (toPrimExpr a, toPrimExpr b)
70
70
71
71
72distinctspec :: Table Expr a => Opaleye.Distinctspec a a
72distinctspec :: Table Expr a => Opaleye.Distinctspec a a
@@ -75,8 +75,8 @@ distinctspec =
75 fmap fromColumns .
75 fmap fromColumns .
76 unwrapApplicative .
76 unwrapApplicative .
77 htraverse
77 htraverse
78− (\(DB a) ->
78+ (\(E a) ->
79− WrapApplicative $ DB . fromPrimExpr <$> f (Nothing, toPrimExpr a)) .
79+ WrapApplicative $ E . fromPrimExpr <$> f (Nothing, toPrimExpr a)) .
80 toColumns
80 toColumns
81
81
82
82
@@ -97,14 +97,14 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $
97 name -> lmap (`hfield` field) (go specs name)
97 name -> lmap (`hfield` field) (go specs name)
98 where
98 where
99 go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)
99 go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)
100− go SSpec {necessity} (NameCol name) = case necessity of
100+ go SSpec {necessity} (N (Name name)) = case necessity of
101 SRequired ->
101 SRequired ->
102− lmap (\(InsertCol (Insertion a)) -> toColumn $ toPrimExpr a) $
102+ lmap (\(I (Insertion a)) -> toColumn $ toPrimExpr a) $
103− DB . fromPrimExpr . fromColumn <$>
103+ E . fromPrimExpr . fromColumn <$>
104 Opaleye.requiredTableField name
104 Opaleye.requiredTableField name
105 SOptional ->
105 SOptional ->
106− lmap (\(InsertCol ma) -> toColumn . toPrimExpr <$> fromInsert ma) $
106+ lmap (\(I ma) -> toColumn . toPrimExpr <$> fromInsert ma) $
107− DB . fromPrimExpr . fromColumn <$>
107+ E . fromPrimExpr . fromColumn <$>
108 Opaleye.optionalTableField name
108 Opaleye.optionalTableField name
109 where
109 where
110 fromInsert = \case
110 fromInsert = \case
@@ -116,7 +116,7 @@ unpackspec :: Table Expr a => Opaleye.Unpackspec a a
116unpackspec = Opaleye.Unpackspec $ Opaleye.PackMap $ \f ->
116unpackspec = Opaleye.Unpackspec $ Opaleye.PackMap $ \f ->
117 fmap fromColumns .
117 fmap fromColumns .
118 unwrapApplicative .
118 unwrapApplicative .
119− htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) .
119+ htraverse (\(E a) -> WrapApplicative $ E <$> traversePrimExpr f a) .
120 toColumns
120 toColumns
121{-# INLINABLE unpackspec #-}
121{-# INLINABLE unpackspec #-}
122
122
@@ -130,7 +130,7 @@ toPackMap :: Table Expr a
130toPackMap as = Opaleye.PackMap $ \f () ->
130toPackMap as = Opaleye.PackMap $ \f () ->
131 fmap fromColumns $
131 fmap fromColumns $
132 unwrapApplicative .
132 unwrapApplicative .
133− htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) $
133+ htraverse (\(E a) -> WrapApplicative $ E <$> traversePrimExpr f a) $
134 toColumns as
134 toColumns as
135
135
136
136
@@ -142,5 +142,5 @@ castTable (toColumns -> as) = fromColumns $ htabulate \i ->
142 case hfield hspecs i of
142 case hfield hspecs i of
143 SSpec{info} ->
143 SSpec{info} ->
144 case hfield as i of
144 case hfield as i of
145− DB expr ->
145+ E expr ->
146− DB (scastExpr info expr)
146+ E (scastExpr info expr)
src/Rel8/Table/Ord.hs+5−5
@@ -25,7 +25,7 @@ import GHC.Generics ( Rep )
25import Prelude hiding ( seq )
25import Prelude hiding ( seq )
26
26
27-- rel8
27-- rel8
28−import Rel8.Expr ( Expr, Col(..) )
28+import Rel8.Expr ( Expr, Col( E ) )
29import Rel8.Expr.Bool ( (||.), (&&.), false, true )
29import Rel8.Expr.Bool ( (||.), (&&.), false, true )
30import Rel8.Expr.Eq ( (==.) )
30import Rel8.Expr.Eq ( (==.) )
31import Rel8.Expr.Ord ( (<.), (>.) )
31import Rel8.Expr.Ord ( (<.), (>.) )
@@ -127,7 +127,7 @@ instance
127(toColumns -> as) <: (toColumns -> bs) =
127(toColumns -> as) <: (toColumns -> bs) =
128 foldr @[] go false $ getConst $ htabulateA $ \field ->
128 foldr @[] go false $ getConst $ htabulateA $ \field ->
129 case (hfield as field, hfield bs field) of
129 case (hfield as field, hfield bs field) of
130− (DB a, DB b) -> case hfield (ordTable @a) field of
130+ (E a, E b) -> case hfield (ordTable @a) field of
131 Dict -> Const [(a <. b, a ==. b)]
131 Dict -> Const [(a <. b, a ==. b)]
132 where
132 where
133 go (lt, eq) a = lt ||. (eq &&. a)
133 go (lt, eq) a = lt ||. (eq &&. a)
@@ -140,7 +140,7 @@ infix 4 <:
140(toColumns -> as) <=: (toColumns -> bs) =
140(toColumns -> as) <=: (toColumns -> bs) =
141 foldr @[] go true $ getConst $ htabulateA $ \field ->
141 foldr @[] go true $ getConst $ htabulateA $ \field ->
142 case (hfield as field, hfield bs field) of
142 case (hfield as field, hfield bs field) of
143− (DB a, DB b) -> case hfield (ordTable @a) field of
143+ (E a, E b) -> case hfield (ordTable @a) field of
144 Dict -> Const [(a <. b, a ==. b)]
144 Dict -> Const [(a <. b, a ==. b)]
145 where
145 where
146 go (lt, eq) a = lt ||. (eq &&. a)
146 go (lt, eq) a = lt ||. (eq &&. a)
@@ -153,7 +153,7 @@ infix 4 <=:
153(toColumns -> as) >: (toColumns -> bs) =
153(toColumns -> as) >: (toColumns -> bs) =
154 foldr @[] go false $ getConst $ htabulateA $ \field ->
154 foldr @[] go false $ getConst $ htabulateA $ \field ->
155 case (hfield as field, hfield bs field) of
155 case (hfield as field, hfield bs field) of
156− (DB a, DB b) -> case hfield (ordTable @a) field of
156+ (E a, E b) -> case hfield (ordTable @a) field of
157 Dict -> Const [(a >. b, a ==. b)]
157 Dict -> Const [(a >. b, a ==. b)]
158 where
158 where
159 go (gt, eq) a = gt ||. (eq &&. a)
159 go (gt, eq) a = gt ||. (eq &&. a)
@@ -166,7 +166,7 @@ infix 4 >:
166(toColumns -> as) >=: (toColumns -> bs) =
166(toColumns -> as) >=: (toColumns -> bs) =
167 foldr @[] go true $ getConst $ htabulateA $ \field ->
167 foldr @[] go true $ getConst $ htabulateA $ \field ->
168 case (hfield as field, hfield bs field) of
168 case (hfield as field, hfield bs field) of
169− (DB a, DB b) -> case hfield (ordTable @a) field of
169+ (E a, E b) -> case hfield (ordTable @a) field of
170 Dict -> Const [(a >. b, a ==. b)]
170 Dict -> Const [(a >. b, a ==. b)]
171 where
171 where
172 go (gt, eq) a = gt ||. (eq &&. a)
172 go (gt, eq) a = gt ||. (eq &&. a)
src/Rel8/Table/Order.hs+3−3
@@ -15,7 +15,7 @@ import Data.Functor.Contravariant ( (>$<), contramap )
15import Prelude
15import Prelude
16
16
17-- rel8
17-- rel8
18−import Rel8.Expr ( unDB )
18+import Rel8.Expr ( unE )
19import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )
19import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )
20import Rel8.Order ( Order )
20import Rel8.Order ( Order )
21import Rel8.Schema.Dict ( Dict( Dict ) )
21import Rel8.Schema.Dict ( Dict( Dict ) )
@@ -34,7 +34,7 @@ ascTable = contramap toColumns $ getConst $
34 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
34 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
35 SSpec {} -> case hfield (ordTable @a) field of
35 SSpec {} -> case hfield (ordTable @a) field of
36 dict@Dict -> case dbTypeDict dict of
36 dict@Dict -> case dbTypeDict dict of
37− Dict -> Const $ unDB . (`hfield` field) >$<
37+ Dict -> Const $ unE . (`hfield` field) >$<
38 case dbTypeNullity dict of
38 case dbTypeNullity dict of
39 Null -> nullsFirst asc
39 Null -> nullsFirst asc
40 NotNull -> asc
40 NotNull -> asc
@@ -47,7 +47,7 @@ descTable = contramap toColumns $ getConst $
47 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
47 htabulateA @(Columns a) $ \field -> case hfield hspecs field of
48 SSpec {} -> case hfield (ordTable @a) field of
48 SSpec {} -> case hfield (ordTable @a) field of
49 dict@Dict -> case dbTypeDict dict of
49 dict@Dict -> case dbTypeDict dict of
50− Dict -> Const $ unDB . (`hfield` field) >$<
50+ Dict -> Const $ unE . (`hfield` field) >$<
51 case dbTypeNullity dict of
51 case dbTypeNullity dict of
52 Null -> nullsLast desc
52 Null -> nullsLast desc
53 NotNull -> desc
53 NotNull -> desc
src/Rel8/Table/Serialize.hs+12−12
@@ -30,7 +30,7 @@ import Prelude
30import qualified Hasql.Decoders as Hasql
30import qualified Hasql.Decoders as Hasql
31
31
32-- rel8
32-- rel8
33−import Rel8.Expr ( Expr, Col(..) )
33+import Rel8.Expr ( Expr, Col( E ) )
34import Rel8.Expr.Serialize ( slitExpr, sparseValue )
34import Rel8.Expr.Serialize ( slitExpr, sparseValue )
35import Rel8.FCF ( Eval, Exp )
35import Rel8.FCF ( Eval, Exp )
36import Rel8.Generic.Record ( Record(..) )
36import Rel8.Generic.Record ( Record(..) )
@@ -42,7 +42,7 @@ import Rel8.Kind.Algebra ( KnownAlgebra )
42import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )
42import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )
43import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
43import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )
44import Rel8.Schema.Null ( NotNull, Sql )
44import Rel8.Schema.Null ( NotNull, Sql )
45−import Rel8.Schema.Result ( Col( Result ), Result )
45+import Rel8.Schema.Result ( Col( R ), Result )
46import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
46import Rel8.Schema.Spec ( SSpec(..), KnownSpec )
47import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )
47import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )
48import Rel8.Type ( DBType )
48import Rel8.Type ( DBType )
@@ -96,25 +96,25 @@ type instance Eval (TToExprs exprs a) = ToExprs exprs a
96
96
97
97
98instance {-# OVERLAPPABLE #-} (Sql DBType a, x ~ Expr a) => ToExprs x a where
98instance {-# OVERLAPPABLE #-} (Sql DBType a, x ~ Expr a) => ToExprs x a where
99− fromResult (HType (Result a)) = a
99+ fromResult (HType (R a)) = a
100− toResult = HType . Result
100+ toResult = HType . R
101
101
102
102
103instance (Sql DBType a, x ~ [a]) => ToExprs (Expr x) [a] where
103instance (Sql DBType a, x ~ [a]) => ToExprs (Expr x) [a] where
104− fromResult (HType (Result a)) = a
104+ fromResult (HType (R a)) = a
105− toResult = HType . Result
105+ toResult = HType . R
106
106
107
107
108instance (Sql DBType a, NotNull a, x ~ Maybe a) => ToExprs (Expr x) (Maybe a)
108instance (Sql DBType a, NotNull a, x ~ Maybe a) => ToExprs (Expr x) (Maybe a)
109 where
109 where
110− fromResult (HType (Result a)) = a
110+ fromResult (HType (R a)) = a
111− toResult = HType . Result
111+ toResult = HType . R
112
112
113
113
114instance (Sql DBType a, NotNull a, x ~ NonEmpty a) => ToExprs (Expr x) (NonEmpty a)
114instance (Sql DBType a, NotNull a, x ~ NonEmpty a) => ToExprs (Expr x) (NonEmpty a)
115 where
115 where
116− fromResult (HType (Result a)) = a
116+ fromResult (HType (R a)) = a
117− toResult = HType . Result
117+ toResult = HType . R
118
118
119
119
120instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ (exprs1, exprs2)) =>
120instance (ToExprs exprs1 a, ToExprs exprs2 b, x ~ (exprs1, exprs2)) =>
@@ -234,10 +234,10 @@ litHTable :: HTable t => t (Col Result) -> t (Col Expr)
234litHTable as = htabulate $ \field ->
234litHTable as = htabulate $ \field ->
235 case hfield hspecs field of
235 case hfield hspecs field of
236 SSpec {nullity, info} -> case hfield as field of
236 SSpec {nullity, info} -> case hfield as field of
237− Result value -> DB (slitExpr nullity info value)
237+ R value -> E (slitExpr nullity info value)
238
238
239
239
240parseHTable :: HTable t => Hasql.Row (t (Col Result))
240parseHTable :: HTable t => Hasql.Row (t (Col Result))
241parseHTable = unwrapApplicative $ htabulateA $ \field ->
241parseHTable = unwrapApplicative $ htabulateA $ \field ->
242 WrapApplicative $ case hfield hspecs field of
242 WrapApplicative $ case hfield hspecs field of
243− SSpec {nullity, info} -> Result <$> sparseValue nullity info
243+ SSpec {nullity, info} -> R <$> sparseValue nullity info
src/Rel8/Table/Undefined.hs+3−3
@@ -11,7 +11,7 @@ where
11import Prelude hiding ( undefined )
11import Prelude hiding ( undefined )
12
12
13-- rel8
13-- rel8
14−import Rel8.Expr ( Expr, Col(..) )
14+import Rel8.Expr ( Expr, Col( E ) )
15import Rel8.Expr.Null ( snull, unsafeUnnullify )
15import Rel8.Expr.Null ( snull, unsafeUnnullify )
16import Rel8.Schema.HTable ( htabulate, hfield, hspecs )
16import Rel8.Schema.HTable ( htabulate, hfield, hspecs )
17import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
17import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
@@ -22,5 +22,5 @@ import Rel8.Table ( Table, fromColumns )
22undefined :: Table Expr a => a
22undefined :: Table Expr a => a
23undefined = fromColumns $ htabulate $ \field -> case hfield hspecs field of
23undefined = fromColumns $ htabulate $ \field -> case hfield hspecs field of
24 SSpec {nullity, info} -> case nullity of
24 SSpec {nullity, info} -> case nullity of
25− Null -> DB (snull info)
25+ Null -> E (snull info)
26− NotNull -> DB (unsafeUnnullify (snull info))
26+ NotNull -> E (unsafeUnnullify (snull info))
src/Rel8/Type/Composite.hs+7−7
@@ -30,12 +30,12 @@ import qualified Hasql.Decoders as Hasql
30import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
30import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
31
31
32-- rel8
32-- rel8
33−import Rel8.Expr ( Col( DB ), Expr )
33+import Rel8.Expr ( Col( E ), Expr )
34import Rel8.Expr.Opaleye ( castExpr, fromPrimExpr, toPrimExpr )
34import Rel8.Expr.Opaleye ( castExpr, fromPrimExpr, toPrimExpr )
35import Rel8.Schema.HTable ( hfield, hspecs, htabulate, htabulateA )
35import Rel8.Schema.HTable ( hfield, hspecs, htabulate, htabulateA )
36−import Rel8.Schema.Name ( Col( NameCol ), Name )
36+import Rel8.Schema.Name ( Col( N ), Name( Name ) )
37import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
37import Rel8.Schema.Null ( Nullity( Null, NotNull ) )
38−import Rel8.Schema.Result ( Col( Result ), Result )
38+import Rel8.Schema.Result ( Col( R ), Result )
39import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
39import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )
40import Rel8.Table ( Table, fromColumns, toColumns )
40import Rel8.Table ( Table, fromColumns, toColumns )
41import Rel8.Table.Eq ( EqTable )
41import Rel8.Table.Eq ( EqTable )
@@ -98,8 +98,8 @@ compose = castExpr . fromPrimExpr . encoder
98decompose :: forall a. DBComposite a => Expr a -> HKD a Expr
98decompose :: forall a. DBComposite a => Expr a -> HKD a Expr
99decompose (toPrimExpr -> a) = fromColumns $ htabulate \field ->
99decompose (toPrimExpr -> a) = fromColumns $ htabulate \field ->
100 case hfield names field of
100 case hfield names field of
101− NameCol name -> case hfield hspecs field of
101+ N (Name name) -> case hfield hspecs field of
102− SSpec {} -> DB $ fromPrimExpr $ Opaleye.CompositeExpr a name
102+ SSpec {} -> E $ fromPrimExpr $ Opaleye.CompositeExpr a name
103 where
103 where
104 names = toColumns (compositeFields @a)
104 names = toColumns (compositeFields @a)
105
105
@@ -107,7 +107,7 @@ decompose (toPrimExpr -> a) = fromColumns $ htabulate \field ->
107decoder :: Table Result a => Hasql.Composite a
107decoder :: Table Result a => Hasql.Composite a
108decoder = fmap fromColumns $ unwrapApplicative $ htabulateA \field ->
108decoder = fmap fromColumns $ unwrapApplicative $ htabulateA \field ->
109 case hfield hspecs field of
109 case hfield hspecs field of
110− SSpec {nullity, info} -> WrapApplicative $ Result <$>
110+ SSpec {nullity, info} -> WrapApplicative $ R <$>
111 case nullity of
111 case nullity of
112 Null -> Hasql.field $ Hasql.nullable $ decode info
112 Null -> Hasql.field $ Hasql.nullable $ decode info
113 NotNull -> Hasql.field $ Hasql.nonNullable $ decode info
113 NotNull -> Hasql.field $ Hasql.nonNullable $ decode info
@@ -117,4 +117,4 @@ encoder :: Table Expr a => a -> Opaleye.PrimExpr
117encoder (toColumns -> a) = Opaleye.FunExpr "ROW" exprs
117encoder (toColumns -> a) = Opaleye.FunExpr "ROW" exprs
118 where
118 where
119 exprs = getConst $ htabulateA \field -> case hfield a field of
119 exprs = getConst $ htabulateA \field -> case hfield a field of
120− DB (toPrimExpr -> expr) -> Const [expr]
120+ E (toPrimExpr -> expr) -> Const [expr]