on master help sign in
Allow Insert (rather than Insertion) to be used as a Context
commitbbfa1a32ed60108464160dcd33bbe0abca8018f6 authorShane O'Brien <shane.obrien@circuithub.com> dateWed 24 Mar 2021, 18:37 (6 years ago) parenta90cc0f
34 files changed+570−410
rel8.cabal+2 src/Rel8.hs+1−3 src/Rel8/Aggregate.hs+117−2 src/Rel8/Expr.hs+67−1 src/Rel8/Query/Each.hs+1−1 src/Rel8/Query/SQL.hs+2−3 src/Rel8/Schema/Column.hs+7−6 src/Rel8/Schema/Context.hs+5−52 src/Rel8/Schema/Context/Label.hs+4−34 src/Rel8/Schema/Context/Nullify.hs+7−89 src/Rel8/Schema/Field.hs+8−8 src/Rel8/Schema/Generic.hs+36−34 src/Rel8/Schema/Insert.hs+160 src/Rel8/Schema/Name.hs+112 src/Rel8/Statement/Delete.hs+1−1 src/Rel8/Statement/Insert.hs+4−31 src/Rel8/Statement/Returning.hs+1−1 src/Rel8/Statement/Select.hs+1−1 src/Rel8/Statement/Update.hs+1−1 src/Rel8/Statement/View.hs+1−1 src/Rel8/Table.hs+6−32 src/Rel8/Table/Aggregate.hs+2−4 src/Rel8/Table/Bool.hs+1−2 src/Rel8/Table/Eq.hs+1−2 src/Rel8/Table/Insert.hs+2−2 src/Rel8/Table/List.hs+1−2 src/Rel8/Table/Name.hs+2−2 src/Rel8/Table/NonEmpty.hs+1−2 src/Rel8/Table/Opaleye.hs+4−4 src/Rel8/Table/Ord.hs+1−2 src/Rel8/Table/Order.hs+1−1 src/Rel8/Table/Recontextualize.hs+8−82 src/Rel8/Table/Serialize.hs+1−2 src/Rel8/Table/Undefined.hs+1−2
rel8.cabal+2
@@ -112,7 +112,9 @@ library
112112 Rel8.Schema.HTable.Trio
113113 Rel8.Schema.HTable.Type
114114 Rel8.Schema.HTable.Vectorize
115+ Rel8.Schema.Insert
115116 Rel8.Schema.Kind
117+ Rel8.Schema.Name
116118 Rel8.Schema.Nullability
117119 Rel8.Schema.Spec
118120 Rel8.Schema.Spec.ConstrainDBType
src/Rel8.hs+1−3
@@ -213,7 +213,6 @@ module Rel8
213213 , Insert(..)
214214 , OnConflict(..)
215215 , insert
216− , Insertion
217216 , toInsert
218217 , toInsertDefaults
219218
@@ -271,10 +270,10 @@ import Rel8.Query.Set
271270import Rel8.Query.These
272271import Rel8.Query.Values
273272import Rel8.Schema.Column
274−import Rel8.Schema.Context (Name, Insertion)
275273import Rel8.Schema.Context.Label
276274import Rel8.Schema.Generic
277275import Rel8.Schema.HTable
276+import Rel8.Schema.Name
278277import Rel8.Schema.Nullability
279278import Rel8.Schema.Table
280279import Rel8.Statement.Delete
@@ -295,7 +294,6 @@ import Rel8.Table.Name
295294import Rel8.Table.NonEmpty
296295import Rel8.Table.Ord
297296import Rel8.Table.Order
298−import Rel8.Table.Recontextualize
299297import Rel8.Table.Serialize
300298import Rel8.Table.These
301299import Rel8.Type
src/Rel8/Aggregate.hs+117−2
@@ -1,17 +1,31 @@
1+{-# language DataKinds #-}
12{-# language DerivingVia #-}
3+{-# language FlexibleContexts #-}
4+{-# language FlexibleInstances #-}
5+{-# language GADTs #-}
26{-# language GeneralizedNewtypeDeriving #-}
7+{-# language MultiParamTypeClasses #-}
38{-# language NamedFieldPuns #-}
49{-# language StandaloneKindSignatures #-}
10+{-# language TypeFamilies #-}
11+{-# language UndecidableInstances #-}
12+{-# language UndecidableSuperClasses #-}
513
614module Rel8.Aggregate
7− ( Aggregate(..), foldInputs, mapInputs
15+ ( Aggregate(..)
816 , Aggregator(..), unsafeMakeAggregate
17+ , Aggregates
18+ , Col( Aggregation )
919 )
1020where
1121
1222-- base
23+import Control.Applicative ( empty )
24+import Data.Foldable ( fold )
1325import Data.Functor.Const ( Const( Const ), getConst )
14−import Data.Kind ( Type )
26+import Data.Functor.Identity ( Identity )
27+import Data.Kind ( Constraint, Type )
28+import Data.Monoid ( First( First ), getFirst )
1529import Prelude
1630
1731-- opaleye
@@ -19,6 +33,24 @@ import qualified Opaleye.Internal.Aggregate as Opaleye
1933import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
2034import qualified Opaleye.Internal.PackMap as Opaleye
2135
36+-- rel8
37+import Rel8.Expr ( Expr, Col(..) )
38+import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
39+import Rel8.Opaque ( Opaque, Opaque1 )
40+import Rel8.Schema.Context ( Interpretation(..) )
41+import Rel8.Schema.Context.Label ( Labelable(..) )
42+import Rel8.Schema.Context.Nullify
43+ ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
44+ , runTag, unnull
45+ )
46+import Rel8.Schema.HTable ( hfield, htabulate, htabulateA, hspecs )
47+import Rel8.Schema.Name ( Name )
48+import Rel8.Schema.Nullability ( Sql )
49+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
50+import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
51+import Rel8.Table.Recontextualize ( Recontextualize )
52+import Rel8.Type ( DBType )
53+
2254-- semigroupoids
2355import Data.Functor.Apply ( Apply, WrappedApplicative(..) )
2456
@@ -34,6 +66,89 @@ newtype Aggregate a = Aggregate (Opaleye.Aggregator () a)
3466 deriving Apply via (WrappedApplicative (Opaleye.Aggregator ()))
3567
3668
69+instance Interpretation Aggregate where
70+ data Col Aggregate _spec where
71+ Aggregation :: ()
72+ => Aggregate (Expr a)
73+ -> Col Aggregate ('Spec labels necessity db a)
74+
75+
76+instance Table Expr a => Table Aggregate (Aggregate a) where
77+ type Columns (Aggregate a) = Columns a
78+ type Context (Aggregate a) = Aggregate
79+
80+ toColumns a = htabulate $ \field -> case hfield hspecs field of
81+ SSpec {} -> Aggregation $ unDB . (`hfield` field) . toColumns <$> a
82+ fromColumns as = fmap fromColumns $ htabulateA $ \field ->
83+ case hfield as field of
84+ Aggregation a -> DB <$> a
85+
86+
87+instance Sql DBType a =>
88+ Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))
89+
90+
91+instance Sql DBType a =>
92+ Recontextualize Aggregate Expr (Aggregate (Expr a)) (Expr a)
93+
94+
95+instance Sql DBType a =>
96+ Recontextualize Aggregate Identity (Aggregate (Expr a)) (Identity a)
97+
98+
99+instance Sql DBType a =>
100+ Recontextualize Aggregate Name (Aggregate (Expr a)) (Name a)
101+
102+
103+instance Sql DBType a =>
104+ Recontextualize Expr Aggregate (Expr a) (Aggregate (Expr a))
105+
106+
107+instance Sql DBType a =>
108+ Recontextualize Identity Aggregate (Identity a) (Aggregate (Expr a))
109+
110+
111+instance Sql DBType a =>
112+ Recontextualize Name Aggregate (Name a) (Aggregate (Expr a))
113+
114+
115+instance Labelable Aggregate where
116+ labeler (Aggregation aggregate) = Aggregation aggregate
117+ unlabeler (Aggregation aggregate) = Aggregation aggregate
118+
119+
120+instance Nullifiable Aggregate where
121+ encodeTag = Aggregation . groupByExpr
122+ where
123+ groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing
124+ decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate
125+ where
126+ undoGroupBy = getFirst . foldInputs go
127+ where
128+ go Nothing = pure . fromPrimExpr
129+ go _ = const $ First empty
130+
131+ nullifier tag SSpec {nullability} (Aggregation aggregate) = Aggregation $
132+ mapInputs (toPrimExpr . runTag nullability tag . fromPrimExpr) $
133+ runTag nullability tag <$> aggregate
134+
135+ unnullifier _ SSpec {nullability} (Aggregation aggregate) =
136+ Aggregation $ unnull nullability <$> aggregate
137+
138+ {-# INLINABLE encodeTag #-}
139+ {-# INLINABLE decodeTag #-}
140+ {-# INLINABLE nullifier #-}
141+ {-# INLINABLE unnullifier #-}
142+
143+
144+-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
145+-- for the columns in @b@.
146+type Aggregates :: Type -> Type -> Constraint
147+class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
148+instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
149+instance {-# OVERLAPPING #-} Aggregates (Opaque1 Aggregate Opaque) (Opaque1 Expr Opaque)
150+
151+
37152foldInputs :: Monoid b
38153 => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b
39154foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =
src/Rel8/Expr.hs+67−1
@@ -1,20 +1,28 @@
11{-# language DataKinds #-}
22{-# language DerivingStrategies #-}
33{-# language FlexibleContexts #-}
4+{-# language FlexibleInstances #-}
45{-# language GADTs #-}
6+{-# language MultiParamTypeClasses #-}
7+{-# language NamedFieldPuns #-}
58{-# language RoleAnnotations #-}
69{-# language ScopedTypeVariables #-}
710{-# language StandaloneKindSignatures #-}
811{-# language TypeApplications #-}
12+{-# language TypeFamilies #-}
913{-# language UndecidableInstances #-}
14+{-# language UndecidableSuperClasses #-}
1015
1116module Rel8.Expr
1217 ( Expr(..)
18+ , Col( DB, unDB )
19+ , Encodes
1320 )
1421where
1522
1623-- base
17−import Data.Kind ( Type )
24+import Data.Functor.Identity ( Identity )
25+import Data.Kind ( Constraint, Type )
1826import Data.String ( IsString, fromString )
1927import Prelude hiding ( null )
2028
@@ -30,10 +38,21 @@ import Rel8.Expr.Opaleye
3038 , zipPrimExprsWith
3139 )
3240import Rel8.Expr.Serialize ( litExpr )
41+import Rel8.Opaque ( Opaque, Opaque1 )
42+import Rel8.Schema.Context ( Interpretation, Col )
43+import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
44+import Rel8.Schema.Context.Nullify
45+ ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
46+ , runTag, unnull
47+ )
48+import Rel8.Schema.HTable.Type ( HType( HType ) )
3349import Rel8.Schema.Nullability
3450 ( Nullability( Nullable, NonNullable )
3551 , Sql, nullabilization
3652 )
53+import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
54+import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
55+import Rel8.Table.Recontextualize ( Recontextualize )
3756import Rel8.Type ( DBType )
3857import Rel8.Type.Monoid ( DBMonoid, memptyExpr )
3958import Rel8.Type.Num ( DBFractional, DBNum )
@@ -85,3 +104,50 @@ instance Sql DBFractional a => Fractional (Expr a) where
85104
86105 fromRational =
87106 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac
107+
108+
109+instance Interpretation Expr where
110+ data Col Expr _spec where
111+ DB :: ()
112+ => { unDB :: Expr a }
113+ -> Col Expr ('Spec labels necessity db a)
114+
115+
116+instance Sql DBType a => Table Expr (Expr a) where
117+ type Columns (Expr a) = HType a
118+ type Context (Expr a) = Expr
119+
120+ toColumns a = HType (DB a)
121+ fromColumns (HType (DB a)) = a
122+
123+
124+instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)
125+
126+
127+instance Sql DBType a => Recontextualize Expr Identity (Expr a) (Identity a)
128+
129+
130+instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)
131+
132+
133+instance Labelable Expr where
134+ labeler (DB a) = DB a
135+ unlabeler (DB a) = DB a
136+
137+
138+instance Nullifiable Expr where
139+ encodeTag = DB
140+ decodeTag (DB a) = a
141+ nullifier tag SSpec {nullability} (DB a) = DB $ runTag nullability tag a
142+ unnullifier _ SSpec {nullability} (DB a) = DB $ unnull nullability a
143+
144+ {-# INLINABLE encodeTag #-}
145+ {-# INLINABLE decodeTag #-}
146+ {-# INLINABLE nullifier #-}
147+ {-# INLINABLE unnullifier #-}
148+
149+
150+type Encodes :: Type -> Type -> Constraint
151+class Recontextualize Identity Expr a exprs => Encodes a exprs
152+instance Recontextualize Identity Expr a exprs => Encodes a exprs
153+instance {-# OVERLAPPING #-} Encodes (Opaque1 Identity Opaque) (Opaque1 Expr Opaque)
src/Rel8/Query/Each.hs+1−1
@@ -14,10 +14,10 @@ import qualified Opaleye.Table as Opaleye
1414-- rel8
1515import Rel8.Query ( Query )
1616import Rel8.Query.Opaleye ( fromOpaleye )
17+import Rel8.Schema.Name ( Selects )
1718import Rel8.Schema.Table ( TableSchema )
1819import Rel8.Table ( fromColumns, toColumns )
1920import Rel8.Table.Opaleye ( table, unpackspec )
20−import Rel8.Table.Recontextualize ( Selects )
2121
2222
2323-- | Select each row from a table definition. This is equivalent to @FROM
src/Rel8/Query/SQL.hs+2−3
@@ -23,16 +23,15 @@ import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )
2323import qualified Opaleye.Internal.Sql as Opaleye
2424
2525-- rel8
26−import Rel8.Expr ( Expr )
26+import Rel8.Expr ( Expr, Col(..) )
2727import Rel8.Expr.Opaleye ( toPrimExpr )
2828import Rel8.Query ( Query )
2929import Rel8.Query.Opaleye ( toOpaleye )
3030import qualified Rel8.Query.Optimize as Rel8 ( optimize )
31−import Rel8.Schema.Context ( Col(..) )
31+import Rel8.Schema.Name ( Selects, Col(..) )
3232import Rel8.Schema.HTable ( htabulateA, hfield )
3333import Rel8.Table ( Table, toColumns )
3434import Rel8.Table.Name ( namesFromLabels )
35−import Rel8.Table.Recontextualize ( Selects )
3635
3736
3837-- | Convert a query to a 'String' containing the query as a @SELECT@
src/Rel8/Schema/Column.hs+7−6
@@ -24,9 +24,10 @@ import Rel8.Aggregate ( Aggregate )
2424import Rel8.Expr ( Expr )
2525import Rel8.Kind.Labels ( Labels )
2626import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
27−import Rel8.Schema.Context ( Name, Insertion )
2827import Rel8.Schema.Field ( Field )
28+import Rel8.Schema.Insert ( Insert )
2929import qualified Rel8.Schema.Kind as K
30+import Rel8.Schema.Name ( Name )
3031import Rel8.Schema.Nullability ( Unnullify )
3132import Rel8.Schema.Structure
3233 ( Structure
@@ -120,7 +121,7 @@ type family HEither context where
120121 HEither Aggregate = EitherTable
121122 HEither Expr = EitherTable
122123 HEither Identity = Either
123− HEither Insertion = EitherTable
124+ HEither Insert = EitherTable
124125 HEither Name = EitherTable
125126 HEither _ = Either
126127
@@ -131,7 +132,7 @@ type family HList context where
131132 HList Aggregate = ListTable
132133 HList Expr = ListTable
133134 HList Identity = []
134− HList Insertion = ListTable
135+ HList Insert = ListTable
135136 HList Name = ListTable
136137 HList _ = []
137138
@@ -142,7 +143,7 @@ type family HMaybe context where
142143 HMaybe Aggregate = MaybeTable
143144 HMaybe Expr = MaybeTable
144145 HMaybe Identity = Maybe
145− HMaybe Insertion = MaybeTable
146+ HMaybe Insert = MaybeTable
146147 HMaybe Name = MaybeTable
147148 HMaybe _ = Maybe
148149
@@ -153,7 +154,7 @@ type family HNonEmpty context where
153154 HNonEmpty Aggregate = NonEmptyTable
154155 HNonEmpty Expr = NonEmptyTable
155156 HNonEmpty Identity = NonEmpty
156− HNonEmpty Insertion = NonEmptyTable
157+ HNonEmpty Insert = NonEmptyTable
157158 HNonEmpty Name = NonEmptyTable
158159 HNonEmpty _ = NonEmpty
159160
@@ -164,6 +165,6 @@ type family HThese context where
164165 HThese Aggregate = TheseTable
165166 HThese Expr = TheseTable
166167 HThese Identity = These
167− HThese Insertion = TheseTable
168+ HThese Insert = TheseTable
168169 HThese Name = TheseTable
169170 HThese _ = These
src/Rel8/Schema/Context.hs+5−52
@@ -1,75 +1,28 @@
11{-# language DataKinds #-}
2−{-# language DerivingStrategies #-}
32{-# language GADTs #-}
4−{-# language GeneralizedNewtypeDeriving #-}
53{-# language StandaloneKindSignatures #-}
64{-# language TypeFamilies #-}
75
86module Rel8.Schema.Context
9− ( Interpretation, Col(..)
10− , Insertion(..)
11− , Name(..)
7+ ( Interpretation(..), Col( Result )
128 )
139where
1410
1511-- base
1612import Data.Functor.Identity ( Identity )
1713import Data.Kind ( Constraint )
18−import Data.String ( IsString )
19−import Prelude
14+import Prelude ()
2015
2116-- rel8
22−import Rel8.Aggregate ( Aggregate )
23−import Rel8.Expr ( Expr )
24−import Rel8.Kind.Necessity ( Necessity( Optional, Required ) )
25−import qualified Rel8.Schema.Kind as K
17+import Rel8.Schema.Kind ( Context, HContext )
2618import Rel8.Schema.Spec ( Spec( Spec ) )
2719
2820
29−type Interpretation :: K.Context -> Constraint
21+type Interpretation :: Context -> Constraint
3022class Interpretation context where
31− data Col context :: K.HContext
32−
33−
34−instance Interpretation Aggregate where
35− data Col Aggregate _spec where
36− Aggregation :: ()
37− => Aggregate (Expr a)
38− -> Col Aggregate ('Spec labels necessity db a)
39−
40−
41−instance Interpretation Expr where
42− data Col Expr _spec where
43− DB :: ()
44− => { unDB :: Expr a }
45− -> Col Expr ('Spec labels necessity db a)
23+ data Col context :: HContext
4624
4725
4826instance Interpretation Identity where
4927 data Col Identity _spec where
5028 Result :: a -> Col Identity ('Spec labels necessity db a)
51−
52−
53−instance Interpretation Insertion where
54− data Col Insertion _spec where
55− RequiredInsert :: Expr a -> Col Insertion ('Spec labels 'Required db a)
56− OptionalInsert :: Maybe (Expr a) -> Col Insertion ('Spec labels 'Optional db a)
57−
58−
59−instance Interpretation Name where
60− data Col Name _spec where
61− NameCol :: String -> Col Name ('Spec labels necessity db a)
62−
63−
64−type Insertion :: K.Context
65−newtype Insertion a = Insertion (Expr a)
66−
67−
68−-- | A @Name@ is the name of a column, as it would be defined in a table's
69−-- schema definition. You can construct names by using the @OverloadedStrings@
70−-- extension and writing string literals. This is typically done when providing
71−-- a 'TableSchema' value.
72−type Name :: K.Context
73−newtype Name a = Name String
74− deriving stock Show
75− deriving newtype (IsString, Monoid, Semigroup)
src/Rel8/Schema/Context/Label.hs+4−34
@@ -1,7 +1,4 @@
11{-# language DataKinds #-}
2−{-# language LambdaCase #-}
3−{-# language FlexibleInstances #-}
4−{-# language MultiParamTypeClasses #-}
52{-# language StandaloneKindSignatures #-}
63{-# language TypeFamilies #-}
74{-# language TypeOperators #-}
@@ -18,14 +15,12 @@ import Data.Kind ( Constraint )
1815import Prelude hiding ( null )
1916
2017-- rel8
21−import Rel8.Aggregate ( Aggregate )
22−import Rel8.Expr ( Expr )
23−import Rel8.Schema.Context ( Interpretation, Col(..), Insertion, Name )
24−import qualified Rel8.Schema.Kind as K
18+import Rel8.Schema.Context ( Interpretation, Col(..) )
19+import Rel8.Schema.Kind ( Context, HContext )
2520import Rel8.Schema.Spec ( Spec( Spec ) )
2621
2722
28−type Labelable :: K.Context -> Constraint
23+type Labelable :: Context -> Constraint
2924class Interpretation context => Labelable context where
3025 labeler :: ()
3126 => Col context ('Spec labels necessity db a)
@@ -36,37 +31,12 @@ class Interpretation context => Labelable context where
3631 -> Col context ('Spec labels necessity db a)
3732
3833
39−instance Labelable Aggregate where
40− labeler (Aggregation aggregate) = Aggregation aggregate
41− unlabeler (Aggregation aggregate) = Aggregation aggregate
42−
43−
44−instance Labelable Expr where
45− labeler (DB a) = DB a
46− unlabeler (DB a) = DB a
47−
48−
49−instance Labelable Insertion where
50− labeler = \case
51− RequiredInsert a -> RequiredInsert a
52− OptionalInsert ma -> OptionalInsert ma
53−
54− unlabeler = \case
55− RequiredInsert a -> RequiredInsert a
56− OptionalInsert ma -> OptionalInsert ma
57−
58−
5934instance Labelable Identity where
6035 labeler (Result a) = Result a
6136 unlabeler (Result a) = Result a
6237
6338
64−instance Labelable Name where
65− labeler (NameCol a) = NameCol a
66− unlabeler (NameCol a) = NameCol a
67−
68−
69−type HLabelable :: K.HContext -> Constraint
39+type HLabelable :: HContext -> Constraint
7040class HLabelable context where
7141 hlabeler :: ()
7242 => context ('Spec labels necessity db a)
src/Rel8/Schema/Context/Nullify.hs+7−89
@@ -1,44 +1,35 @@
11{-# language DataKinds #-}
2−{-# language LambdaCase #-}
32{-# language FlexibleContexts #-}
43{-# language FlexibleInstances #-}
54{-# language MultiParamTypeClasses #-}
6−{-# language NamedFieldPuns #-}
7−{-# language ScopedTypeVariables #-}
85{-# language StandaloneKindSignatures #-}
9−{-# language TypeApplications #-}
106{-# language TypeFamilies #-}
117
128module Rel8.Schema.Context.Nullify
139 ( Nullifiable( encodeTag, decodeTag, nullifier, unnullifier )
1410 , NullifiableEq
11+ , unnull, runTag
1512 )
1613where
1714
1815-- base
19−import Control.Applicative ( empty )
20−import Data.Foldable ( fold )
2116import Data.Kind ( Constraint )
22−import qualified Data.List.NonEmpty as NonEmpty
23−import Data.Monoid ( First( First ), getFirst )
2417import Prelude hiding ( null )
2518
2619-- opaleye
2720import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
2821
2922-- rel8
30−import Rel8.Aggregate ( Aggregate, foldInputs, mapInputs )
31−import Rel8.Expr ( Expr( Expr ) )
32−import Rel8.Expr.Aggregate ( groupByExpr )
23+import {-# SOURCE #-} Rel8.Expr ( Expr )
3324import Rel8.Expr.Bool ( boolExpr )
3425import Rel8.Expr.Null ( nullify, unsafeUnnullify )
35−import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )
36−import Rel8.Kind.Labels ( KnownLabels, labelsSing, renderLabels )
26+import Rel8.Expr.Opaleye ( fromPrimExpr )
27+import Rel8.Kind.Labels ( KnownLabels )
3728import Rel8.Kind.Necessity ( Necessity( Required ) )
38−import Rel8.Schema.Context ( Interpretation, Col(..), Insertion, Name )
29+import Rel8.Schema.Context ( Interpretation, Col(..) )
3930import qualified Rel8.Schema.Kind as K
4031import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ), Sql )
41−import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )
32+import Rel8.Schema.Spec ( Spec( Spec ), SSpec )
4233import Rel8.Type.Eq ( DBEq )
4334import Rel8.Type.Monoid ( DBMonoid )
4435
@@ -66,65 +57,6 @@ class Interpretation context => Nullifiable context where
6657 -> Col context ('Spec labels necessity db a)
6758
6859
69−instance Nullifiable Aggregate where
70− encodeTag = Aggregation . groupByExpr
71− decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate
72−
73− nullifier tag SSpec {nullability} (Aggregation aggregate) = Aggregation $
74− mapInputs (toPrimExpr . runTag nullability tag . fromPrimExpr) $
75− runTag nullability tag <$> aggregate
76−
77− unnullifier _ SSpec {nullability} (Aggregation aggregate) =
78− Aggregation $ unnull nullability <$> aggregate
79−
80− {-# INLINABLE encodeTag #-}
81− {-# INLINABLE decodeTag #-}
82− {-# INLINABLE nullifier #-}
83− {-# INLINABLE unnullifier #-}
84−
85−
86−instance Nullifiable Expr where
87− encodeTag = DB
88− decodeTag (DB a) = a
89− nullifier tag SSpec {nullability} (DB a) = DB $ runTag nullability tag a
90− unnullifier _ SSpec {nullability} (DB a) = DB $ unnull nullability a
91−
92− {-# INLINABLE encodeTag #-}
93− {-# INLINABLE decodeTag #-}
94− {-# INLINABLE nullifier #-}
95− {-# INLINABLE unnullifier #-}
96−
97−
98−instance Nullifiable Insertion where
99− encodeTag = RequiredInsert
100− decodeTag (RequiredInsert a) = a
101−
102− nullifier tag SSpec {nullability} = \case
103− RequiredInsert a -> RequiredInsert $ runTag nullability tag a
104− OptionalInsert ma -> OptionalInsert $ runTag nullability tag <$> ma
105−
106− unnullifier _ SSpec {nullability} = \case
107− RequiredInsert a -> RequiredInsert $ unnull nullability a
108− OptionalInsert ma -> OptionalInsert $ unnull nullability <$> ma
109−
110− {-# INLINABLE encodeTag #-}
111− {-# INLINABLE decodeTag #-}
112− {-# INLINABLE nullifier #-}
113− {-# INLINABLE unnullifier #-}
114−
115−
116−instance Nullifiable Name where
117− encodeTag _ = nameFromLabel
118− decodeTag _ = mempty
119− nullifier _ _ (NameCol name) = NameCol name
120− unnullifier _ _ (NameCol name) = NameCol name
121−
122− {-# INLINABLE encodeTag #-}
123− {-# INLINABLE decodeTag #-}
124− {-# INLINABLE nullifier #-}
125− {-# INLINABLE unnullifier #-}
126−
127−
12860type NullifiableEq :: K.Context -> K.Context -> Constraint
12961class (a ~ b, Nullifiable b) => NullifiableEq a b
13062instance (a ~ b, Nullifiable b) => NullifiableEq a b
@@ -135,24 +67,10 @@ runTag nullability tag a = case nullability of
13567 Nullable -> boolExpr null a tag
13668 NonNullable -> boolExpr null (nullify a) tag
13769 where
138− null = Expr (Opaleye.ConstExpr Opaleye.NullLit)
70+ null = fromPrimExpr $ Opaleye.ConstExpr Opaleye.NullLit
13971
14072
14173unnull :: Nullability db a -> Expr (Maybe db) -> Expr a
14274unnull nullability a = case nullability of
14375 Nullable -> a
14476 NonNullable -> unsafeUnnullify a
145−
146−
147−-- HACK
148−undoGroupBy :: Aggregate (Expr _a) -> Maybe (Expr a)
149−undoGroupBy = getFirst . foldInputs go
150− where
151− go Nothing a = pure (Expr a)
152− go _ _ = First empty
153−
154−
155−nameFromLabel :: forall labels necessity db a.
156− KnownLabels labels => Col Name ('Spec labels necessity db a)
157−nameFromLabel = case labelsSing @labels of
158− labels -> NameCol (NonEmpty.last (renderLabels labels))
src/Rel8/Schema/Field.hs+8−8
@@ -17,7 +17,7 @@ import Rel8.Aggregate ( Aggregate )
1717import Rel8.Expr ( Expr )
1818import Rel8.Kind.Labels ( Labels )
1919import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )
20−import Rel8.Schema.Context ( Insertion )
20+import Rel8.Schema.Insert ( Insert )
2121import qualified Rel8.Schema.Kind as K
2222import Rel8.Schema.Spec ( Spec( Spec ) )
2323import Rel8.Schema.Structure ( Structure, Shape( Column ), Shape1 )
@@ -25,10 +25,10 @@ import Rel8.Schema.Structure ( Structure, Shape( Column ), Shape1 )
2525
2626type Field :: K.Context -> Labels -> Necessity -> Type -> Type -> Type
2727type family Field labels context necessity db a where
28− Field Identity _labels _necessity _db a = a
29− Field Expr _labels _necessity _db a = Expr a
30− Field Insertion _labels 'Required _db a = Expr a
31− Field Insertion _labels 'Optional _db a = Maybe (Expr a)
32− Field Aggregate _labels _necessity _db a = Aggregate (Expr a)
33− Field Structure labels necessity db a = Shape1 'Column ('Spec labels necessity db a)
34− Field context _labels _necessity _db a = context a
28+ Field Identity _labels _necessity _db a = a
29+ Field Expr _labels _necessity _db a = Expr a
30+ Field Insert _labels 'Required _db a = Expr a
31+ Field Insert _labels 'Optional _db a = Maybe (Expr a)
32+ Field Aggregate _labels _necessity _db a = Aggregate (Expr a)
33+ Field Structure labels necessity db a = Shape1 'Column ('Spec labels necessity db a)
34+ Field context _labels _necessity _db a = context a
src/Rel8/Schema/Generic.hs+36−34
@@ -36,13 +36,13 @@ import GHC.TypeLits ( Symbol, KnownSymbol )
3636import Prelude
3737
3838-- rel8
39−import Rel8.Aggregate ( Aggregate )
40−import Rel8.Expr ( Expr )
39+import Rel8.Aggregate ( Aggregate, Col(..) )
40+import Rel8.Expr ( Expr, Col(..) )
4141import Rel8.Kind.Necessity
4242 ( SNecessity( SRequired, SOptional )
4343 , KnownNecessity, necessitySing
4444 )
45−import Rel8.Schema.Context
45+import Rel8.Schema.Context ( Col(..) )
4646import Rel8.Schema.Context.Identity
4747 ( fromHEitherTable, toHEitherTable
4848 , fromHListTable, toHListTable
@@ -68,7 +68,9 @@ import Rel8.Schema.HTable.Quintet ( HQuintet(..) )
6868import Rel8.Schema.HTable.These ( HTheseTable )
6969import Rel8.Schema.HTable.Trio ( HTrio(..) )
7070import Rel8.Schema.HTable.Vectorize ( hrelabel )
71+import Rel8.Schema.Insert ( Insert, Col(..) )
7172import qualified Rel8.Schema.Kind as K
73+import Rel8.Schema.Name ( Name( Name ), Col(..) )
7274import Rel8.Schema.Spec ( Spec( Spec ), KTable )
7375import Rel8.Schema.Structure
7476 ( IsStructure, Shape(..), Shape1, Shape2
@@ -114,9 +116,9 @@ instance TableHelper Expr where
114116 gtoColumns = toExprColumns
115117
116118
117−instance TableHelper Insertion where
118− gfromColumns = fromInsertionColumns
119− gtoColumns = toInsertionColumns
119+instance TableHelper Insert where
120+ gfromColumns = fromInsertColumns
121+ gtoColumns = toInsertColumns
120122
121123
122124instance TableHelper Identity where
@@ -181,8 +183,8 @@ class HTable (GRep t) => Rel8able t where
181183 fromExprColumns :: GRep t (Col Expr) -> t Expr
182184 toExprColumns :: t Expr -> GRep t (Col Expr)
183185
184− fromInsertionColumns :: GRep t (Col Insertion) -> t Insertion
185− toInsertionColumns :: t Insertion -> GRep t (Col Insertion)
186+ fromInsertColumns :: GRep t (Col Insert) -> t Insert
187+ toInsertColumns :: t Insert -> GRep t (Col Insert)
186188
187189 fromIdentityColumns :: GRep t (Col Identity) -> t Identity
188190 toIdentityColumns :: t Identity -> GRep t (Col Identity)
@@ -220,19 +222,19 @@ class HTable (GRep t) => Rel8able t where
220222 ) => t Expr -> GRep t (Col Expr)
221223 toExprColumns = toGColumns @_ @(Rep (t Structure)) . from
222224
223− default fromInsertionColumns ::
224− ( Generic (t Insertion)
225+ default fromInsertColumns ::
226+ ( Generic (t Insert)
225227 , GColumns (Rep (t Structure)) ~ GRep t
226− , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
227− ) => GRep t (Col Insertion) -> t Insertion
228− fromInsertionColumns = to . fromGColumns @_ @(Rep (t Structure))
228+ , GRel8able Insert (Rep (t Structure)) (Rep (t Insert))
229+ ) => GRep t (Col Insert) -> t Insert
230+ fromInsertColumns = to . fromGColumns @_ @(Rep (t Structure))
229231
230− default toInsertionColumns ::
231− ( Generic (t Insertion)
232+ default toInsertColumns ::
233+ ( Generic (t Insert)
232234 , GColumns (Rep (t Structure)) ~ GRep t
233− , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))
234− ) => t Insertion -> GRep t (Col Insertion)
235− toInsertionColumns = toGColumns @_ @(Rep (t Structure)) . from
235+ , GRel8able Insert (Rep (t Structure)) (Rep (t Insert))
236+ ) => t Insert -> GRep t (Col Insert)
237+ toInsertColumns = toGColumns @_ @(Rep (t Structure)) . from
236238
237239 default fromIdentityColumns ::
238240 ( Generic (t Identity)
@@ -402,9 +404,9 @@ instance
402404
403405
404406instance
405− ( x ~ Field Insertion '[] necessity db a
407+ ( x ~ Field Insert '[] necessity db a
406408 , KnownNecessity necessity
407− ) => K1Table label Insertion 'True (Shape1 'Column ('Spec '[] necessity db a)) x
409+ ) => K1Table label Insert 'True (Shape1 'Column ('Spec '[] necessity db a)) x
408410 where
409411 fromK1Columns (HIdentity insert) = case insert of
410412 RequiredInsert a -> a
@@ -417,9 +419,9 @@ instance
417419
418420
419421instance
420− ( x ~ Field Insertion (label ': labels) necessity db a
422+ ( x ~ Field Insert (label ': labels) necessity db a
421423 , KnownNecessity necessity
422− ) => K1Table _label Insertion 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
424+ ) => K1Table _label Insert 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x
423425 where
424426 fromK1Columns (HIdentity insert) = case insert of
425427 RequiredInsert a -> a
@@ -520,11 +522,11 @@ instance
520522instance
521523 ( HTable (K1Columns "Left" structure1)
522524 , HTable (K1Columns "Right" structure2)
523− , K1Table "Left" Insertion (IsStructure structure1) structure1 a
524− , K1Table "Right" Insertion (IsStructure structure2) structure2 b
525+ , K1Table "Left" Insert (IsStructure structure1) structure1 a
526+ , K1Table "Right" Insert (IsStructure structure2) structure2 b
525527 , e ~ EitherTable a b
526528 , KnownSymbol label
527− ) => K1Table label Insertion 'True (Shape2 'Either structure1 structure2) e
529+ ) => K1Table label Insert 'True (Shape2 'Either structure1 structure2) e
528530 where
529531 fromK1Columns =
530532 fromColumns2
@@ -615,11 +617,11 @@ instance
615617
616618
617619instance
618− ( Table Insertion a
620+ ( Table Insert a
619621 , K1Columns label structure ~ HLabel label (Columns a)
620622 , as ~ ListTable a
621623 , KnownSymbol label
622− ) => K1Table label Insertion 'True (Shape1 'List structure) as
624+ ) => K1Table label Insert 'True (Shape1 'List structure) as
623625 where
624626 fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
625627 toK1Columns = hrelabel (hlabel hlabeler) . toColumns
@@ -688,10 +690,10 @@ instance
688690
689691instance
690692 ( HTable (K1Columns "Just" structure)
691− , K1Table "Just" Insertion (IsStructure structure) structure a
693+ , K1Table "Just" Insert (IsStructure structure) structure a
692694 , ma ~ MaybeTable a
693695 , KnownSymbol label
694− ) => K1Table label Insertion 'True (Shape1 'Maybe structure) ma
696+ ) => K1Table label Insert 'True (Shape1 'Maybe structure) ma
695697 where
696698 fromK1Columns =
697699 fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .
@@ -766,11 +768,11 @@ instance
766768
767769
768770instance
769− ( Table Insertion a
771+ ( Table Insert a
770772 , K1Columns label structure ~ HLabel label (Columns a)
771773 , as ~ NonEmptyTable a
772774 , KnownSymbol label
773− ) => K1Table label Insertion 'True (Shape1 'NonEmpty structure) as
775+ ) => K1Table label Insert 'True (Shape1 'NonEmpty structure) as
774776 where
775777 fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)
776778 toK1Columns = hrelabel (hlabel hlabeler) . toColumns
@@ -852,11 +854,11 @@ instance
852854instance
853855 ( HTable (K1Columns "Here" structure1)
854856 , HTable (K1Columns "There" structure2)
855− , K1Table "Here" Insertion (IsStructure structure1) structure1 a
856− , K1Table "There" Insertion (IsStructure structure2) structure2 b
857+ , K1Table "Here" Insert (IsStructure structure1) structure1 a
858+ , K1Table "There" Insert (IsStructure structure2) structure2 b
857859 , e ~ TheseTable a b
858860 , KnownSymbol label
859− ) => K1Table label Insertion 'True (Shape2 'These structure1 structure2) e
861+ ) => K1Table label Insert 'True (Shape2 'These structure1 structure2) e
860862 where
861863 fromK1Columns =
862864 fromColumns2
src/Rel8/Schema/Insert.hsnew file+160
@@ -0,0 +1,160 @@
1+{-# language DataKinds #-}
2+{-# language DuplicateRecordFields #-}
3+{-# language FlexibleContexts #-}
4+{-# language FlexibleInstances #-}
5+{-# language GADTs #-}
6+{-# language LambdaCase #-}
7+{-# language MultiParamTypeClasses #-}
8+{-# language NamedFieldPuns #-}
9+{-# language ScopedTypeVariables #-}
10+{-# language StandaloneKindSignatures #-}
11+{-# language TypeApplications #-}
12+{-# language TypeFamilies #-}
13+{-# language UndecidableInstances #-}
14+{-# language UndecidableSuperClasses #-}
15+
16+module Rel8.Schema.Insert
17+ ( Insert(..)
18+ , OnConflict(..)
19+ , Col( RequiredInsert, OptionalInsert )
20+ , Insertion(..)
21+ , Inserts
22+ )
23+where
24+
25+-- base
26+import Data.Functor.Identity ( Identity )
27+import Data.Kind ( Constraint, Type )
28+import Prelude
29+
30+-- rel8
31+import Rel8.Aggregate ( Aggregate )
32+import Rel8.Expr ( Expr )
33+import Rel8.Kind.Necessity ( Necessity(Optional, Required) )
34+import Rel8.Opaque ( Opaque, Opaque1 )
35+import Rel8.Schema.Context ( Interpretation(..) )
36+import Rel8.Schema.Context.Label ( Labelable(..) )
37+import Rel8.Schema.Context.Nullify
38+ ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
39+ , runTag, unnull
40+ )
41+import Rel8.Schema.HTable.Type ( HType(HType) )
42+import qualified Rel8.Schema.Kind as K
43+import Rel8.Schema.Name ( Name, Selects )
44+import Rel8.Schema.Nullability ( Sql )
45+import Rel8.Schema.Spec ( SSpec(SSpec, nullability), Spec(Spec) )
46+import Rel8.Schema.Table ( TableSchema )
47+import Rel8.Statement.Returning ( Returning )
48+import Rel8.Table ( Table(..) )
49+import Rel8.Table.Recontextualize ( Recontextualize )
50+import Rel8.Type ( DBType )
51+
52+
53+-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
54+-- statement.
55+data OnConflict
56+ = Abort -- ^ @ON CONFLICT ABORT@
57+ | DoNothing -- ^ @ON CONFLICT DO NOTHING@
58+
59+
60+-- | The constituent parts of a SQL @INSERT@ statement.
61+type Insert :: K.Context
62+data Insert a where
63+ Insert :: (Selects names exprs, Inserts exprs inserts) =>
64+ { into :: TableSchema names
65+ -- ^ Which table to insert into.
66+ , rows :: [inserts]
67+ -- ^ The rows to insert.
68+ , onConflict :: OnConflict
69+ -- ^ What to do if the inserted rows conflict with data already in the
70+ -- table.
71+ , returning :: Returning names a
72+ -- ^ What information to return on completion.
73+ }
74+ -> Insert a
75+
76+
77+instance Interpretation Insert where
78+ data Col Insert _spec where
79+ RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required db a)
80+ OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional db a)
81+
82+
83+type Insertion :: K.Context
84+newtype Insertion a = Insertion (Expr a)
85+
86+
87+instance Sql DBType a => Table Insert (Insertion a) where
88+ type Columns (Insertion a) = HType a
89+ type Context (Insertion a) = Insert
90+
91+ toColumns (Insertion a) = HType (RequiredInsert a)
92+ fromColumns (HType (RequiredInsert a)) = Insertion a
93+
94+
95+instance Sql DBType a =>
96+ Recontextualize Aggregate Insert (Aggregate (Expr a)) (Insertion a)
97+
98+
99+instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Insertion a)
100+
101+
102+instance Sql DBType a =>
103+ Recontextualize Identity Insert (Identity a) (Insertion a)
104+
105+
106+instance Sql DBType a =>
107+ Recontextualize Insert Aggregate (Insertion a) (Aggregate (Expr a))
108+
109+
110+instance Sql DBType a => Recontextualize Insert Expr (Insertion a) (Expr a)
111+
112+
113+instance Sql DBType a =>
114+ Recontextualize Insert Identity (Insertion a) (Identity a)
115+
116+
117+instance Sql DBType a => Recontextualize Insert Insert (Insertion a) (Insertion a)
118+
119+
120+instance Sql DBType a => Recontextualize Insert Name (Insertion a) (Name a)
121+
122+
123+instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion a)
124+
125+
126+instance Labelable Insert where
127+ labeler = \case
128+ RequiredInsert a -> RequiredInsert a
129+ OptionalInsert ma -> OptionalInsert ma
130+
131+ unlabeler = \case
132+ RequiredInsert a -> RequiredInsert a
133+ OptionalInsert ma -> OptionalInsert ma
134+
135+
136+instance Nullifiable Insert where
137+ encodeTag = RequiredInsert
138+ decodeTag (RequiredInsert a) = a
139+
140+ nullifier tag SSpec {nullability} = \case
141+ RequiredInsert a -> RequiredInsert $ runTag nullability tag a
142+ OptionalInsert ma -> OptionalInsert $ runTag nullability tag <$> ma
143+
144+ unnullifier _ SSpec {nullability} = \case
145+ RequiredInsert a -> RequiredInsert $ unnull nullability a
146+ OptionalInsert ma -> OptionalInsert $ unnull nullability <$> ma
147+
148+ {-# INLINABLE encodeTag #-}
149+ {-# INLINABLE decodeTag #-}
150+ {-# INLINABLE nullifier #-}
151+ {-# INLINABLE unnullifier #-}
152+
153+
154+
155+-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
156+-- with the table @b@.
157+type Inserts :: Type -> Type -> Constraint
158+class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
159+instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts
160+instance {-# OVERLAPPING #-} Inserts (Opaque1 Expr Opaque) (Opaque1 Insert Opaque)
src/Rel8/Schema/Name.hsnew file+112
@@ -0,0 +1,112 @@
1+{-# language DataKinds #-}
2+{-# language DerivingStrategies #-}
3+{-# language FlexibleContexts #-}
4+{-# language FlexibleInstances #-}
5+{-# language GeneralizedNewtypeDeriving #-}
6+{-# language MultiParamTypeClasses #-}
7+{-# language RankNTypes #-}
8+{-# language ScopedTypeVariables #-}
9+{-# language StandaloneKindSignatures #-}
10+{-# language TypeApplications #-}
11+{-# language TypeFamilies #-}
12+{-# language UndecidableInstances #-}
13+{-# language UndecidableSuperClasses #-}
14+
15+module Rel8.Schema.Name
16+ ( Name(..)
17+ , Col( NameCol )
18+ , Selects
19+ )
20+where
21+
22+-- base
23+import Data.Functor.Identity ( Identity )
24+import qualified Data.List.NonEmpty as NonEmpty
25+import Data.Kind ( Constraint, Type )
26+import Data.String ( IsString )
27+import Prelude
28+
29+-- rel8
30+import Rel8.Expr ( Expr )
31+import Rel8.Kind.Labels ( KnownLabels, labelsSing, renderLabels )
32+import Rel8.Opaque ( Opaque, Opaque1 )
33+import Rel8.Schema.Context ( Interpretation, Col )
34+import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
35+import Rel8.Schema.Context.Nullify
36+ ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier
37+ )
38+import Rel8.Schema.HTable.Type ( HType( HType ) )
39+import qualified Rel8.Schema.Kind as K
40+import Rel8.Schema.Nullability ( Sql )
41+import Rel8.Schema.Spec ( Spec( Spec ) )
42+import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
43+import Rel8.Table.Recontextualize ( Recontextualize )
44+import Rel8.Type ( DBType )
45+
46+
47+-- | A @Name@ is the name of a column, as it would be defined in a table's
48+-- schema definition. You can construct names by using the @OverloadedStrings@
49+-- extension and writing string literals. This is typically done when providing
50+-- a 'TableSchema' value.
51+type Name :: K.Context
52+newtype Name a = Name String
53+ deriving stock Show
54+ deriving newtype (IsString, Monoid, Semigroup)
55+
56+
57+instance Sql DBType a => Table Name (Name a) where
58+ type Columns (Name a) = HType a
59+ type Context (Name a) = Name
60+
61+ toColumns (Name a) = HType (NameCol a)
62+ fromColumns (HType (NameCol a)) = Name a
63+
64+
65+instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)
66+
67+
68+instance Sql DBType a => Recontextualize Identity Name (Identity a) (Name a)
69+
70+
71+instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)
72+
73+
74+instance Sql DBType a => Recontextualize Name Identity (Name a) (Identity a)
75+
76+
77+instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)
78+
79+
80+instance Interpretation Name where
81+ newtype Col Name _spec = NameCol String
82+
83+
84+instance Labelable Name where
85+ labeler (NameCol a) = NameCol a
86+ unlabeler (NameCol a) = NameCol a
87+
88+
89+instance Nullifiable Name where
90+ encodeTag _ = nameFromLabel
91+ decodeTag _ = mempty
92+ nullifier _ _ (NameCol name) = NameCol name
93+ unnullifier _ _ (NameCol name) = NameCol name
94+
95+ {-# INLINABLE encodeTag #-}
96+ {-# INLINABLE decodeTag #-}
97+ {-# INLINABLE nullifier #-}
98+ {-# INLINABLE unnullifier #-}
99+
100+
101+nameFromLabel :: forall labels necessity db a.
102+ KnownLabels labels => Col Name ('Spec labels necessity db a)
103+nameFromLabel = case labelsSing @labels of
104+ labels -> NameCol (NonEmpty.last (renderLabels labels))
105+
106+
107+-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
108+-- the 'Expr' columns in @b@.
109+type Selects :: Type -> Type -> Constraint
110+class Recontextualize Name Expr names exprs => Selects names exprs
111+instance Recontextualize Name Expr names exprs => Selects names exprs
112+instance {-# OVERLAPPING #-} Selects (Opaque1 Name Opaque) (Opaque1 Expr Opaque)
src/Rel8/Statement/Delete.hs+1−1
@@ -29,11 +29,11 @@ import qualified Opaleye.Internal.Manipulation as Opaleye
2929-- rel8
3030import Rel8.Expr ( Expr )
3131import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
32+import Rel8.Schema.Name ( Selects )
3233import Rel8.Schema.Table ( TableSchema )
3334import Rel8.Statement.Returning ( Returning( NumberOfRowsAffected, Projection ) )
3435import Rel8.Table ( fromColumns, toColumns )
3536import Rel8.Table.Opaleye ( table, unpackspec )
36−import Rel8.Table.Recontextualize ( Selects )
3737import Rel8.Table.Serialize ( Serializable, parse )
3838
3939-- text
src/Rel8/Statement/Insert.hs+4−31
@@ -1,9 +1,6 @@
1−{-# language DuplicateRecordFields #-}
2−{-# language FlexibleContexts #-}
31{-# language GADTs #-}
42{-# language NamedFieldPuns #-}
53{-# language ScopedTypeVariables #-}
6−{-# language StandaloneKindSignatures #-}
74{-# language TypeApplications #-}
85
96module Rel8.Statement.Insert
@@ -15,7 +12,6 @@ where
1512
1613-- base
1714import Control.Exception ( throwIO )
18−import Data.Kind ( Type )
1915import Data.List.NonEmpty ( NonEmpty( (:|) ) )
2016import Prelude
2117
@@ -26,14 +22,15 @@ import qualified Hasql.Encoders as Hasql
2622import qualified Hasql.Session as Hasql
2723import qualified Hasql.Statement as Hasql
2824
29−-- rel8
25+-- opaleye
3026import qualified Opaleye.Internal.Manipulation as Opaleye
3127import qualified Opaleye.Manipulation as Opaleye
32−import Rel8.Schema.Table ( TableSchema )
28+
29+-- rel8
30+import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )
3331import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
3432import Rel8.Table ( fromColumns, toColumns )
3533import Rel8.Table.Opaleye ( table, unpackspec )
36−import Rel8.Table.Recontextualize ( Inserts, Selects )
3734import Rel8.Table.Serialize ( Serializable, parse )
3835
3936-- text
@@ -41,30 +38,6 @@ import qualified Data.Text as Text ( pack )
4138import Data.Text.Encoding ( encodeUtf8 )
4239
4340
44−-- | The constituent parts of a SQL @INSERT@ statement.
45−type Insert :: Type -> Type
46−data Insert a where
47− Insert :: (Selects names exprs, Inserts exprs inserts) =>
48− { into :: TableSchema names
49− -- ^ Which table to insert into.
50− , rows :: [inserts]
51− -- ^ The rows to insert.
52− , onConflict :: OnConflict
53− -- ^ What to do if the inserted rows conflict with data already in the
54− -- table.
55− , returning :: Returning names a
56− -- ^ What information to return on completion.
57− }
58− -> Insert a
59−
60−
61−-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@
62−-- statement.
63−data OnConflict
64− = Abort -- ^ @ON CONFLICT ABORT@
65− | DoNothing -- ^ @ON CONFLICT DO NOTHING@
66−
67−
6841-- | Run an @INSERT@ statement
6942--
7043-- >>> :{
src/Rel8/Statement/Returning.hs+1−1
@@ -12,7 +12,7 @@ import Data.Kind ( Type )
1212import Prelude ()
1313
1414-- rel8
15−import Rel8.Table.Recontextualize ( Selects )
15+import Rel8.Schema.Name ( Selects )
1616import Rel8.Table.Serialize ( Serializable )
1717
1818
src/Rel8/Statement/Select.hs+1−1
@@ -21,7 +21,7 @@ import qualified Hasql.Statement as Hasql
2121-- rel8
2222import Rel8.Query ( Query )
2323import Rel8.Query.SQL ( sqlForQuery, sqlForQueryWithNames )
24−import Rel8.Table.Recontextualize ( Selects )
24+import Rel8.Schema.Name ( Selects )
2525import Rel8.Table.Serialize ( Serializable, parse )
2626
2727-- text
src/Rel8/Statement/Update.hs+1−1
@@ -31,12 +31,12 @@ import Data.Profunctor ( lmap )
3131-- rel8
3232import Rel8.Expr ( Expr )
3333import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )
34+import Rel8.Schema.Name ( Selects )
3435import Rel8.Schema.Table ( TableSchema )
3536import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )
3637import Rel8.Table ( fromColumns, toColumns )
3738import Rel8.Table.Insert ( toInsert )
3839import Rel8.Table.Opaleye ( table, unpackspec )
39−import Rel8.Table.Recontextualize ( Selects )
4040import Rel8.Table.Serialize ( Serializable, parse )
4141
4242-- text
src/Rel8/Statement/View.hs+1−1
@@ -22,9 +22,9 @@ import qualified Hasql.Statement as Hasql
2222-- rel8
2323import Rel8.Query ( Query )
2424import Rel8.Query.SQL ( sqlForQueryWithNames )
25+import Rel8.Schema.Name ( Selects )
2526import Rel8.Schema.Table ( TableSchema( TableSchema ) )
2627import Rel8.Table.Alternative ( emptyTable )
27−import Rel8.Table.Recontextualize ( Selects )
2828
2929-- text
3030import qualified Data.Text as Text
src/Rel8/Table.hs+6−32
@@ -20,12 +20,11 @@ import Data.Kind ( Constraint, Type )
2020import Prelude
2121
2222-- rel8
23−import Rel8.Aggregate ( Aggregate )
24−import Rel8.Expr ( Expr )
23+import {-# SOURCE #-} Rel8.Expr ( Expr )
2524import Rel8.Opaque ( Opaque, Opaque1 )
26−import Rel8.Schema.Context ( Col(..), Insertion(..), Name(..) )
25+import Rel8.Schema.Context ( Col(..) )
2726import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )
28−import Rel8.Schema.HTable ( HTable, hfield, hspecs, htabulate, htabulateA )
27+import Rel8.Schema.HTable ( HTable )
2928import Rel8.Schema.HTable.Identity ( HIdentity(..) )
3029import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )
3130import Rel8.Schema.HTable.Pair ( HPair(..) )
@@ -35,7 +34,7 @@ import Rel8.Schema.HTable.Trio ( HTrio(..) )
3534import Rel8.Schema.HTable.Type ( HType( HType ) )
3635import qualified Rel8.Schema.Kind as K
3736import Rel8.Schema.Nullability ( Sql )
38−import Rel8.Schema.Spec ( SSpec( SSpec ), KnownSpec )
37+import Rel8.Schema.Spec ( KnownSpec )
3938import Rel8.Type ( DBType )
4039
4140
@@ -78,25 +77,6 @@ instance KnownSpec spec => Table context (Col context spec) where
7877 fromColumns = unHIdentity
7978
8079
81−instance Table Expr a => Table Aggregate (Aggregate a) where
82− type Columns (Aggregate a) = Columns a
83− type Context (Aggregate a) = Aggregate
84−
85− toColumns a = htabulate $ \field -> case hfield hspecs field of
86− SSpec {} -> Aggregation $ unDB . (`hfield` field) . toColumns <$> a
87− fromColumns as = fmap fromColumns $ htabulateA $ \field ->
88− case hfield as field of
89− Aggregation a -> DB <$> a
90−
91−
92−instance Sql DBType a => Table Expr (Expr a) where
93− type Columns (Expr a) = HType a
94− type Context (Expr a) = Expr
95−
96− toColumns a = HType (DB a)
97− fromColumns (HType (DB a)) = a
98−
99−
10080instance Sql DBType a => Table Identity (Identity a) where
10181 type Columns (Identity a) = HType a
10282 type Context (Identity a) = Identity
@@ -105,20 +85,14 @@ instance Sql DBType a => Table Identity (Identity a) where
10585 fromColumns (HType (Result a)) = Identity a
10686
10787
88+{-}
10889instance Sql DBType a => Table Insertion (Insertion a) where
10990 type Columns (Insertion a) = HType a
11091 type Context (Insertion a) = Insertion
11192
11293 toColumns (Insertion a) = HType (RequiredInsert a)
11394 fromColumns (HType (RequiredInsert a)) = Insertion a
114−
115−
116−instance Sql DBType a => Table Name (Name a) where
117− type Columns (Name a) = HType a
118− type Context (Name a) = Name
119−
120− toColumns (Name a) = HType (NameCol a)
121− fromColumns (HType (NameCol a)) = Name a
95+-}
12296
12397
12498instance
src/Rel8/Table/Aggregate.hs+2−4
@@ -18,10 +18,9 @@ import Data.Functor.Identity ( Identity( Identity ) )
1818import Prelude
1919
2020-- rel8
21−import Rel8.Aggregate ( Aggregate )
22−import Rel8.Expr ( Expr )
21+import Rel8.Aggregate ( Aggregate, Aggregates, Col(..) )
22+import Rel8.Expr ( Expr, Col(..) )
2323import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr, sgroupByExpr )
24−import Rel8.Schema.Context ( Col(..) )
2524import Rel8.Schema.Dict ( Dict( Dict ) )
2625import Rel8.Schema.HTable ( htabulate, hfield, hdicts, hspecs )
2726import Rel8.Schema.HTable.Vectorize ( hvectorize )
@@ -31,7 +30,6 @@ import Rel8.Table ( Table, Columns, toColumns, fromColumns )
3130import Rel8.Table.Eq ( EqTable )
3231import Rel8.Table.List ( ListTable )
3332import Rel8.Table.NonEmpty ( NonEmptyTable )
34−import Rel8.Table.Recontextualize ( Aggregates )
3533import Rel8.Type.Eq ( DBEq )
3634
3735
src/Rel8/Table/Bool.hs+1−2
@@ -12,9 +12,8 @@ where
1212import Prelude
1313
1414-- rel8
15−import Rel8.Expr ( Expr )
15+import Rel8.Expr ( Expr, Col(..) )
1616import Rel8.Expr.Bool ( boolExpr, caseExpr )
17−import Rel8.Schema.Context ( Col(..) )
1817import Rel8.Schema.HTable ( htabulate, hfield )
1918import Rel8.Table ( Table, fromColumns, toColumns )
2019
src/Rel8/Table/Eq.hs+1−2
@@ -23,11 +23,10 @@ import Data.List.NonEmpty ( NonEmpty( (:|) ) )
2323import Prelude hiding ( seq )
2424
2525-- rel8
26−import Rel8.Expr ( Expr )
26+import Rel8.Expr ( Expr, Col(..) )
2727import Rel8.Expr.Bool ( (||.), (&&.) )
2828import Rel8.Expr.Eq ( seq, sne )
2929import Rel8.Opaque ( Opaque )
30−import Rel8.Schema.Context ( Col(..) )
3130import Rel8.Schema.Dict ( Dict( Dict ) )
3231import Rel8.Schema.HTable
3332 ( HConstrainTable
src/Rel8/Table/Insert.hs+2−2
@@ -13,12 +13,12 @@ where
1313import Prelude
1414
1515-- rel8
16+import Rel8.Expr ( Col(..) )
1617import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )
17−import Rel8.Schema.Context ( Col(..) )
1818import Rel8.Schema.HTable ( hfield, htabulate, hspecs )
19+import Rel8.Schema.Insert ( Inserts, Col(..) )
1920import Rel8.Schema.Spec ( SSpec(..) )
2021import Rel8.Table ( fromColumns, toColumns )
21−import Rel8.Table.Recontextualize ( Inserts )
2222
2323
2424-- | @toInsert@ converts a 'Table' of 'Expr's into a 'Table' that can be used
src/Rel8/Table/List.hs+1−2
@@ -15,9 +15,8 @@ import Data.Kind ( Type )
1515import Prelude
1616
1717-- rel8
18−import Rel8.Expr ( Expr )
18+import Rel8.Expr ( Expr, Col(..) )
1919import Rel8.Expr.Array ( sappend, sempty )
20−import Rel8.Schema.Context ( Col(..) )
2120import Rel8.Schema.HTable.List ( HListTable )
2221import Rel8.Schema.HTable.Vectorize ( happend, hempty )
2322import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
src/Rel8/Table/Name.hs+2−2
@@ -24,10 +24,10 @@ import Prelude
2424import Text.Casing ( quietSnake )
2525
2626-- rel8
27−import Rel8.Expr ( Expr )
27+import Rel8.Expr ( Expr, Col(..) )
2828import Rel8.Kind.Labels ( renderLabels )
29−import Rel8.Schema.Context ( Col(..), Name )
3029import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )
30+import Rel8.Schema.Name ( Name, Col(..) )
3131import Rel8.Schema.Spec ( SSpec(..) )
3232import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )
3333
src/Rel8/Table/NonEmpty.hs+1−2
@@ -15,9 +15,8 @@ import Data.Kind ( Type )
1515import Prelude
1616
1717-- rel8
18−import Rel8.Expr ( Expr )
18+import Rel8.Expr ( Expr, Col(..) )
1919import Rel8.Expr.Array ( sappend1 )
20−import Rel8.Schema.Context ( Col(..) )
2120import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )
2221import Rel8.Schema.HTable.Vectorize ( happend )
2322import Rel8.Table ( Table, Context, Columns, fromColumns, toColumns )
src/Rel8/Table/Opaleye.hs+4−4
@@ -33,7 +33,7 @@ import Data.Profunctor ( dimap, lmap )
3333
3434-- rel8
3535import Rel8.Aggregate ( Aggregate( Aggregate ) )
36−import Rel8.Expr ( Expr )
36+import Rel8.Expr ( Expr, Col(..) )
3737import Rel8.Expr.Opaleye
3838 ( scastExpr
3939 , fromPrimExpr, toPrimExpr
@@ -41,12 +41,12 @@ import Rel8.Expr.Opaleye
4141 , fromColumn, toColumn
4242 )
4343import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )
44−import Rel8.Schema.Context ( Col(..), Insertion, Name(..) )
4544import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs )
45+import Rel8.Schema.Insert ( Insert, Inserts, Col(..) )
46+import Rel8.Schema.Name ( Name, Selects, Col(..) )
4647import Rel8.Schema.Spec ( SSpec(..) )
4748import Rel8.Schema.Table ( TableSchema(..) )
4849import Rel8.Table ( Table, fromColumns, toColumns )
49−import Rel8.Table.Recontextualize ( Selects, Inserts )
5050import Rel8.Table.Undefined ( undefined )
5151
5252-- semigroupoids
@@ -95,7 +95,7 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $
9595 specs -> case hfield names field of
9696 name -> lmap (`hfield` field) (go specs name)
9797 where
98− go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insertion spec) (Col Expr spec)
98+ go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)
9999 go SSpec {necessity, info, nullability} (NameCol name) =
100100 case necessity of
101101 SRequired ->
src/Rel8/Table/Ord.hs+1−2
@@ -20,12 +20,11 @@ import Data.Kind ( Constraint, Type )
2020import Prelude hiding ( seq )
2121
2222-- rel8
23−import Rel8.Expr ( Expr )
23+import Rel8.Expr ( Expr, Col(..) )
2424import Rel8.Expr.Bool ( (||.), (&&.), false, true )
2525import Rel8.Expr.Eq ( seq )
2626import Rel8.Expr.Ord ( slt, sgt)
2727import Rel8.Opaque ( Opaque )
28−import Rel8.Schema.Context ( Col(..) )
2928import Rel8.Schema.Dict ( Dict( Dict ) )
3029import Rel8.Schema.HTable
3130 ( HConstrainTable
src/Rel8/Table/Order.hs+1−1
@@ -15,9 +15,9 @@ import Data.Functor.Contravariant ( (>$<), contramap )
1515import Prelude
1616
1717-- rel8
18+import Rel8.Expr ( unDB )
1819import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )
1920import Rel8.Order ( Order )
20−import Rel8.Schema.Context ( unDB )
2121import Rel8.Schema.Dict ( Dict( Dict ) )
2222import Rel8.Schema.HTable (htabulateA, hfield, hdicts, hspecs)
2323import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
src/Rel8/Table/Recontextualize.hs+8−82
@@ -1,5 +1,4 @@
11{-# language DataKinds #-}
2−{-# language FlexibleContexts #-}
32{-# language FlexibleInstances #-}
43{-# language FunctionalDependencies #-}
54{-# language StandaloneKindSignatures #-}
@@ -9,10 +8,6 @@
98
109module Rel8.Table.Recontextualize
1110 ( Recontextualize
12− , Aggregates
13− , Encodes
14− , Selects
15− , Inserts
1611 )
1712where
1813
@@ -22,10 +17,8 @@ import Data.Kind ( Constraint, Type )
2217import Prelude ()
2318
2419-- rel8
25−import Rel8.Aggregate ( Aggregate )
26−import Rel8.Expr ( Expr )
27−import Rel8.Opaque ( Opaque, Opaque1 )
28−import Rel8.Schema.Context ( Col(..), Insertion, Name )
20+import Rel8.Opaque ( Opaque1 )
21+import Rel8.Schema.Context ( Col )
2922import Rel8.Schema.Context.Label ( Labelable )
3023import Rel8.Schema.HTable ( HTable )
3124import qualified Rel8.Schema.Kind as K
@@ -54,59 +47,23 @@ instance KnownSpec spec =>
5447 Recontextualize from to (Col from spec) (Col to spec)
5548
5649
57−instance Sql DBType a =>
58− Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))
59−
60−
61−instance Sql DBType a =>
62− Recontextualize Aggregate Expr (Aggregate (Expr a)) (Expr a)
63−
64−
65−instance Sql DBType a =>
66− Recontextualize Aggregate Identity (Aggregate (Expr a)) (Identity a)
67−
68−
50+{-
6951instance Sql DBType a =>
7052 Recontextualize Aggregate Insertion (Aggregate (Expr a)) (Insertion a)
7153
7254
73−instance Sql DBType a =>
74− Recontextualize Aggregate Name (Aggregate (Expr a)) (Name a)
75−
76−
77−instance Sql DBType a =>
78− Recontextualize Expr Aggregate (Expr a) (Aggregate (Expr a))
79−
80−
81−instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)
82−
83−
84−instance Sql DBType a => Recontextualize Expr Identity (Expr a) (Identity a)
85−
86−
8755instance Sql DBType a => Recontextualize Expr Insertion (Expr a) (Insertion a)
88−
89−
90−instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)
91−
92−
93−instance Sql DBType a =>
94− Recontextualize Identity Aggregate (Identity a) (Aggregate (Expr a))
95−
96−
97−instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)
56+-}
9857
9958
10059instance Sql DBType a => Recontextualize Identity Identity (Identity a) (Identity a)
10160
10261
62+{-
10363instance Sql DBType a =>
10464 Recontextualize Identity Insertion (Identity a) (Insertion a)
10565
10666
107−instance Sql DBType a => Recontextualize Identity Name (Identity a) (Name a)
108−
109−
11067instance Sql DBType a =>
11168 Recontextualize Insertion Aggregate (Insertion a) (Aggregate (Expr a))
11269
@@ -124,20 +81,8 @@ instance Sql DBType a => Recontextualize Insertion Insertion (Insertion a) (Inse
12481instance Sql DBType a => Recontextualize Insertion Name (Insertion a) (Name a)
12582
12683
127−instance Sql DBType a =>
128− Recontextualize Name Aggregate (Name a) (Aggregate (Expr a))
129−
130−
131−instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)
132−
133−
134−instance Sql DBType a => Recontextualize Name Identity (Name a) (Identity a)
135−
136−
13784instance Sql DBType a => Recontextualize Name Insertion (Name a) (Insertion a)
138−
139−
140−instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)
85+-}
14186
14287
14388instance Recontextualize from to (Opaque1 from a) (Opaque1 to a)
@@ -188,19 +133,7 @@ instance
188133 ) => Recontextualize from to (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)
189134
190135
191−-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's
192−-- for the columns in @b@.
193−type Aggregates :: Type -> Type -> Constraint
194−class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
195−instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs
196−instance {-# OVERLAPPING #-} Aggregates (Opaque1 Aggregate Opaque) (Opaque1 Expr Opaque)
197−
198−
199−type Encodes :: Type -> Type -> Constraint
200−class Recontextualize Identity Expr a exprs => Encodes a exprs
201−instance Recontextualize Identity Expr a exprs => Encodes a exprs
202−instance {-# OVERLAPPING #-} Encodes (Opaque1 Identity Opaque) (Opaque1 Expr Opaque)
203−
136+{-
204137
205138-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting
206139-- with the table @b@.
@@ -208,11 +141,4 @@ type Inserts :: Type -> Type -> Constraint
208141class Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts
209142instance Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts
210143instance {-# OVERLAPPING #-} Inserts (Opaque1 Expr Opaque) (Opaque1 Insertion Opaque)
211−
212−
213−-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for
214−-- the 'Expr' columns in @b@.
215−type Selects :: Type -> Type -> Constraint
216−class Recontextualize Name Expr names exprs => Selects names exprs
217−instance Recontextualize Name Expr names exprs => Selects names exprs
218−instance {-# OVERLAPPING #-} Selects (Opaque1 Name Opaque) (Opaque1 Expr Opaque)
144+-}
src/Rel8/Table/Serialize.hs+1−2
@@ -28,7 +28,7 @@ import Prelude
2828import qualified Hasql.Decoders as Hasql
2929
3030-- rel8
31−import Rel8.Expr ( Expr )
31+import Rel8.Expr ( Expr, Encodes, Col(..) )
3232import Rel8.Expr.Serialize ( slitExpr, sparseValue )
3333import Rel8.Opaque ( Opaque )
3434import Rel8.Schema.Context ( Col(..) )
@@ -54,7 +54,6 @@ import Rel8.Table.Either ( EitherTable )
5454import Rel8.Table.List ( ListTable )
5555import Rel8.Table.Maybe ( MaybeTable )
5656import Rel8.Table.NonEmpty ( NonEmptyTable )
57−import Rel8.Table.Recontextualize ( Encodes )
5857import Rel8.Table.These ( TheseTable )
5958import Rel8.Type ( DBType )
6059
src/Rel8/Table/Undefined.hs+1−2
@@ -11,9 +11,8 @@ where
1111import Prelude hiding ( undefined )
1212
1313-- rel8
14−import Rel8.Expr ( Expr )
14+import Rel8.Expr ( Expr, Col(..) )
1515import Rel8.Expr.Null ( snull, unsafeUnnullify )
16−import Rel8.Schema.Context ( Col(..) )
1716import Rel8.Schema.HTable ( htabulate, hfield, hspecs )
1817import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )
1918import Rel8.Schema.Spec ( SSpec(..) )