97d89cf · rel8 · git.iko.soy

git.iko.soy/rel8

Remove Interpretation and Col (#107)

This commit removes the `Interpretation` type class and - by extension - the associated `Col` newtype. We were doing this because we want to use things like `Expr` with `Type`s (e.g., `Expr Bool`), but also use `Expr`s with `Spec`s (e.g., `Col Expr ('Spec Bool)`). I realised that we don't need to jump through `Col` to do this, we can take advantage of `Expr`s polymorphic kind. This essentially means moving the constructors in `Col` directly into the associated contexts. With this done, we no longer need to distinguish between a `HContext` and `Context`, so we drop `HContext` and change `Context` to be `Spec -> Type`. A consequence of this is that `KRel8able` changes to be `(Spec -> Type) -> Type`, which is direct conflict with `HTable` - so only one of these can be `Table`s. We choose `Rel8able` to win, and add `Cols` to treat any `HTable` as a `Table` (thus allowing any `htable f` to be a `Table f`).

commit97d89cf8b01070fa7a9254f8a6834322474be48e authorOllie Charles <oliver.charles@circuithub.com> dateTue 6 Jul 2021, 16:57 (5 years ago) parent7c5422f

44 files changed+317−343

compare with master

unifiedsplit

rel8.cabal+1−1 src/Rel8/Aggregate.hs+7−14 src/Rel8/Expr.hs+4−14 src/Rel8/Expr.hs-boot+6−2 src/Rel8/Generic/Construction.hs+29−29 src/Rel8/Generic/Construction/ADT.hs+7−7 src/Rel8/Generic/Construction/Record.hs+3−3 src/Rel8/Generic/Rel8able.hs+11−11 src/Rel8/Generic/Table.hs+4−5 src/Rel8/Generic/Table/ADT.hs+9−11 src/Rel8/Query/Each.hs+3−3 src/Rel8/Query/List.hs+5−4 src/Rel8/Query/Maybe.hs+7−5 src/Rel8/Query/SQL.hs+4−3 src/Rel8/Query/These.hs+1−1 src/Rel8/Schema/Context.hs−26 src/Rel8/Schema/Context/Nullify.hs+11−11 src/Rel8/Schema/HTable.hs+1−1 src/Rel8/Schema/Kind.hs+4−15 src/Rel8/Schema/Name.hs+3−9 src/Rel8/Schema/Result.hs+31−16 src/Rel8/Statement/Delete.hs+6−6 src/Rel8/Statement/Insert.hs+6−6 src/Rel8/Statement/Update.hs+8−8 src/Rel8/Table.hs+12−27 src/Rel8/Table/ADT.hs+10−4 src/Rel8/Table/Aggregate.hs+4−4 src/Rel8/Table/Bool.hs+1−1 src/Rel8/Table/Cols.hs+53 src/Rel8/Table/Either.hs+5−5 src/Rel8/Table/Eq.hs+2−15 src/Rel8/Table/HKD.hs+1−2 src/Rel8/Table/List.hs+3−3 src/Rel8/Table/Maybe.hs+5−5 src/Rel8/Table/Name.hs+9−4 src/Rel8/Table/NonEmpty.hs+3−3 src/Rel8/Table/Nullify.hs+4−5 src/Rel8/Table/Opaleye.hs+9−7 src/Rel8/Table/Ord.hs+2−17 src/Rel8/Table/Recontextualize.hs+1−6 src/Rel8/Table/Rel8able.hs+7−5 src/Rel8/Table/Serialize.hs+7−11 src/Rel8/Table/Undefined.hs+1−1 src/Rel8/Type/Composite.hs+7−7

rel8.cabal+1−1

@@ -114,7 +114,6 @@ library

114114 Rel8.Query.These

115115 Rel8.Query.Values

116116

117− Rel8.Schema.Context

118117 Rel8.Schema.Context.Nullify

119118 Rel8.Schema.Context.Virtual

120119 Rel8.Schema.Dict

@@ -150,6 +149,7 @@ library

150149 Rel8.Table.Aggregate

151150 Rel8.Table.Alternative

152151 Rel8.Table.Bool

152+ Rel8.Table.Cols

153153 Rel8.Table.Either

154154 Rel8.Table.Eq

155155 Rel8.Table.HKD

src/Rel8/Aggregate.hs+7−14

@@ -5,6 +5,7 @@

55{-# language MultiParamTypeClasses #-}

66{-# language NamedFieldPuns #-}

77{-# language PolyKinds #-}

8+{-# language RankNTypes #-}

89{-# language StandaloneKindSignatures #-}

910{-# language TypeFamilies #-}

1011{-# language UndecidableInstances #-}

@@ -14,7 +15,6 @@ module Rel8.Aggregate

1415 ( Aggregate(..), foldInputs, mapInputs

1516 , Aggregator(..), unsafeMakeAggregate

1617 , Aggregates

17− , Col( A, unA )

1818 )

1919where

2020

@@ -30,11 +30,10 @@ import qualified Opaleye.Internal.PackMap as Opaleye

3030

3131-- rel8

3232import Rel8.Expr ( Expr )

33−import Rel8.Schema.Context ( Interpretation(..) )

3433import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )

3534import Rel8.Schema.Name ( Name )

3635import Rel8.Schema.Null ( Sql )

37−import Rel8.Schema.Result ( Col( R ) )

36+import Rel8.Schema.Result ( Result( R ) )

3837import Rel8.Schema.Spec ( Spec( Spec ) )

3938import Rel8.Table

4039 ( Table, Columns, Context, fromColumns, toColumns

@@ -51,14 +50,8 @@ import Rel8.Type ( DBType )

5150-- combine @Aggregate@s using the @<.>@ combinator.

5251type Aggregate :: k -> Type

5352data Aggregate a where

54− Aggregate :: !(Opaleye.Aggregator () (Expr a)) -> Aggregate a

55−

56−

57−instance Interpretation Aggregate where

58− data Col Aggregate _spec where

59− A :: ()

60− => { unA :: !(Aggregate a) }

61− -> Col Aggregate ('Spec a)

53+ Aggregate :: forall (a :: Type). !(Opaleye.Aggregator () (Expr a)) -> Aggregate a

54+ A :: { unA :: !(Aggregate a) } -> Aggregate ('Spec a)

6255

6356

6457instance Sql DBType a => Table Aggregate (Aggregate a) where

@@ -99,7 +92,7 @@ class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates e

9992instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

10093

10194

102−foldInputs :: Monoid b

95+foldInputs :: forall (a :: Type) (b :: Type). Monoid b

10396 => (Maybe Aggregator -> Opaleye.PrimExpr -> b) -> Aggregate a -> b

10497foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =

10598 getConst $ flip agg () $ \(aggregator, a) ->

@@ -109,7 +102,7 @@ foldInputs f (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =

109102 Aggregator {operation, ordering, distinction}

110103

111104

112−mapInputs :: ()

105+mapInputs :: forall (a :: Type). ()

113106 => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Aggregate a -> Aggregate a

114107mapInputs transform (Aggregate (Opaleye.Aggregator (Opaleye.PackMap agg))) =

115108 Aggregate $ Opaleye.Aggregator $ Opaleye.PackMap $ agg . \f input ->

@@ -124,7 +117,7 @@ data Aggregator = Aggregator

124117 }

125118

126119

127−unsafeMakeAggregate :: ()

120+unsafeMakeAggregate :: forall (input :: Type) (output :: Type). ()

128121 => (Expr input -> Opaleye.PrimExpr)

129122 -> (Opaleye.PrimExpr -> Expr output)

130123 -> Maybe Aggregator

src/Rel8/Expr.hs+4−14

@@ -13,11 +13,7 @@

1313{-# language UndecidableInstances #-}

1414{-# language UndecidableSuperClasses #-}

1515

16−module Rel8.Expr

17− ( Expr(..)

18− , Col( E, unE )

19− )

20−where

16+module Rel8.Expr ( Expr(..) ) where

2117

2218-- base

2319import Data.Kind ( Type )

@@ -37,10 +33,9 @@ import Rel8.Expr.Opaleye

3733 , zipPrimExprsWith

3834 )

3935import Rel8.Expr.Serialize ( litExpr )

40−import Rel8.Schema.Context ( Interpretation, Col )

4136import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )

4237import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )

43−import Rel8.Schema.Result ( Col( R ) )

38+import Rel8.Schema.Result ( Result( R ) )

4439import Rel8.Schema.Spec ( Spec( Spec ) )

4540import Rel8.Table

4641 ( Table, Columns, Context, fromColumns, toColumns

@@ -54,10 +49,10 @@ import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )

5449

5550

5651-- | Typed SQL expressions.

57−type role Expr representational

5852type Expr :: k -> Type

5953data Expr a where

60− Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)

54+ Expr :: forall (a :: Type). !Opaleye.PrimExpr -> Expr a

55+ E :: { unE :: !(Expr a) } -> Expr ('Spec a)

6156

6257

6358deriving stock instance Show (Expr a)

@@ -124,11 +119,6 @@ instance Sql DBFloating a => Floating (Expr a) where

124119 atanh = function "atanh"

125120

126121

127−instance Interpretation Expr where

128− data Col Expr _spec where

129− E :: {unE :: !(Expr a)} -> Col Expr ('Spec a)

130−

131−

132122instance Sql DBType a => Table Expr (Expr a) where

133123 type Columns (Expr a) = HType a

134124 type Context (Expr a) = Expr

src/Rel8/Expr.hs-boot+6−2

@@ -1,5 +1,7 @@

1+{-# language DataKinds #-}

12{-# language GADTs #-}

23{-# language PolyKinds #-}

4+{-# language RankNTypes #-}

35{-# language RoleAnnotations #-}

46{-# language StandaloneKindSignatures #-}

@@ -15,8 +17,10 @@ import Prelude ()

1517-- opaleye

1618import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

1719

20+import Rel8.Schema.Spec ( Spec(..) )

21+

1822

19−type role Expr representational

2023type Expr :: k -> Type

2124data Expr a where

22− Expr :: k ~ Type => !Opaleye.PrimExpr -> Expr (a :: k)

25+ Expr :: forall (a :: Type). !Opaleye.PrimExpr -> Expr a

26+ E :: { unE :: !(Expr a) } -> Expr ('Spec a)

src/Rel8/Generic/Construction.hs+29−29

@@ -29,8 +29,8 @@ import GHC.TypeLits ( Symbol )

2929import Prelude

3030

3131-- rel8

32−import Rel8.Aggregate ( Col( A ), Aggregate( Aggregate ) )

33−import Rel8.Expr ( Col( E ), Expr )

32+import Rel8.Aggregate ( Aggregate( A, Aggregate ) )

33+import Rel8.Expr ( Expr( E ) )

3434import Rel8.Expr.Aggregate ( groupByExpr )

3535import Rel8.Expr.Eq ( (==.) )

3636import Rel8.Expr.Null ( nullify, snull, unsafeUnnullify )

@@ -59,7 +59,7 @@ import Rel8.Schema.Context.Nullify ( sguard, snullify )

5959import Rel8.Schema.HTable ( HTable )

6060import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )

6161import qualified Rel8.Schema.Kind as K

62−import Rel8.Schema.Name ( Col( N ), Name( Name ) )

62+import Rel8.Schema.Name ( Name( N, Name ) )

6363import Rel8.Schema.Null ( Nullity( Null, NotNull ) )

6464import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )

6565import Rel8.Table

@@ -86,11 +86,11 @@ type family GGBuildable' algebra name rep where

8686 GGBuildable' 'K.Product name rep =

8787 ( name ~ GConstructor (Eval (rep Expr))

8888 , Representable Id (Eval (rep Expr))

89− , GConstructable (TTable Expr) TColumns Id (Col Expr) (Eval (rep Expr))

89+ , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))

9090 )

9191 GGBuildable' 'K.Sum name rep =

9292 ( Representable Id (GConstructorADT name (Eval (rep Expr)))

93− , GMakeableADT (TTable Expr) TColumns Id (Col Expr) name (Eval (rep Expr))

93+ , GMakeableADT (TTable Expr) TColumns Id Expr name (Eval (rep Expr))

9494 )

9595

9696

@@ -103,7 +103,7 @@ type family GGBuild algebra name rep r where

103103

104104

105105ggbuild :: forall algebra name rep a. GGBuildable algebra name rep

106− => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr) -> a)

106+ => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)

107107 -> GGBuild algebra name rep a

108108ggbuild gfromColumns = case algebraSing @algebra of

109109 SProduct ->

@@ -113,7 +113,7 @@ ggbuild gfromColumns = case algebraSing @algebra of

113113 @(TTable Expr)

114114 @TColumns

115115 @Id

116− @(Col Expr)

116+ @Expr

117117 @(Eval (rep Expr))

118118 (const toColumns)

119119 SSum ->

@@ -123,7 +123,7 @@ ggbuild gfromColumns = case algebraSing @algebra of

123123 @(TTable Expr)

124124 @TColumns

125125 @Id

126− @(Col Expr)

126+ @Expr

127127 @name

128128 @(Eval (rep Expr))

129129 (const toColumns)

@@ -151,9 +151,9 @@ type family GGConstructable' algebra rep where

151151 ( Representable Id (Eval (rep Aggregate))

152152 , Representable Id (Eval (rep Expr))

153153 , Representable Id (Eval (rep Name))

154− , GConstructable (TTable Aggregate) TColumns Id (Col Aggregate) (Eval (rep Aggregate))

155− , GConstructable (TTable Expr) TColumns Id (Col Expr) (Eval (rep Expr))

156− , GConstructable (TTable Name) TColumns Id (Col Name) (Eval (rep Name))

154+ , GConstructable (TTable Aggregate) TColumns Id Aggregate (Eval (rep Aggregate))

155+ , GConstructable (TTable Expr) TColumns Id Expr (Eval (rep Expr))

156+ , GConstructable (TTable Name) TColumns Id Name (Eval (rep Name))

157157 )

158158 GGConstructable' 'K.Sum rep =

159159 ( RepresentableConstructors Id (Eval (rep Expr))

@@ -161,9 +161,9 @@ type family GGConstructable' algebra rep where

161161 , RepresentableFields Id (Eval (rep Expr))

162162 , RepresentableFields Id (Eval (rep Name))

163163 , Functor (GConstructors Id (Eval (rep Expr)))

164− , GConstructableADT (TTable Aggregate) TColumns Id (Col Aggregate) (Eval (rep Aggregate))

165− , GConstructableADT (TTable Expr) TColumns Id (Col Expr) (Eval (rep Expr))

166− , GConstructableADT (TTable Name) TColumns Id (Col Name) (Eval (rep Name))

164+ , GConstructableADT (TTable Aggregate) TColumns Id Aggregate (Eval (rep Aggregate))

165+ , GConstructableADT (TTable Expr) TColumns Id Expr (Eval (rep Expr))

166+ , GConstructableADT (TTable Name) TColumns Id Name (Eval (rep Name))

167167 )

168168

169169

@@ -174,7 +174,7 @@ type family GGConstruct algebra rep r where

174174

175175

176176ggconstruct :: forall algebra rep a. GGConstructable algebra rep

177− => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr) -> a)

177+ => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr -> a)

178178 -> GGConstruct algebra rep a -> a

179179ggconstruct gfromColumns f = case algebraSing @algebra of

180180 SProduct ->

@@ -185,7 +185,7 @@ ggconstruct gfromColumns f = case algebraSing @algebra of

185185 @(TTable Expr)

186186 @TColumns

187187 @Id

188− @(Col Expr)

188+ @Expr

189189 @(Eval (rep Expr))

190190 (const toColumns)

191191 SSum ->

@@ -195,7 +195,7 @@ ggconstruct gfromColumns f = case algebraSing @algebra of

195195 @(TTable Expr)

196196 @TColumns

197197 @Id

198− @(Col Expr)

198+ @Expr

199199 @(Eval (rep Expr))

200200 (const toColumns)

201201 (\SSpec {info} -> E (snull info))

@@ -214,7 +214,7 @@ type family GGDeconstruct algebra rep a r where

214214

215215

216216ggdeconstruct :: forall algebra rep a r. (GGConstructable algebra rep, Table Expr r)

217− => (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr))

217+ => (a -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)

218218 -> GGDeconstruct algebra rep a r

219219ggdeconstruct gtoColumns = case algebraSing @algebra of

220220 SProduct -> \build ->

@@ -223,7 +223,7 @@ ggdeconstruct gtoColumns = case algebraSing @algebra of

223223 @(TTable Expr)

224224 @TColumns

225225 @Id

226− @(Col Expr)

226+ @Expr

227227 @(Eval (rep Expr))

228228 (const fromColumns) .

229229 gtoColumns

@@ -235,7 +235,7 @@ ggdeconstruct gtoColumns = case algebraSing @algebra of

235235 @(TTable Expr)

236236 @TColumns

237237 @Id

238− @(Col Expr)

238+ @Expr

239239 @(Eval (rep Expr))

240240 (const fromColumns)

241241 (\SSpec {nullity} -> case nullity of

@@ -256,7 +256,7 @@ type family GGName algebra rep a where

256256

257257

258258ggname :: forall algebra rep a. GGConstructable algebra rep

259− => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Name) -> a)

259+ => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Name -> a)

260260 -> GGName algebra rep a

261261ggname gfromColumns = case algebraSing @algebra of

262262 SProduct ->

@@ -266,7 +266,7 @@ ggname gfromColumns = case algebraSing @algebra of

266266 @(TTable Name)

267267 @TColumns

268268 @Id

269− @(Col Name)

269+ @Name

270270 @(Eval (rep Name))

271271 (const toColumns)

272272 SSum -> \tag ->

@@ -276,7 +276,7 @@ ggname gfromColumns = case algebraSing @algebra of

276276 @(TTable Name)

277277 @TColumns

278278 @Id

279− @(Col Name)

279+ @Name

280280 @(Eval (rep Name))

281281 (const toColumns)

282282 (\_ _ (N (Name a)) -> N (Name a))

@@ -294,8 +294,8 @@ type family GGAggregate algebra rep r where

294294

295295

296296ggaggregate :: forall algebra rep exprs agg. GGConstructable algebra rep

297− => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Aggregate) -> agg)

298− -> (exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) (Col Expr))

297+ => (Eval (GGColumns algebra TColumns (Eval (rep Expr))) Aggregate -> agg)

298+ -> (exprs -> Eval (GGColumns algebra TColumns (Eval (rep Expr))) Expr)

299299 -> GGAggregate algebra rep agg -> exprs -> agg

300300ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

301301 SProduct -> flip f exprs $

@@ -304,7 +304,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

304304 @(TTable Aggregate)

305305 @TColumns

306306 @Id

307− @(Col Aggregate)

307+ @Aggregate

308308 @(Eval (rep Aggregate))

309309 (const toColumns)

310310 where

@@ -317,7 +317,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

317317 @(TTable Expr)

318318 @TColumns

319319 @Id

320− @(Col Expr)

320+ @Expr

321321 @(Eval (rep Expr))

322322 (const fromColumns) $

323323 gtoColumns es

@@ -327,7 +327,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

327327 @(TTable Aggregate)

328328 @TColumns

329329 @Id

330− @(Col Aggregate)

330+ @Aggregate

331331 @(Eval (rep Aggregate))

332332 (const toColumns)

333333 (\tag' SSpec {nullity} (A (Aggregate a)) ->

@@ -343,7 +343,7 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

343343 @(TTable Expr)

344344 @TColumns

345345 @Id

346− @(Col Expr)

346+ @Expr

347347 @(Eval (rep Expr))

348348 (const fromColumns)

349349 (\SSpec {nullity} -> case nullity of

src/Rel8/Generic/Construction/ADT.hs+7−7

@@ -62,20 +62,20 @@ import Rel8.Type.Tag ( Tag( Tag ) )

6262import Data.Text ( pack )

6363

6464

65−type Null :: K.HContext -> Type

65+type Null :: K.Context -> Type

6666type Null context = forall a. ()

6767 => SSpec ('Spec a)

6868 -> context ('Spec (Nullify a))

6969

7070

71−type Nullifier :: K.HContext -> Type

71+type Nullifier :: K.Context -> Type

7272type Nullifier context = forall a. ()

7373 => SSpec ('Spec a)

7474 -> context ('Spec a)

7575 -> context ('Spec (Nullify a))

7676

7777

78−type Unnullifier :: K.HContext -> Type

78+type Unnullifier :: K.Context -> Type

7979type Unnullifier context = forall a. ()

8080 => SSpec ('Spec a)

8181 -> context ('Spec (Nullify a))

@@ -188,7 +188,7 @@ type GConstructableADT

188188 :: (Type -> Exp Constraint)

189189 -> (Type -> Exp K.HTable)

190190 -> (Type -> Exp Type)

191− -> K.HContext -> (Type -> Type) -> Constraint

191+ -> K.Context -> (Type -> Type) -> Constraint

192192class GConstructableADT _Table _Columns f context rep where

193193 gbuildADT :: ()

194194 => ToColumns _Table _Columns f context

@@ -245,7 +245,7 @@ type GConstructableADT'

245245 :: (Type -> Exp Constraint)

246246 -> (Type -> Exp K.HTable)

247247 -> (Type -> Exp Type)

248− -> K.HContext -> K.HTable -> (Type -> Type) -> Constraint

248+ -> K.Context -> K.HTable -> (Type -> Type) -> Constraint

249249class GConstructableADT' _Table _Columns f context htable rep where

250250 gbuildADT' :: ()

251251 => ToColumns _Table _Columns f context

@@ -383,7 +383,7 @@ type GMakeableADT

383383 :: (Type -> Exp Constraint)

384384 -> (Type -> Exp K.HTable)

385385 -> (Type -> Exp Type)

386− -> K.HContext -> Symbol -> (Type -> Type) -> Constraint

386+ -> K.Context -> Symbol -> (Type -> Type) -> Constraint

387387class GMakeableADT _Table _Columns f context name rep where

388388 gmakeADT :: ()

389389 => ToColumns _Table _Columns f context

@@ -417,7 +417,7 @@ type GMakeableADT'

417417 :: (Type -> Exp Constraint)

418418 -> (Type -> Exp K.HTable)

419419 -> (Type -> Exp Type)

420− -> K.HContext -> K.HTable -> Symbol -> (Type -> Type) -> Type -> Constraint

420+ -> K.Context -> K.HTable -> Symbol -> (Type -> Type) -> Type -> Constraint

421421class GMakeableADT' _Table _Columns f context htable name rep fields where

422422 gmakeADT' :: ()

423423 => ToColumns _Table _Columns f context

src/Rel8/Generic/Construction/Record.hs+3−3

@@ -43,7 +43,7 @@ type FromColumns

4343 :: (Type -> Exp Constraint)

4444 -> (Type -> Exp K.HTable)

4545 -> (Type -> Exp Type)

46− -> K.HContext

46+ -> K.Context

4747 -> Type

4848type FromColumns _Table _Columns f context = forall proxy x.

4949 Eval (_Table x) => proxy x -> Eval (_Columns x) context -> Eval (f x)

@@ -53,7 +53,7 @@ type ToColumns

5353 :: (Type -> Exp Constraint)

5454 -> (Type -> Exp K.HTable)

5555 -> (Type -> Exp Type)

56− -> K.HContext

56+ -> K.Context

5757 -> Type

5858type ToColumns _Table _Columns f context = forall proxy x.

5959 Eval (_Table x) => proxy x -> Eval (f x) -> Eval (_Columns x) context

@@ -117,7 +117,7 @@ type GConstructable

117117 :: (Type -> Exp Constraint)

118118 -> (Type -> Exp K.HTable)

119119 -> (Type -> Exp Type)

120− -> K.HContext -> (Type -> Type) -> Constraint

120+ -> K.Context -> (Type -> Type) -> Constraint

121121class GConstructable _Table _Columns f context rep where

122122 gconstruct :: ()

123123 => ToColumns _Table _Columns f context

src/Rel8/Generic/Rel8able.hs+11−11

@@ -8,6 +8,7 @@

88{-# language StandaloneKindSignatures #-}

99{-# language TypeApplications #-}

1010{-# language TypeFamilies #-}

11+{-# language TypeFamilyDependencies #-}

1112{-# language UndecidableInstances #-}

1213

1314module Rel8.Generic.Rel8able

@@ -32,7 +33,6 @@ import Rel8.Generic.Record ( Record(..) )

3233import Rel8.Generic.Table ( GAlgebra )

3334import qualified Rel8.Generic.Table.Record as G

3435import qualified Rel8.Kind.Algebra as K ( Algebra(..) )

35−import Rel8.Schema.Context ( Col )

3636import Rel8.Schema.Context.Virtual ( Abstract(..) )

3737import Rel8.Schema.HTable ( HTable )

3838import qualified Rel8.Schema.Kind as K

@@ -96,11 +96,11 @@ class HTable (GColumns t) => Rel8able t where

9696 type GColumns t :: K.HTable

9797 type GFromExprs t :: Type

9898

99− gfromColumns :: Abstract context -> GColumns t (Col context) -> t context

100− gtoColumns :: Abstract context -> t context -> GColumns t (Col context)

99+ gfromColumns :: Abstract context -> GColumns t context -> t context

100+ gtoColumns :: Abstract context -> t context -> GColumns t context

101101

102− gfromResult :: GColumns t (Col Result) -> GFromExprs t

103− gtoResult :: GFromExprs t -> GColumns t (Col Result)

102+ gfromResult :: GColumns t Result -> GFromExprs t

103+ gtoResult :: GFromExprs t -> GColumns t Result

104104

105105 type GColumns t = G.GColumns TColumns (GRep t Expr)

106106 type GFromExprs t = t Result

@@ -110,7 +110,7 @@ class HTable (GColumns t) => Rel8able t where

110110 , VRel8able t Expr

111111 , VRel8able t Name

112112 )

113− => Abstract context -> GColumns t (Col context) -> t context

113+ => Abstract context -> GColumns t context -> t context

114114 gfromColumns = \case

115115 VAggregate -> vfromColumns

116116 VExpr -> vfromColumns

@@ -121,7 +121,7 @@ class HTable (GColumns t) => Rel8able t where

121121 , VRel8able t Expr

122122 , VRel8able t Name

123123 )

124− => Abstract context -> t context -> GColumns t (Col context)

124+ => Abstract context -> t context -> GColumns t context

125125 gtoColumns = \case

126126 VAggregate -> vtoColumns

127127 VExpr -> vtoColumns

@@ -134,7 +134,7 @@ class HTable (GColumns t) => Rel8able t where

134134 , Rep (Record (t Result)) ~ GMap TFromExprs (GRep t Expr)

135135 , GFromExprs t ~ t Result

136136 )

137− => GColumns t (Col Result) -> GFromExprs t

137+ => GColumns t Result -> GFromExprs t

138138 gfromResult =

139139 unrecord .

140140 to .

@@ -152,7 +152,7 @@ class HTable (GColumns t) => Rel8able t where

152152 , Rep (Record (t Result)) ~ GMap TFromExprs (GRep t Expr)

153153 , GFromExprs t ~ t Result

154154 )

155− => GFromExprs t -> GColumns t (Col Result)

155+ => GFromExprs t -> GColumns t Result

156156 gtoResult =

157157 G.gtoResult

158158 @(TTable Expr)

@@ -181,7 +181,7 @@ type VRel8able t context =

181181

182182

183183vfromColumns :: forall t context. VRel8able t context

184− => GColumns t (Col context) -> t context

184+ => GColumns t context -> t context

185185vfromColumns =

186186 unrecord .

187187 to .

@@ -189,7 +189,7 @@ vfromColumns =

189189

190190

191191vtoColumns :: forall t context. VRel8able t context

192− => t context -> GColumns t (Col context)

192+ => t context -> GColumns t context

193193vtoColumns =

194194 G.gtoColumns @(TTable context) @TColumns @TFromExprs toColumns .

195195 from .

src/Rel8/Generic/Table.hs+4−5

@@ -34,7 +34,6 @@ import Rel8.Kind.Algebra

3434 , SAlgebra( SProduct, SSum )

3535 , KnownAlgebra, algebraSing

3636 )

37−import Rel8.Schema.Context ( Col )

3837import qualified Rel8.Schema.Kind as K

3938import Rel8.Schema.Result ( Result )

4039

@@ -84,8 +83,8 @@ ggfromResult :: forall algebra _Table _Columns _FromExprs rep x.

8483 , Eval (GGTable algebra _Table _Columns _FromExprs rep)

8584 )

8685 => (forall a proxy. Eval (_Table a)

87− => proxy a -> Eval (_Columns a) (Col Result) -> Eval (_FromExprs a))

88− -> Eval (GGColumns algebra _Columns rep) (Col Result)

86+ => proxy a -> Eval (_Columns a) Result -> Eval (_FromExprs a))

87+ -> Eval (GGColumns algebra _Columns rep) Result

8988 -> GMap _FromExprs rep x

9089ggfromResult f x = case algebraSing @algebra of

9190 SProduct -> gfromResult @_Table @_Columns @_FromExprs @rep f x

@@ -97,9 +96,9 @@ ggtoResult :: forall algebra _Table _Columns _FromExprs rep x.

9796 , Eval (GGTable algebra _Table _Columns _FromExprs rep)

9897 )

9998 => (forall a proxy. Eval (_Table a)

100− => proxy a -> Eval (_FromExprs a) -> Eval (_Columns a) (Col Result))

99+ => proxy a -> Eval (_FromExprs a) -> Eval (_Columns a) Result)

101100 -> GMap _FromExprs rep x

102− -> Eval (GGColumns algebra _Columns rep) (Col Result)

101+ -> Eval (GGColumns algebra _Columns rep) Result

103102ggtoResult f x = case algebraSing @algebra of

104103 SProduct -> gtoResult @_Table @_Columns @_FromExprs @rep f x

105104 SSum -> gtoResultADT @_Table @_Columns @_FromExprs @rep f x

src/Rel8/Generic/Table/ADT.hs+9−11

@@ -39,7 +39,7 @@ import Rel8.Schema.HTable.Nullify ( HNullify, hnulls, hnullify, hunnullify )

3939import Rel8.Schema.HTable.Product ( HProduct( HProduct ) )

4040import qualified Rel8.Schema.Kind as K

4141import Rel8.Schema.Result

42− ( Col( R ), Result

42+ ( Result( R )

4343 , null, nullifier, unnullifier

4444 )

4545import Rel8.Type.Tag ( Tag( Tag ) )

@@ -75,21 +75,19 @@ type GTableADT

7575class GTableADT _Table _Columns _FromExprs rep where

7676 gfromResultADT :: ()

7777 => (forall a proxy. Eval (_Table a)

78− => proxy a -> Eval (_Columns a) (Col Result) -> Eval (_FromExprs a))

79− -> GColumnsADT _Columns rep (Col Result)

78+ => proxy a -> Eval (_Columns a) Result -> Eval (_FromExprs a))

79+ -> GColumnsADT _Columns rep Result

8080 -> GMap _FromExprs rep x

8181

8282 gtoResultADT :: ()

8383 => (forall a proxy. Eval (_Table a)

84− => proxy a -> Eval (_FromExprs a) -> Eval (_Columns a) (Col Result))

84+ => proxy a -> Eval (_FromExprs a) -> Eval (_Columns a) Result)

8585 -> GMap _FromExprs rep x

86− -> GColumnsADT _Columns rep (Col Result)

86+ -> GColumnsADT _Columns rep Result

8787

8888

8989instance

9090 ( htable ~ HLabel "tag" (HType Tag)

91− , Eval (_Table (htable context))

92− , Eval (_Columns (htable context)) ~ htable

9391 , GTableADT' _Table _Columns _FromExprs htable rep

9492 )

9593 => GTableADT _Table _Columns _FromExprs (M1 D meta rep)

@@ -113,17 +111,17 @@ type GTableADT'

113111 -> (Type -> Exp Type)

114112 -> K.HTable -> (Type -> Type) -> Constraint

115113class GTableADT' _Table _Columns _FromExprs htable rep where

116− gfromResultADT' :: context ~ Col Result

114+ gfromResultADT' :: context ~ Result

117115 => (forall a proxy. Eval (_Table a)

118116 => proxy a -> Eval (_Columns a) context -> Eval (_FromExprs a))

119− -> (htable (Col Result) -> Tag)

117+ -> (htable Result -> Tag)

120118 -> GColumnsADT' _Columns htable rep context

121119 -> Maybe (GMap _FromExprs rep x)

122120

123− gtoResultADT' :: context ~ Col Result

121+ gtoResultADT' :: context ~ Result

124122 => (forall a proxy. Eval (_Table a)

125123 => proxy a -> Eval (_FromExprs a) -> Eval (_Columns a) context)

126− -> (Tag -> htable (Col Result))

124+ -> (Tag -> htable Result)

127125 -> Maybe (GMap _FromExprs rep x)

128126 -> GColumnsADT' _Columns htable rep context

129127

src/Rel8/Query/Each.hs+3−3

@@ -17,7 +17,7 @@ import Rel8.Query ( Query )

1717import Rel8.Query.Opaleye ( fromOpaleye )

1818import Rel8.Schema.Name ( Selects )

1919import Rel8.Schema.Table ( TableSchema )

20−import Rel8.Table ( fromColumns, toColumns )

20+import Rel8.Table.Cols ( fromCols, toCols )

2121import Rel8.Table.Opaleye ( table, unpackspec )

2222

2323

@@ -25,8 +25,8 @@ import Rel8.Table.Opaleye ( table, unpackspec )

2525-- table@.

2626each :: Selects names exprs => TableSchema names -> Query exprs

2727each =

28− fmap fromColumns .

28+ fmap fromCols .

2929 fromOpaleye .

3030 Opaleye.selectTableExplicit unpackspec .

3131 table .

32− fmap toColumns

32+ fmap toCols

src/Rel8/Query/List.hs+5−4

@@ -19,7 +19,7 @@ import Prelude

1919import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

2020

2121-- rel8

22−import Rel8.Expr ( Col( E, unE ), Expr )

22+import Rel8.Expr ( Expr( E, unE ) )

2323import Rel8.Expr.Aggregate ( listAggExpr, nonEmptyAggExpr )

2424import Rel8.Expr.Opaleye ( mapPrimExpr )

2525import Rel8.Query ( Query )

@@ -29,7 +29,8 @@ import Rel8.Query.Maybe ( optional )

2929import Rel8.Schema.HTable.Vectorize ( hunvectorize )

3030import Rel8.Schema.Null ( Sql, Unnullify )

3131import Rel8.Schema.Spec ( SSpec( SSpec, info ) )

32−import Rel8.Table ( Table, fromColumns, toColumns )

32+import Rel8.Table ( Table, fromColumns )

33+import Rel8.Table.Cols ( toCols )

3334import Rel8.Table.Aggregate ( listAgg, nonEmptyAgg )

3435import Rel8.Table.List ( ListTable( ListTable ) )

3536import Rel8.Table.Maybe ( maybeTable )

@@ -51,7 +52,7 @@ many =

5152 fmap (maybeTable mempty (\(ListTable a) -> ListTable a)) .

5253 optional .

5354 aggregate .

54− fmap (listAgg . toColumns)

55+ fmap (listAgg . toCols)

5556

5657

5758-- | Aggregate a 'Query' into a 'NonEmptyTable'. If the supplied query returns

@@ -66,7 +67,7 @@ some :: Table Expr a => Query a -> Query (NonEmptyTable Expr a)

6667some =

6768 fmap (\(NonEmptyTable a) -> NonEmptyTable a) .

6869 aggregate .

69− fmap (nonEmptyAgg . toColumns)

70+ fmap (nonEmptyAgg . toCols)

7071

7172

7273-- | A version of 'many' specialised to single expressions.

src/Rel8/Query/Maybe.hs+7−5

@@ -1,4 +1,5 @@

11{-# language GADTs #-}

2+{-# language LambdaCase #-}

23{-# language NamedFieldPuns #-}

45module Rel8.Query.Maybe

@@ -18,7 +19,7 @@ import Control.Comonad ( extract )

1819import qualified Opaleye.Internal.MaybeFields as Opaleye

1920

2021-- rel8

21−import Rel8.Expr ( Col( E ), Expr )

22+import Rel8.Expr ( Expr( E ) )

2223import Rel8.Expr.Eq ( (==.) )

2324import Rel8.Expr.Opaleye ( fromColumn, fromPrimExpr )

2425import Rel8.Query ( Query )

@@ -54,13 +55,14 @@ catMaybeTable ma@(MaybeTable _ a) = do

5455-- to step through multiple @LEFT JOINs@.

5556--

5657-- Note that @traverseMaybeTable@ takes a @a -> Query b@ function, which means

57−-- you also have the ability to "expand" one row into multiple rows. If the

58+-- you also have the ability to "expand" one row into multiple rows. If the

5859-- @a -> Query b@ function returns no rows, then the resulting query will also

5960-- have no rows. However, regardless of the given @a -> Query b@ function, if

6061-- the input is @nothingTable@, you will always get exactly one @nothingTable@

6162-- back.

6263traverseMaybeTable :: (a -> Query b) -> MaybeTable Expr a -> Query (MaybeTable Expr b)

6364traverseMaybeTable query ma@(MaybeTable (E input) _) = do

64− MaybeTable (E output) b <- optional (query =<< catMaybeTable ma)

65− where_ $ output ==. input

66− pure $ MaybeTable (E input) b

65+ optional (query =<< catMaybeTable ma) >>= \case

66+ MaybeTable (E output) b -> do

67+ where_ $ output ==. input

68+ pure $ MaybeTable (E input) b

src/Rel8/Query/SQL.hs+4−3

@@ -23,13 +23,14 @@ import qualified Opaleye.Internal.QueryArr as Opaleye hiding ( Select )

2323import qualified Opaleye.Internal.Sql as Opaleye

2424

2525-- rel8

26−import Rel8.Expr ( Expr, Col( E ) )

26+import Rel8.Expr ( Expr( E ) )

2727import Rel8.Expr.Opaleye ( toPrimExpr )

2828import Rel8.Query ( Query )

2929import Rel8.Query.Opaleye ( toOpaleye )

30−import Rel8.Schema.Name ( Name( Name ), Selects, Col( N ) )

30+import Rel8.Schema.Name ( Name( N, Name ), Selects )

3131import Rel8.Schema.HTable ( htabulateA, hfield )

3232import Rel8.Table ( Table, toColumns )

33+import Rel8.Table.Cols ( toCols )

3334import Rel8.Table.Name ( namesFromLabels )

3435import Rel8.Table.Opaleye ( castTable )

3536

@@ -42,7 +43,7 @@ showQuery = fold . sqlForQuery

4243

4344sqlForQuery :: Table Expr a

4445 => Query a -> Maybe String

45−sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toColumns

46+sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toCols

4647

4748

4849sqlForQueryWithNames :: Selects names exprs

src/Rel8/Query/These.hs+1−1

@@ -25,7 +25,7 @@ import qualified Opaleye.Internal.QueryArr as Opaleye

2525import qualified Opaleye.Internal.Tag as Opaleye

2626

2727-- rel8

28−import Rel8.Expr ( Col( E ), Expr )

28+import Rel8.Expr ( Expr( E ) )

2929import Rel8.Expr.Bool ( boolExpr, not_ )

3030import Rel8.Expr.Eq ( (==.) )

3131import Rel8.Expr.Opaleye ( toPrimExpr, traversePrimExpr )

src/Rel8/Schema/Context.hsdeleted−26

@@ -1,26 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language StandaloneKindSignatures #-}

3−{-# language TypeFamilies #-}

4−

5−module Rel8.Schema.Context

6− ( Interpretation( Col )

7− , UnCol

8− )

9−where

10−

11−-- base

12−import Data.Kind ( Constraint )

13−import Prelude ()

14−

15−-- rel8

16−import Rel8.Schema.Kind ( Context, HContext )

17−

18−

19−type Interpretation :: Context -> Constraint

20−class Interpretation context where

21− data Col context :: HContext

22−

23−

24−type UnCol :: HContext -> Context

25−type family UnCol context where

26− UnCol (Col context) = context

src/Rel8/Schema/Context/Nullify.hs+11−11

@@ -25,18 +25,18 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

2525

2626-- rel8

2727import Rel8.Aggregate

28− ( Col( A ), Aggregate( Aggregate )

28+ ( Aggregate( A, Aggregate )

2929 , foldInputs, mapInputs

3030 )

31−import Rel8.Expr ( Col( E ), Expr )

31+import Rel8.Expr ( Expr( E ) )

3232import Rel8.Expr.Bool ( boolExpr )

3333import Rel8.Expr.Null ( nullify, unsafeUnnullify )

3434import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr )

3535import Rel8.Kind.Context ( SContext(..) )

3636import qualified Rel8.Schema.Kind as K

37−import Rel8.Schema.Name ( Col( N ), Name( Name ) )

37+import Rel8.Schema.Name ( Name( N, Name ) )

3838import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )

39−import Rel8.Schema.Result ( Col( R ), Result )

39+import Rel8.Schema.Result ( Result( R ) )

4040import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

4141

4242

@@ -88,11 +88,11 @@ absurd = \case

8888

8989guarder :: ()

9090 => SContext context

91− -> Col context ('Spec tag)

91+ -> context ('Spec tag)

9292 -> (tag -> Bool)

9393 -> (Expr tag -> Expr Bool)

94− -> Col context ('Spec (Maybe a))

95− -> Col context ('Spec (Maybe a))

94+ -> context ('Spec (Maybe a))

95+ -> context ('Spec (Maybe a))

9696guarder SAggregate (A tag) _ isNonNull (A (Aggregate a)) =

9797 A $

9898 mapInputs (toPrimExpr . run . fromPrimExpr) $

@@ -113,8 +113,8 @@ guarder SResult (R tag) isNonNull _ (R a) = R (bool Nothing a condition)

113113nullifier :: ()

114114 => Nullifiability context

115115 -> SSpec ('Spec a)

116− -> Col context ('Spec a)

117− -> Col context ('Spec (Nullify a))

116+ -> context ('Spec a)

117+ -> context ('Spec (Nullify a))

118118nullifier NAggregate SSpec {nullity} (A (Aggregate a)) =

119119 A $ Aggregate $ snullify nullity <$> a

120120nullifier NExpr SSpec {nullity} (E a) = E $ snullify nullity a

@@ -124,8 +124,8 @@ nullifier NName _ (N (Name a)) = N $ Name a

124124unnullifier :: ()

125125 => Nullifiability context

126126 -> SSpec ('Spec a)

127− -> Col context ('Spec (Nullify a))

128− -> Col context ('Spec a)

127+ -> context ('Spec (Nullify a))

128+ -> context ('Spec a)

129129unnullifier NAggregate SSpec {nullity} (A (Aggregate a)) =

130130 A $ Aggregate $ sunnullify nullity <$> a

131131unnullifier NExpr SSpec {nullity} (E a) = E $ sunnullify nullity a

src/Rel8/Schema/HTable.hs+1−1

@@ -129,7 +129,7 @@ type GHField :: K.HTable -> Spec -> Type

129129newtype GHField t spec = GHField (HField (GHColumns (Rep (t Proxy))) spec)

130130

131131

132−type GHTable :: K.HContext -> (Type -> Type) -> Constraint

132+type GHTable :: K.Context -> (Type -> Type) -> Constraint

133133class HTable (GHColumns rep) => GHTable context rep | rep -> context where

134134 type GHColumns rep :: K.HTable

135135 toGHColumns :: rep x -> GHColumns rep context

src/Rel8/Schema/Kind.hs+4−15

@@ -1,10 +1,6 @@

11{-# language StandaloneKindSignatures #-}

3−module Rel8.Schema.Kind

4− ( Context, Rel8able

5− , HContext, HTable

6− )

7−where

3+module Rel8.Schema.Kind ( Rel8able, Context, HTable ) where

95-- base

106import Data.Kind ( Type )

@@ -14,19 +10,12 @@ import Prelude ()

1410import Rel8.Schema.Spec ( Spec )

1511

1612

17−type HContext :: Type

18−type HContext = Spec -> Type

13+type Context :: Type

14+type Context = Spec -> Type

1915

2016

2117type HTable :: Type

22−type HTable = HContext -> Type

23−

24−

25−data X

26−

27−

28−type Context :: Type

29−type Context = X -> Type

18+type HTable = Context -> Type

3019

3120

3221type Rel8able :: Type

src/Rel8/Schema/Name.hs+3−9

@@ -14,7 +14,6 @@

1414

1515module Rel8.Schema.Name

1616 ( Name(..)

17− , Col( N, unN )

1817 , Selects

1918 )

2019where

@@ -26,10 +25,9 @@ import Prelude

2625

2726-- rel8

2827import Rel8.Expr ( Expr )

29−import Rel8.Schema.Context ( Interpretation, Col )

3028import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )

3129import Rel8.Schema.Null ( Sql )

32−import Rel8.Schema.Result ( Col( R ) )

30+import Rel8.Schema.Result ( Result( R ) )

3331import Rel8.Schema.Spec ( Spec( Spec ) )

3432import Rel8.Table

3533 ( Table, Columns, Context, fromColumns, toColumns

@@ -45,7 +43,8 @@ import Rel8.Type ( DBType )

4543-- a 'TableSchema' value.

4644type Name :: k -> Type

4745data Name a where

48− Name :: k ~ Type => !String -> Name (a :: k)

46+ Name :: forall (a :: Type). !String -> Name a

47+ N :: { unN :: !(Name a) } -> Name ('Spec a)

4948

5049

5150deriving stock instance Show (Name a)

@@ -75,11 +74,6 @@ instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)

7574instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)

7675

7776

78−instance Interpretation Name where

79− data Col Name _spec where

80− N :: {unN :: !(Name a)} -> Col Name ('Spec a)

81−

82−

8377-- | @Selects a b@ means that @a@ is a schema (i.e., a 'Table' of 'Name's) for

8478-- the 'Expr' columns in @b@.

8579type Selects :: Type -> Type -> Constraint

src/Rel8/Schema/Result.hs+31−16

@@ -1,21 +1,25 @@

11{-# language DataKinds #-}

2+{-# language EmptyCase #-}

23{-# language GADTs #-}

4+{-# language LambdaCase #-}

35{-# language NamedFieldPuns #-}

6+{-# language PolyKinds #-}

47{-# language StandaloneKindSignatures #-}

58{-# language TypeFamilies #-}

710module Rel8.Schema.Result

8− ( Col( R, unR ), Result

11+ ( Result( R, unR )

12+ , NotResult( NotResult ), absurd

913 , null, nullifier, unnullifier

1014 , vectorizer, unvectorizer

1115 )

1216where

1317

1418-- base

19+import Data.Kind ( Type )

1520import Prelude hiding ( null )

1621

1722-- rel8

18−import Rel8.Schema.Context ( Interpretation( Col ) )

1923import Rel8.Schema.Kind ( Context )

2024import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ) )

2125import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

@@ -25,23 +29,34 @@ import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

2529--

2630-- When a query is executed against a PostgreSQL database, Rel8 parses the

2731-- returned rows, decoding each row into the @Result@ context.

28−type Result :: Context

29−data Result a

32+type Result :: k -> Type

33+data Result a where

34+ R :: { unR :: !a } -> Result ('Spec a)

3035

3136

32−instance Interpretation Result where

33− data Col Result _spec where

34− R :: {unR :: !a} -> Col Result ('Spec a)

37+type IsResult :: Context -> Bool

38+type family IsResult context where

39+ IsResult Result = 'True

40+ IsResult _ = 'False

3541

3642

37−null :: Col Result ('Spec (Maybe a))

43+type NotResult :: Context -> Type

44+data NotResult context where

45+ NotResult :: IsResult context ~ 'False => NotResult context

46+

47+

48+absurd :: NotResult Result -> a

49+absurd = \case

50+

51+

52+null :: Result ('Spec (Maybe a))

3853null = R Nothing

3954

4055

4156nullifier :: ()

4257 => SSpec ('Spec a)

43− -> Col Result ('Spec a)

44− -> Col Result ('Spec (Nullify a))

58+ -> Result ('Spec a)

59+ -> Result ('Spec (Nullify a))

4560nullifier SSpec {nullity} (R a) = R $ case nullity of

4661 Null -> a

4762 NotNull -> Just a

@@ -49,8 +64,8 @@ nullifier SSpec {nullity} (R a) = R $ case nullity of

4964

5065unnullifier :: ()

5166 => SSpec ('Spec a)

52− -> Col Result ('Spec (Nullify a))

53− -> Maybe (Col Result ('Spec a))

67+ -> Result ('Spec (Nullify a))

68+ -> Maybe (Result ('Spec a))

5469unnullifier SSpec {nullity} (R a) =

5570 case nullity of

5671 Null -> pure $ R a

@@ -59,13 +74,13 @@ unnullifier SSpec {nullity} (R a) =

5974

6075vectorizer :: Functor f

6176 => SSpec ('Spec a)

62− -> f (Col Result ('Spec a))

63− -> Col Result ('Spec (f a))

77+ -> f (Result ('Spec a))

78+ -> Result ('Spec (f a))

6479vectorizer _ = R . fmap unR

6580

6681

6782unvectorizer :: Functor f

6883 => SSpec ('Spec a)

69− -> Col Result ('Spec (f a))

70− -> f (Col Result ('Spec a))

84+ -> Result ('Spec (f a))

85+ -> f (Result ('Spec a))

7186unvectorizer _ (R results) = R <$> results

src/Rel8/Statement/Delete.hs+6−6

@@ -32,7 +32,7 @@ import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )

3232import Rel8.Schema.Name ( Selects )

3333import Rel8.Schema.Table ( TableSchema )

3434import Rel8.Statement.Returning ( Returning( NumberOfRowsAffected, Projection ) )

35−import Rel8.Table ( fromColumns, toColumns )

35+import Rel8.Table.Cols ( fromCols, toCols )

3636import Rel8.Table.Opaleye ( castTable, table, unpackspec )

3737import Rel8.Table.Serialize ( Serializable, parse )

3838

@@ -69,8 +69,8 @@ delete c Delete {from, deleteWhere, returning} =

6969 prepare = False

7070 sql = Opaleye.arrangeDeleteSql from' where'

7171 where

72− from' = table $ toColumns <$> from

73− where' = toColumn . toPrimExpr . deleteWhere . fromColumns

72+ from' = table $ toCols <$> from

73+ where' = toColumn . toPrimExpr . deleteWhere . fromCols

7474

7575 Projection project -> Hasql.run session c >>= either throwIO pure

7676 where

@@ -83,9 +83,9 @@ delete c Delete {from, deleteWhere, returning} =

8383 sql =

8484 Opaleye.arrangeDeleteReturningSql unpackspec from' where' project'

8585 where

86− from' = table $ toColumns <$> from

87− where' = toColumn . toPrimExpr . deleteWhere . fromColumns

88− project' = castTable . toColumns . project . fromColumns

86+ from' = table $ toCols <$> from

87+ where' = toColumn . toPrimExpr . deleteWhere . fromCols

88+ project' = castTable . toCols . project . fromCols

8989 where

9090 decoder :: forall exprs projection a. Serializable projection a

9191 => (exprs -> projection) -> Hasql.Result [a]

src/Rel8/Statement/Insert.hs+6−6

@@ -33,7 +33,7 @@ import qualified Opaleye.Manipulation as Opaleye

3333import Rel8.Schema.Name ( Selects )

3434import Rel8.Schema.Table ( TableSchema )

3535import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )

36−import Rel8.Table ( fromColumns, toColumns )

36+import Rel8.Table.Cols ( fromCols, toCols )

3737import Rel8.Table.Opaleye ( castTable, table, unpackspec )

3838import Rel8.Table.Serialize ( Serializable, parse )

3939

@@ -84,8 +84,8 @@ insert c Insert {into, rows, onConflict, returning} =

8484 prepare = False

8585 sql = Opaleye.arrangeInsertManySql into' rows' onConflict'

8686 where

87− into' = table $ toColumns <$> into

88− rows' = toColumns <$> x :| xs

87+ into' = table $ toCols <$> into

88+ rows' = toCols <$> x :| xs

8989

9090 (x:xs, Projection project) -> Hasql.run session c >>= either throwIO pure

9191 where

@@ -103,9 +103,9 @@ insert c Insert {into, rows, onConflict, returning} =

103103 project'

104104 onConflict'

105105 where

106− into' = table $ toColumns <$> into

107− rows' = toColumns <$> x :| xs

108− project' = castTable . toColumns . project . fromColumns

106+ into' = table $ toCols <$> into

107+ rows' = toCols <$> x :| xs

108+ project' = castTable . toCols . project . fromCols

109109

110110 where

111111 onConflict' =

src/Rel8/Statement/Update.hs+8−8

@@ -31,7 +31,7 @@ import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )

3131import Rel8.Schema.Name ( Selects )

3232import Rel8.Schema.Table ( TableSchema )

3333import Rel8.Statement.Returning ( Returning( Projection, NumberOfRowsAffected ) )

34−import Rel8.Table ( fromColumns, toColumns )

34+import Rel8.Table.Cols ( fromCols, toCols )

3535import Rel8.Table.Opaleye ( castTable, table, unpackspec )

3636import Rel8.Table.Serialize ( Serializable, parse )

3737

@@ -70,9 +70,9 @@ update c Update {target, set, updateWhere, returning} =

7070 prepare = False

7171 sql = Opaleye.arrangeUpdateSql target' set' where'

7272 where

73− target' = table $ toColumns <$> target

74− set' = toColumns . set . fromColumns

75− where' = toColumn . toPrimExpr . updateWhere . fromColumns

73+ target' = table $ toCols <$> target

74+ set' = toCols . set . fromCols

75+ where' = toColumn . toPrimExpr . updateWhere . fromCols

7676

7777 Projection project -> Hasql.run session c >>= either throwIO pure

7878 where

@@ -90,10 +90,10 @@ update c Update {target, set, updateWhere, returning} =

9090 where'

9191 project'

9292 where

93− target' = table $ toColumns <$> target

94− set' = toColumns . set . fromColumns

95− where' = toColumn . toPrimExpr . updateWhere . fromColumns

96− project' = castTable . toColumns . project . fromColumns

93+ target' = table $ toCols <$> target

94+ set' = toCols . set . fromCols

95+ where' = toColumn . toPrimExpr . updateWhere . fromCols

96+ project' = castTable . toCols . project . fromCols

9797

9898 where

9999 decoder :: forall exprs projection a. Serializable projection a

src/Rel8/Table.hs+12−27

@@ -33,7 +33,6 @@ import Rel8.Generic.Table.Record

3333 , gfromColumns, gtoColumns, gfromResult, gtoResult

3434 )

3535import Rel8.Generic.Record ( Record(..) )

36−import Rel8.Schema.Context ( Col, UnCol )

3736import Rel8.Schema.HTable ( HTable )

3837import Rel8.Schema.HTable.Identity ( HIdentity(..) )

3938import qualified Rel8.Schema.Kind as K

@@ -64,11 +63,11 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

6463 -- corresponding Haskell type.

6564 type FromExprs a :: Type

6665

67− toColumns :: a -> Columns a (Col context)

68− fromColumns :: Columns a (Col context) -> a

66+ toColumns :: a -> Columns a context

67+ fromColumns :: Columns a context -> a

6968

70− fromResult :: Columns a (Col Result) -> FromExprs a

71− toResult :: FromExprs a -> Columns a (Col Result)

69+ fromResult :: Columns a Result -> FromExprs a

70+ toResult :: FromExprs a -> Columns a Result

7271

7372 type Columns a = GColumns TColumns (Rep (Record a))

7473 type Context a = GContext TContext (Rep (Record a))

@@ -79,7 +78,7 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

7978 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))

8079 , Columns a ~ GColumns TColumns (Rep (Record a))

8180 )

82− => a -> Columns a (Col context)

81+ => a -> Columns a context

8382 toColumns =

8483 gtoColumns

8584 @(TTable context)

@@ -94,7 +93,7 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

9493 , GTable (TTable context) TColumns TFromExprs (Rep (Record a))

9594 , Columns a ~ GColumns TColumns (Rep (Record a))

9695 )

97− => Columns a (Col context) -> a

96+ => Columns a context -> a

9897 fromColumns =

9998 unrecord .

10099 to .

@@ -110,7 +109,7 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

110109 , Columns a ~ GColumns TColumns (Rep (Record a))

111110 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))

112111 )

113− => FromExprs a -> Columns a (Col Result)

112+ => FromExprs a -> Columns a Result

114113 toResult =

115114 gtoResult

116115 @(TTable context)

@@ -127,7 +126,7 @@ class (HTable (Columns a), context ~ Context a) => Table context a | a -> contex

127126 , Columns a ~ GColumns TColumns (Rep (Record a))

128127 , Rep (Record (FromExprs a)) ~ GMap TFromExprs (Rep (Record a))

129128 )

130− => Columns a (Col Result) -> FromExprs a

129+ => Columns a Result -> FromExprs a

131130 fromResult =

132131 unrecord .

133132 to .

@@ -172,25 +171,11 @@ data TFromExprs :: Type -> Exp Type

172171type instance Eval (TFromExprs a) = FromExprs a

173172

174173

175−-- | Any 'HTable' is also a 'Table'.

176−instance (context ~ UnCol hcontext, hcontext ~ Col context, HTable t) =>

177− Table context (t hcontext)

178− where

179− type Columns (t hcontext) = t

180− type Context (t hcontext) = UnCol hcontext

181− type FromExprs (t hcontext) = t (Col Result)

182−

183− toColumns = id

184− fromColumns = id

185− toResult = id

186− fromResult = id

187−

188−

189174-- | Any context is trivially a table.

190−instance KnownSpec spec => Table context (Col context spec) where

191− type Columns (Col context spec) = HIdentity spec

192− type Context (Col context spec) = context

193− type FromExprs (Col context spec) = Col Result spec

175+instance KnownSpec spec => Table context (context spec) where

176+ type Columns (context spec) = HIdentity spec

177+ type Context (context spec) = context

178+ type FromExprs (context spec) = Result spec

194179

195180 toColumns = HIdentity

196181 fromColumns = unHIdentity

src/Rel8/Table/ADT.hs+10−4

@@ -8,6 +8,7 @@

88{-# language StandaloneKindSignatures #-}

99{-# language TypeApplications #-}

1010{-# language TypeFamilies #-}

11+{-# language TypeFamilyDependencies #-}

1112{-# language UndecidableInstances #-}

1213{-# language UndecidableSuperClasses #-}

1314

@@ -53,7 +54,7 @@ import Rel8.Generic.Rel8able

5354 )

5455import qualified Rel8.Generic.Table.ADT as G

5556import qualified Rel8.Kind.Algebra as K

56−import Rel8.Schema.Context ( Col )

57+import Rel8.Schema.Context.Virtual

5758import Rel8.Schema.HTable ( HTable )

5859import qualified Rel8.Schema.Kind as K

5960import Rel8.Schema.Name ( Name )

@@ -65,15 +66,20 @@ import Rel8.Table

6566

6667

6768type ADT :: K.Rel8able -> K.Rel8able

68−newtype ADT t context = ADT (GColumnsADT t (Col context))

69+newtype ADT t context = ADT (GColumnsADT t context)

6970

7071

7172instance ADTable t => Rel8able (ADT t) where

7273 type GColumns (ADT t) = GColumnsADT t

7374 type GFromExprs (ADT t) = t Result

7475

75− gfromColumns _ = ADT

76− gtoColumns _ (ADT a) = a

76+ gfromColumns VAggregate = ADT

77+ gfromColumns VExpr = ADT

78+ gfromColumns VName = ADT

79+

80+ gtoColumns VAggregate (ADT a) = a

81+ gtoColumns VExpr (ADT a) = a

82+ gtoColumns VName (ADT a) = a

7783

7884 gfromResult =

7985 unrecord .

src/Rel8/Table/Aggregate.hs+4−4

@@ -16,8 +16,8 @@ import Data.Functor.Identity ( Identity( Identity ) )

1616import Prelude

1717

1818-- rel8

19−import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )

20−import Rel8.Expr ( Expr, Col( E ) )

19+import Rel8.Aggregate ( Aggregate( A ), Aggregates )

20+import Rel8.Expr ( Expr( E ) )

2121import Rel8.Expr.Aggregate

2222 ( groupByExpr

2323 , slistAggExpr

@@ -44,8 +44,8 @@ groupBy = fromColumns . hgroupBy (eqTable @exprs) . toColumns

4444

4545

4646hgroupBy :: HTable t

47− => t (Dict (ConstrainSpec (Sql DBEq))) -> t (Col Expr) -> t (Col Aggregate)

48−hgroupBy eqs exprs = fromColumns $ htabulate $ \field ->

47+ => t (Dict (ConstrainSpec (Sql DBEq))) -> t Expr -> t Aggregate

48+hgroupBy eqs exprs = htabulate $ \field ->

4949 case hfield eqs field of

5050 Dict -> case hfield exprs field of

5151 E expr -> A $ groupByExpr expr

src/Rel8/Table/Bool.hs+1−1

@@ -13,7 +13,7 @@ where

1313import Prelude

1414

1515-- rel8

16−import Rel8.Expr ( Expr, Col( E, unE ) )

16+import Rel8.Expr ( Expr( E, unE ) )

1717import Rel8.Expr.Bool ( boolExpr, caseExpr )

1818import Rel8.Expr.Null ( isNull, unsafeUnnullify )

1919import Rel8.Schema.HTable ( htabulate, hfield )

src/Rel8/Table/Cols.hsnew file+53

@@ -0,0 +1,53 @@

1+{-# language DataKinds #-}

2+{-# language FlexibleInstances #-}

3+{-# language MultiParamTypeClasses #-}

4+{-# language StandaloneKindSignatures #-}

5+{-# language TypeFamilies #-}

6+{-# language UndecidableInstances #-}

8+module Rel8.Table.Cols

9+ ( Cols( Cols )

10+ , fromCols

11+ , toCols

12+ )

13+where

14+

15+-- base

16+import Data.Kind ( Type )

17+import Prelude

18+

19+-- rel8

20+import qualified Rel8.Schema.Kind as K

21+import Rel8.Schema.HTable ( HTable )

22+import Rel8.Schema.Result ( Result )

23+import Rel8.Table ( Table(..) )

24+import Rel8.Table.Recontextualize ( Recontextualize )

25+

26+

27+type Cols :: K.Context -> K.HTable -> Type

28+newtype Cols context columns = Cols (columns context)

29+

30+

31+instance (HTable columns, context ~ context') =>

32+ Table context' (Cols context columns)

33+ where

34+ type Columns (Cols context columns) = columns

35+ type Context (Cols context columns) = context

36+ type FromExprs (Cols context columns) = Cols Result columns

37+

38+ toColumns (Cols a) = a

39+ fromColumns = Cols

40+

41+ toResult (Cols a) = a

42+ fromResult = Cols

43+

44+

45+instance HTable t => Recontextualize from to (Cols from t) (Cols to t)

46+

47+

48+fromCols :: Table context a => Cols context (Columns a) -> a

49+fromCols (Cols a) = fromColumns a

50+

51+

52+toCols :: Table context a => a -> Cols context (Columns a)

53+toCols = Cols . toColumns

src/Rel8/Table/Either.hs+5−5

@@ -32,8 +32,8 @@ import Prelude hiding ( undefined )

3232import Control.Comonad ( extract )

3333

3434-- rel8

35−import Rel8.Aggregate ( Col( A ), Aggregate )

36−import Rel8.Expr ( Col( E ), Expr )

35+import Rel8.Aggregate ( Aggregate( A ) )

36+import Rel8.Expr ( Expr( E ) )

3737import Rel8.Expr.Aggregate ( groupByExpr )

3838import Rel8.Expr.Serialize ( litExpr )

3939import Rel8.Kind.Context ( Reifiable )

@@ -43,8 +43,8 @@ import Rel8.Schema.HTable.Either ( HEitherTable(..) )

4343import Rel8.Schema.HTable.Identity ( HIdentity(..) )

4444import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

4545import qualified Rel8.Schema.Kind as K

46−import Rel8.Schema.Name ( Col( N ), Name )

47−import Rel8.Schema.Result ( Col( R ) )

46+import Rel8.Schema.Name ( Name( N ) )

47+import Rel8.Schema.Result ( Result( R ) )

4848import Rel8.Schema.Spec ( Spec( Spec ) )

4949import Rel8.Table

5050 ( Table, Columns, Context, fromColumns, toColumns

@@ -72,7 +72,7 @@ import Data.Functor.Bind ( Bind, (>>-) )

7272-- adapted to work with Rel8.

7373type EitherTable :: K.Context -> Type -> Type -> Type

7474data EitherTable context a b = EitherTable

75− { tag :: Col context ('Spec EitherTag)

75+ { tag :: context ('Spec EitherTag)

7676 , left :: Nullify context a

7777 , right :: Nullify context b

7878 }

src/Rel8/Table/Eq.hs+2−15

@@ -28,17 +28,14 @@ import GHC.Generics ( Rep )

2828import Prelude

2929

3030-- rel8

31−import Rel8.Expr ( Expr, Col( E ) )

31+import Rel8.Expr ( Expr( E ) )

3232import Rel8.Expr.Bool ( (||.), (&&.) )

3333import Rel8.Expr.Eq ( (==.), (/=.) )

3434import Rel8.FCF ( Eval, Exp )

3535import Rel8.Generic.Record ( Record )

3636import Rel8.Generic.Table.Record ( GTable, GColumns, gtable )

3737import Rel8.Schema.Dict ( Dict( Dict ) )

38−import Rel8.Schema.HTable

39− ( HTable, HConstrainTable

40− , htabulateA, hfield, hdicts

41− )

38+import Rel8.Schema.HTable ( htabulateA, hfield )

4239import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )

4340import Rel8.Schema.Null ( Sql )

4441import Rel8.Schema.Spec.Constrain ( ConstrainSpec )

@@ -73,16 +70,6 @@ data TEqTable :: Type -> Exp Constraint

7370type instance Eval (TEqTable a) = EqTable a

7471

7572

76−instance

77− ( HTable t

78− , f ~ Col Expr

79− , HConstrainTable t (ConstrainSpec (Sql DBEq))

80− )

81− => EqTable (t f)

82− where

83− eqTable = hdicts @(Columns (t f)) @(ConstrainSpec (Sql DBEq))

84−

85−

8673instance Sql DBEq a => EqTable (Expr a) where

8774 eqTable = HType Dict

8875

src/Rel8/Table/HKD.hs+1−2

@@ -61,7 +61,6 @@ import Rel8.Generic.Table

6161 )

6262import Rel8.Generic.Table.Record ( GTable, GContext )

6363import qualified Rel8.Generic.Table.Record as G

64−import Rel8.Schema.Context ( Col )

6564import qualified Rel8.Schema.Kind as K

6665import Rel8.Schema.HTable ( HTable )

6766import Rel8.Schema.Name ( Name )

@@ -77,7 +76,7 @@ type GColumnsHKD a =

7776

7877

7978type HKD :: Type -> K.Rel8able

80−newtype HKD a f = HKD (GColumnsHKD a (Col f))

79+newtype HKD a f = HKD (GColumnsHKD a f)

8180

8281

8382instance HKDable a => Rel8able (HKD a) where

src/Rel8/Table/List.hs+3−3

@@ -21,13 +21,13 @@ import Data.Kind ( Type )

2121import Prelude

2222

2323-- rel8

24−import Rel8.Expr ( Expr, Col( E, unE ) )

24+import Rel8.Expr ( Expr( E, unE ) )

2525import Rel8.Expr.Array ( sappend, sempty, slistOf )

2626import Rel8.Schema.Dict ( Dict( Dict ) )

2727import Rel8.Schema.HTable.List ( HListTable )

2828import Rel8.Schema.HTable.Vectorize ( happend, hempty, hvectorize, hunvectorize )

2929import qualified Rel8.Schema.Kind as K

30−import Rel8.Schema.Name ( Col( N ), Name( Name ) )

30+import Rel8.Schema.Name ( Name( N, Name ) )

3131import Rel8.Schema.Null ( Nullity( Null, NotNull ) )

3232import Rel8.Schema.Result ( vectorizer, unvectorizer )

3333import Rel8.Schema.Spec ( SSpec(..) )

@@ -49,7 +49,7 @@ import Rel8.Table.Serialize ( ToExprs )

4949-- @ListTable@s with 'Rel8.many' or 'Rel8.listAgg'.

5050type ListTable :: K.Context -> Type -> Type

5151newtype ListTable context a =

52− ListTable (HListTable (Columns a) (Col (Context a)))

52+ ListTable (HListTable (Columns a) (Context a))

5353

5454

5555instance (Table context a, context ~ context') =>

src/Rel8/Table/Maybe.hs+5−5

@@ -31,8 +31,8 @@ import Prelude hiding ( null, undefined )

3131import Control.Comonad ( extract )

3232

3333-- rel8

34−import Rel8.Aggregate ( Col( A ), Aggregate )

35−import Rel8.Expr ( Col( E ), Expr )

34+import Rel8.Aggregate ( Aggregate( A ) )

35+import Rel8.Expr ( Expr(E ) )

3636import Rel8.Expr.Aggregate ( groupByExpr )

3737import Rel8.Expr.Bool ( boolExpr )

3838import Rel8.Expr.Null ( isNull, isNonNull, null, nullify )

@@ -42,10 +42,10 @@ import qualified Rel8.Schema.Kind as K

4242import Rel8.Schema.HTable.Identity ( HIdentity(..) )

4343import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

4444import Rel8.Schema.HTable.Maybe ( HMaybeTable(..) )

45−import Rel8.Schema.Name ( Col( N ), Name )

45+import Rel8.Schema.Name ( Name( N ) )

4646import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )

4747import qualified Rel8.Schema.Null as N

48−import Rel8.Schema.Result ( Col( R ) )

48+import Rel8.Schema.Result ( Result( R ) )

4949import Rel8.Schema.Spec ( Spec( Spec ) )

5050import Rel8.Table

5151 ( Table, Columns, Context, fromColumns, toColumns

@@ -80,7 +80,7 @@ import Data.Functor.Bind ( Bind, (>>-) )

8080-- a "nullTag" - to track whether or not the outer join produced any rows.

8181type MaybeTable :: K.Context -> Type -> Type

8282data MaybeTable context a = MaybeTable

83− { tag :: Col context ('Spec (Maybe MaybeTag))

83+ { tag :: context ('Spec (Maybe MaybeTag))

8484 , just :: Nullify context a

8585 }

8686 deriving stock Functor

src/Rel8/Table/Name.hs+9−4

@@ -1,8 +1,12 @@

1+{-# language DataKinds #-}

12{-# language FlexibleContexts #-}

3+{-# language FlexibleInstances #-}

4+{-# language MultiParamTypeClasses #-}

25{-# language NamedFieldPuns #-}

36{-# language ScopedTypeVariables #-}

47{-# language TypeApplications #-}

58{-# language TypeFamilies #-}

9+{-# language UndecidableInstances #-}

610{-# language ViewPatterns #-}

711

812module Rel8.Table.Name

@@ -25,12 +29,13 @@ import Prelude

2529import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

2630

2731-- rel8

28−import Rel8.Expr ( Expr, Col( E ) )

32+import Rel8.Expr ( Expr( E ) )

2933import Rel8.Expr.Opaleye ( toPrimExpr )

3034import Rel8.Schema.HTable ( htabulate, htabulateA, hfield, hspecs )

31−import Rel8.Schema.Name ( Name( Name ), Col( N ) )

35+import Rel8.Schema.Name ( Name( N, Name ) )

3236import Rel8.Schema.Spec ( SSpec(..) )

33−import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

37+import Rel8.Table ( Table(..) )

38+import Rel8.Table.Cols ( Cols( Cols ) )

3439

3540

3641-- | Construct a table in the 'Name' context containing the names of all

@@ -67,7 +72,7 @@ namesFromLabelsWith f = fromColumns $ htabulate $ \field ->

6772

6873showExprs :: Table Expr a => a -> [(String, Opaleye.PrimExpr)]

6974showExprs as = case (namesFromLabels, toColumns as) of

70− (names, exprs) -> getConst $ htabulateA $ \field ->

75+ (Cols names, exprs) -> getConst $ htabulateA $ \field ->

7176 case (hfield names field, hfield exprs field) of

7277 (N (Name name), E expr) -> Const [(name, toPrimExpr expr)]

7378

src/Rel8/Table/NonEmpty.hs+3−3

@@ -22,13 +22,13 @@ import Data.List.NonEmpty ( NonEmpty )

2222import Prelude hiding ( id )

2323

2424-- rel8

25−import Rel8.Expr ( Expr, Col( E, unE ) )

25+import Rel8.Expr ( Expr( E, unE ) )

2626import Rel8.Expr.Array ( sappend1, snonEmptyOf )

2727import Rel8.Schema.Dict ( Dict( Dict ) )

2828import Rel8.Schema.HTable.NonEmpty ( HNonEmptyTable )

2929import Rel8.Schema.HTable.Vectorize ( happend, hvectorize, hunvectorize )

3030import qualified Rel8.Schema.Kind as K

31−import Rel8.Schema.Name ( Col( N ), Name( Name ) )

31+import Rel8.Schema.Name ( Name( N, Name ) )

3232import Rel8.Schema.Null ( Nullity( Null, NotNull ) )

3333import Rel8.Schema.Result ( vectorizer, unvectorizer )

3434import Rel8.Schema.Spec ( SSpec(..) )

@@ -47,7 +47,7 @@ import Rel8.Table.Serialize ( ToExprs )

4747-- construct @NonEmptyTable@s with 'Rel8.some' or 'nonEmptyAgg'.

4848type NonEmptyTable :: K.Context -> Type -> Type

4949newtype NonEmptyTable context a =

50− NonEmptyTable (HNonEmptyTable (Columns a) (Col (Context a)))

50+ NonEmptyTable (HNonEmptyTable (Columns a) (Context a))

5151

5252

5353instance (Table context a, context ~ context') =>

src/Rel8/Table/Nullify.hs+4−5

@@ -28,7 +28,6 @@ import Control.Comonad ( Comonad, duplicate, extract, ComonadApply, (<@>) )

2828import Rel8.Aggregate ( Aggregate )

2929import Rel8.Expr ( Expr )

3030import Rel8.Kind.Context ( Reifiable, contextSing )

31−import Rel8.Schema.Context ( Col )

3231import Rel8.Schema.Context.Nullify

3332 ( Nullifiability( NAggregate, NExpr )

3433 , NonNullifiability

@@ -61,7 +60,7 @@ import Data.Functor.Extend ( Extend, duplicated )

6160type Nullify :: K.Context -> Type -> Type

6261data Nullify context a

6362 = Table (Nullifiability context) a

64− | Fields (NonNullifiability context) (HNullify (Columns a) (Col (Context a)))

63+ | Fields (NonNullifiability context) (HNullify (Columns a) (Context a))

6564

6665

6766instance Nullifiable context => Functor (Nullify context) where

@@ -173,10 +172,10 @@ aggregateNullify f = \case

173172

174173

175174guard :: (Reifiable context, HTable t)

176− => Col context ('Spec tag)

175+ => context ('Spec tag)

177176 -> (tag -> Bool)

178177 -> (Expr tag -> Expr Bool)

179− -> HNullify t (Col context)

180− -> HNullify t (Col context)

178+ -> HNullify t context

179+ -> HNullify t context

181180guard tag isNonNull isNonNullExpr =

182181 hguard (guarder contextSing tag isNonNull isNonNullExpr)

src/Rel8/Table/Opaleye.hs+9−7

@@ -1,8 +1,10 @@

11{-# language BlockArguments #-}

2+{-# language DataKinds #-}

23{-# language DisambiguateRecordFields #-}

34{-# language FlexibleContexts #-}

45{-# language LambdaCase #-}

56{-# language NamedFieldPuns #-}

7+{-# language RankNTypes #-}

68{-# language TypeFamilies #-}

79{-# language ViewPatterns #-}

810

@@ -35,8 +37,8 @@ import qualified Opaleye.Internal.Table as Opaleye

3537import Data.Profunctor ( dimap, lmap )

3638

3739-- rel8

38−import Rel8.Aggregate ( Col( A ), Aggregate( Aggregate ), Aggregates )

39−import Rel8.Expr ( Expr, Col(..) )

40+import Rel8.Aggregate ( Aggregate( A, Aggregate ), Aggregates )

41+import Rel8.Expr ( Expr(..) )

4042import Rel8.Expr.Opaleye

4143 ( fromPrimExpr, toPrimExpr

4244 , traversePrimExpr

@@ -44,8 +46,8 @@ import Rel8.Expr.Opaleye

4446 , scastExpr

4547 )

4648import Rel8.Schema.HTable ( htabulateA, hfield, htraverse, hspecs, htabulate )

47−import Rel8.Schema.Name ( Col( N ), Name( Name ), Selects )

48−import Rel8.Schema.Spec ( SSpec(..) )

49+import Rel8.Schema.Name ( Name( N, Name ), Selects )

50+import Rel8.Schema.Spec ( Spec, SSpec(..) )

4951import Rel8.Schema.Table ( TableSchema(..) )

5052import Rel8.Table ( Table, fromColumns, toColumns )

5153import Rel8.Table.Undefined ( undefined )

@@ -88,14 +90,14 @@ table (TableSchema name schema columns) =

8890 Just schemaName -> Opaleye.TableWithSchema schemaName name (tableFields columns)

8991

9092

91−tableFields ::Selects names exprs

93+tableFields :: Selects names exprs

9294 => names -> Opaleye.TableFields exprs exprs

9395tableFields (toColumns -> names) = dimap toColumns fromColumns $

9496 unwrapApplicative $ htabulateA $ \field -> WrapApplicative $

9597 case hfield names field of

9698 name -> lmap (`hfield` field) (go name)

9799 where

98− go :: Col Name spec -> Opaleye.TableFields (Col Expr spec) (Col Expr spec)

100+ go :: forall (spec :: Spec). Name spec -> Opaleye.TableFields (Expr spec) (Expr spec)

99101 go (N (Name name)) =

100102 lmap (\(E a) -> toColumn $ toPrimExpr a) $

101103 E . fromPrimExpr . fromColumn <$>

@@ -130,7 +132,7 @@ toPackMap as = Opaleye.PackMap $ \f () ->

130132castTable :: Table Expr a => a -> a

131133castTable (toColumns -> as) = fromColumns $ htabulate \i ->

132134 case hfield hspecs i of

133− SSpec{info} ->

135+ SSpec{info} ->

134136 case hfield as i of

135137 E expr ->

136138 E (scastExpr info expr)

src/Rel8/Table/Ord.hs+2−17

@@ -25,7 +25,7 @@ import GHC.Generics ( Rep )

2525import Prelude hiding ( seq )

2626

2727-- rel8

28−import Rel8.Expr ( Expr, Col( E ) )

28+import Rel8.Expr ( Expr( E ) )

2929import Rel8.Expr.Bool ( (||.), (&&.), false, true )

3030import Rel8.Expr.Eq ( (==.) )

3131import Rel8.Expr.Ord ( (<.), (>.) )

@@ -33,17 +33,13 @@ import Rel8.FCF ( Eval, Exp )

3333import Rel8.Generic.Record ( Record )

3434import Rel8.Generic.Table.Record ( GTable, GColumns, gtable )

3535import Rel8.Schema.Dict ( Dict( Dict ) )

36−import Rel8.Schema.HTable

37− ( HTable, HConstrainTable

38− , htabulateA, hfield, hdicts

39− )

36+import Rel8.Schema.HTable ( htabulateA, hfield )

4037import Rel8.Schema.HTable.Identity ( HIdentity( HType ) )

4138import Rel8.Schema.Null (Sql)

4239import Rel8.Schema.Spec.Constrain ( ConstrainSpec )

4340import Rel8.Table ( Columns, toColumns, TColumns, TFromExprs )

4441import Rel8.Table.Bool ( bool )

4542import Rel8.Table.Eq ( EqTable )

46−import Rel8.Type.Eq ( DBEq )

4743import Rel8.Type.Ord ( DBOrd )

4844

4945

@@ -74,17 +70,6 @@ data TOrdTable :: Type -> Exp Constraint

7470type instance Eval (TOrdTable a) = OrdTable a

7571

7672

77−instance

78− ( HTable t

79− , f ~ Col Expr

80− , HConstrainTable t (ConstrainSpec (Sql DBEq))

81− , HConstrainTable t (ConstrainSpec (Sql DBOrd))

82− )

83− => OrdTable (t f)

84− where

85− ordTable = hdicts @(Columns (t f)) @(ConstrainSpec (Sql DBOrd))

86−

87−

8873instance Sql DBOrd a => OrdTable (Expr a) where

8974 ordTable = HType Dict

9075

src/Rel8/Table/Recontextualize.hs+1−6

@@ -16,8 +16,6 @@ import Data.Kind ( Constraint, Type )

1616import Prelude ()

1717

1818-- rel8

19−import Rel8.Schema.Context ( Col )

20−import Rel8.Schema.HTable ( HTable )

2119import qualified Rel8.Schema.Kind as K

2220import Rel8.Schema.Spec ( KnownSpec )

2321import Rel8.Table ( Table, Congruent )

@@ -41,10 +39,7 @@ class

4139 , b from -> a

4240

4341

44−instance KnownSpec spec => Recontextualize from to (Col from spec) (Col to spec)

45−

46−

47−instance HTable t => Recontextualize from to (t (Col from)) (t (Col to))

42+instance KnownSpec spec => Recontextualize from to (from spec) (to spec)

4843

4944

5045instance

src/Rel8/Table/Rel8able.hs+7−5

@@ -44,10 +44,10 @@ import Rel8.Type.Eq ( DBEq )

4444import Rel8.Type.Ord ( DBOrd )

4545

4646

47−instance (Rel8able t, Virtual context) => Table context (t context) where

48− type Columns (t context) = GColumns t

49− type Context (t context) = context

50− type FromExprs (t context) = GFromExprs t

47+instance (Rel8able t, Virtual f, f ~ g) => Table f (t g) where

48+ type Columns (t g) = GColumns t

49+ type Context (t g) = g

50+ type FromExprs (t g) = GFromExprs t

5151

5252 fromColumns = gfromColumns virtual

5353 toColumns = gtoColumns virtual

@@ -60,8 +60,10 @@ instance

6060 , Virtual from

6161 , Virtual to

6262 , Congruent (t from) (t to)

63+ , from ~ from'

64+ , to ~ to'

6365 )

64− => Recontextualize from to (t from) (t to)

66+ => Recontextualize from' to' (t from) (t to)

6567

6668

6769instance

src/Rel8/Table/Serialize.hs+7−11

@@ -10,7 +10,7 @@

1010{-# language UndecidableInstances #-}

1111

1212module Rel8.Table.Serialize

13− ( Serializable, lit, parse

13+ ( Serializable, lit, litHTable, parse

1414 , ToExprs

1515 )

1616where

@@ -24,11 +24,11 @@ import Prelude

2424import qualified Hasql.Decoders as Hasql

2525

2626-- rel8

27−import Rel8.Expr ( Expr, Col( E ) )

27+import Rel8.Expr ( Expr( E ) )

2828import Rel8.Expr.Serialize ( slitExpr, sparseValue )

2929import Rel8.Schema.HTable ( HTable, htabulate, htabulateA, hfield, hspecs )

3030import Rel8.Schema.Null ( NotNull, Sql )

31−import Rel8.Schema.Result ( Col( R ), Result )

31+import Rel8.Schema.Result ( Result( R ) )

3232import Rel8.Schema.Spec ( SSpec(..), KnownSpec )

3333import Rel8.Table ( Table, fromColumns, FromExprs, fromResult, toResult )

3434import Rel8.Type ( DBType )

@@ -115,12 +115,8 @@ instance

115115 => ToExprs x (a, b, c, d, e, f, g)

116116

117117

118−instance (HTable t, result ~ Col Result, x ~ t (Col Expr)) =>

119− ToExprs x (t result)

120−

121−

122−instance (KnownSpec spec, x ~ Col Expr spec) =>

123− ToExprs x (Col Result spec)

118+instance (KnownSpec spec, x ~ Expr spec) =>

119+ ToExprs x (Result spec)

124120

125121

126122-- | @Serializable@ witnesses the one-to-one correspondence between the type

@@ -142,14 +138,14 @@ parse :: forall exprs a. Serializable exprs a => Hasql.Row a

142138parse = fromResult @_ @exprs <$> parseHTable

143139

144140

145−litHTable :: HTable t => t (Col Result) -> t (Col Expr)

141+litHTable :: HTable t => t Result -> t Expr

146142litHTable as = htabulate $ \field ->

147143 case hfield hspecs field of

148144 SSpec {nullity, info} -> case hfield as field of

149145 R value -> E (slitExpr nullity info value)

150146

151147

152−parseHTable :: HTable t => Hasql.Row (t (Col Result))

148+parseHTable :: HTable t => Hasql.Row (t Result)

153149parseHTable = unwrapApplicative $ htabulateA $ \field ->

154150 WrapApplicative $ case hfield hspecs field of

155151 SSpec {nullity, info} -> R <$> sparseValue nullity info

src/Rel8/Table/Undefined.hs+1−1

@@ -11,7 +11,7 @@ where

1111import Prelude hiding ( undefined )

1212

1313-- rel8

14−import Rel8.Expr ( Expr, Col( E ) )

14+import Rel8.Expr ( Expr( E ) )

1515import Rel8.Expr.Null ( snull, unsafeUnnullify )

1616import Rel8.Schema.HTable ( htabulate, hfield, hspecs )

1717import Rel8.Schema.Null ( Nullity( Null, NotNull ) )

src/Rel8/Type/Composite.hs+7−7

@@ -30,19 +30,19 @@ import qualified Hasql.Decoders as Hasql

3030import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

3131

3232-- rel8

33−import Rel8.Expr ( Col( E ), Expr )

33+import Rel8.Expr ( Expr( E ) )

3434import Rel8.Expr.Opaleye ( castExpr, fromPrimExpr, toPrimExpr )

3535import Rel8.Schema.HTable ( HTable, hfield, hspecs, htabulate, htabulateA )

36−import Rel8.Schema.Name ( Col( N ), Name( Name ) )

36+import Rel8.Schema.Name ( Name( N, Name ) )

3737import Rel8.Schema.Null ( Nullity( Null, NotNull ) )

38−import Rel8.Schema.Result ( Col( R ), Result )

38+import Rel8.Schema.Result ( Result( R ) )

3939import Rel8.Schema.Spec ( SSpec( SSpec, nullity, info ) )

4040import Rel8.Table ( fromColumns, toColumns, fromResult, toResult )

4141import Rel8.Table.Eq ( EqTable )

4242import Rel8.Table.HKD ( HKD, HKDable )

4343import Rel8.Table.Ord ( OrdTable )

4444import Rel8.Table.Rel8able ()

45−import Rel8.Table.Serialize ( lit )

45+import Rel8.Table.Serialize ( litHTable )

4646import Rel8.Type ( DBType, typeInformation )

4747import Rel8.Type.Eq ( DBEq )

4848import Rel8.Type.Information ( TypeInformation(..) )

@@ -68,7 +68,7 @@ newtype Composite a = Composite

6868instance DBComposite a => DBType (Composite a) where

6969 typeInformation = TypeInformation

7070 { decode = Hasql.composite (Composite . fromResult @_ @(HKD a Expr) <$> decoder)

71− , encode = encoder . lit . toResult @_ @(HKD a Expr) . unComposite

71+ , encode = encoder . litHTable . toResult @_ @(HKD a Expr) . unComposite

7272 , typeName = compositeTypeName @a

7373 }

7474

@@ -118,7 +118,7 @@ decompose (toPrimExpr -> a) = fromColumns $ htabulate \field ->

118118 names = toColumns (compositeFields @a)

119119

120120

121−decoder :: HTable t => Hasql.Composite (t (Col Result))

121+decoder :: HTable t => Hasql.Composite (t Result)

122122decoder = unwrapApplicative $ htabulateA \field ->

123123 case hfield hspecs field of

124124 SSpec {nullity, info} -> WrapApplicative $ R <$>

@@ -127,7 +127,7 @@ decoder = unwrapApplicative $ htabulateA \field ->

127127 NotNull -> Hasql.field $ Hasql.nonNullable $ decode info

128128

129129

130−encoder :: HTable t => t (Col Expr) -> Opaleye.PrimExpr

130+encoder :: HTable t => t Expr -> Opaleye.PrimExpr

131131encoder a = Opaleye.FunExpr "ROW" exprs

132132 where

133133 exprs = getConst $ htabulateA \field -> case hfield a field of