4aa5ba9 · rel8 · git.iko.soy

rel8.cabal−2

compare with master

unifiedsplit

@@ -79,7 +79,6 @@ library

79

80 Rel8.Kind.Algebra

81 Rel8.Kind.Context

82− Rel8.Kind.Labels

83

82

84 Rel8.Generic.Construction

83 Rel8.Generic.Construction

85 Rel8.Generic.Construction.ADT

84 Rel8.Generic.Construction.ADT

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

115 Rel8.Query.Values

114 Rel8.Query.Values

116

115

117 Rel8.Schema.Context

116 Rel8.Schema.Context

118− Rel8.Schema.Context.Label

119 Rel8.Schema.Context.Nullify

117 Rel8.Schema.Context.Nullify

120 Rel8.Schema.Dict

118 Rel8.Schema.Dict

121 Rel8.Schema.HTable

119 Rel8.Schema.HTable

src/Rel8.hs−2

@@ -270,7 +270,6 @@ module Rel8

270 , evaluate

271

272 -- * Implementation details

273− , Labelable

274 , HKDT(..)

273 , HKDT(..)

275 ) where

274 ) where

276

275

@@ -317,7 +316,6 @@ import Rel8.Query.SQL (showQuery)

317import Rel8.Query.Set

316import Rel8.Query.Set

318import Rel8.Query.These

317import Rel8.Query.These

319import Rel8.Query.Values

318import Rel8.Query.Values

320−import Rel8.Schema.Context.Label

321import Rel8.Schema.HTable

319import Rel8.Schema.HTable

322import Rel8.Schema.Name

320import Rel8.Schema.Name

323import Rel8.Schema.Null hiding ( nullable )

321import Rel8.Schema.Null hiding ( nullable )

src/Rel8/Aggregate.hs+1−7

@@ -33,7 +33,6 @@ import qualified Opaleye.Internal.PackMap as Opaleye

33-- rel8

34import Rel8.Expr ( Expr )

35import Rel8.Schema.Context ( Interpretation(..) )

36−import Rel8.Schema.Context.Label ( Labelable(..) )

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

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

38import Rel8.Schema.Name ( Name )

37import Rel8.Schema.Name ( Name )

39import Rel8.Schema.Null ( Sql )

38import Rel8.Schema.Null ( Sql )

@@ -62,7 +61,7 @@ instance Interpretation Aggregate where

62 data Col Aggregate _spec where

61 data Col Aggregate _spec where

63 A :: ()

62 A :: ()

64 => { unA :: !(Aggregate a) }

63 => { unA :: !(Aggregate a) }

65− -> Col Aggregate ('Spec labels a)

64+ -> Col Aggregate ('Spec a)

66

65

67

66

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

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

@@ -104,11 +103,6 @@ instance Sql DBType a =>

104 Recontextualize Name Aggregate (Name a) (Aggregate a)

103 Recontextualize Name Aggregate (Name a) (Aggregate a)

105

104

106

105

107−instance Labelable Aggregate where

108− labeler (A aggregate) = A aggregate

109− unlabeler (A aggregate) = A aggregate

110−

111−

112-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's

106-- | @Aggregates a b@ means that the columns in @a@ are all 'Aggregate' 'Expr's

113-- for the columns in @b@.

107-- for the columns in @b@.

114type Aggregates :: Type -> Type -> Constraint

108type Aggregates :: Type -> Type -> Constraint

src/Rel8/Column.hs+6−6

@@ -20,7 +20,7 @@ import Rel8.Aggregate ( Aggregate, Col( A ) )

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

21import Rel8.FCF ( Eval, Exp )

22import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )

23−import Rel8.Schema.HTable.Identity ( HIdentity( HIdentity ) )

23+import Rel8.Schema.HTable.Identity ( HIdentity(..), HType )

24import qualified Rel8.Schema.Kind as K

25import Rel8.Schema.Name ( Name(..), Col( N ) )

26import Rel8.Schema.Null ( Sql )

@@ -55,11 +55,11 @@ instance (Reifiable context, Sql DBType a) =>

55 Table (Reify context) (AColumn context a)

56 where

57 type Context (AColumn context a) = Reify context

58− type Columns (AColumn context a) = HIdentity ('Spec '[] a)

58+ type Columns (AColumn context a) = HType a

59 type Unreify (AColumn context a) = Column context a

60

61− fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a

61+ fromColumns (HType (Reify a)) = sfromColumn contextSing a

62− toColumns = HIdentity . Reify . stoColumn contextSing

62+ toColumns = HType . Reify . stoColumn contextSing

63 reify _ = AColumn

64 unreify _ (AColumn a) = a

65

@@ -77,7 +77,7 @@ instance

77

78sfromColumn :: ()

79 => SContext context

80− -> Col context ('Spec labels a)

80+ -> Col context ('Spec a)

81 -> AColumn context a

82sfromColumn = \case

83 SAggregate -> \(A a) -> AColumn a

@@ -90,7 +90,7 @@ sfromColumn = \case

90stoColumn :: ()

91 => SContext context

92 -> AColumn context a

93− -> Col context ('Spec labels a)

93+ -> Col context ('Spec a)

94stoColumn = \case

95 SAggregate -> \(AColumn a) -> A a

96 SExpr -> \(AColumn a) -> E a

src/Rel8/Expr.hs+1−7

@@ -39,7 +39,6 @@ import Rel8.Expr.Opaleye

39 )

40import Rel8.Expr.Serialize ( litExpr )

41import Rel8.Schema.Context ( Interpretation, Col )

42−import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )

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

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

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

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

45import Rel8.Schema.Reify ( notReify )

44import Rel8.Schema.Reify ( notReify )

@@ -128,7 +127,7 @@ instance Sql DBFloating a => Floating (Expr a) where

128

127

129instance Interpretation Expr where

128instance Interpretation Expr where

130 data Col Expr _spec where

129 data Col Expr _spec where

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

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

132

131

133

132

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

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

@@ -148,8 +147,3 @@ instance Sql DBType a => Recontextualize Expr Result (Expr a) (Identity a)

148

147

149

148

150instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)

149instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)

151−

152−

153−instance Labelable Expr where

154− labeler (E a) = E a

155− unlabeler (E a) = E a

src/Rel8/Generic/Construction/ADT.hs+23−31

@@ -48,7 +48,6 @@ import Rel8.Generic.Construction.Record

48 )

49import Rel8.Generic.Table.ADT ( GColumnsADT, GColumnsADT' )

50import Rel8.Generic.Table.Record ( GColumns )

51−import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

52import Rel8.Schema.HTable ( HTable )

51import Rel8.Schema.HTable ( HTable )

53import Rel8.Schema.HTable.Identity ( HType )

52import Rel8.Schema.HTable.Identity ( HType )

54import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

53import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

@@ -64,23 +63,23 @@ import Data.Text ( pack )

64

63

65

64

66type Null :: K.HContext -> Type

65type Null :: K.HContext -> Type

67−type Null context = forall labels a. ()

66+type Null context = forall a. ()

68− => SSpec ('Spec labels a)

67+ => SSpec ('Spec a)

69− -> context ('Spec labels (Nullify a))

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

70

69

71

70

72type Nullifier :: K.HContext -> Type

71type Nullifier :: K.HContext -> Type

73−type Nullifier context = forall labels a. ()

72+type Nullifier context = forall a. ()

74− => SSpec ('Spec labels a)

73+ => SSpec ('Spec a)

75− -> context ('Spec labels a)

74+ -> context ('Spec a)

76− -> context ('Spec labels (Nullify a))

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

77

76

78

77

79type Unnullifier :: K.HContext -> Type

78type Unnullifier :: K.HContext -> Type

80−type Unnullifier context = forall labels a. ()

79+type Unnullifier context = forall a. ()

81− => SSpec ('Spec labels a)

80+ => SSpec ('Spec a)

82− -> context ('Spec labels (Nullify a))

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

83− -> context ('Spec labels a)

82+ -> context ('Spec a)

84

83

85

84

86type NoConstructor :: Symbol -> Symbol -> ErrorMessage

85type NoConstructor :: Symbol -> Symbol -> ErrorMessage

@@ -222,24 +221,23 @@ class GConstructableADT _Table _Columns f context rep where

222instance

221instance

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

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

224 , GConstructableADT' _Table _Columns f context htable rep

223 , GConstructableADT' _Table _Columns f context htable rep

225− , HLabelable context

226 )

224 )

227 => GConstructableADT _Table _Columns f context (M1 D meta rep)

225 => GConstructableADT _Table _Columns f context (M1 D meta rep)

228 where

226 where

229 gbuildADT toColumns nullifier =

227 gbuildADT toColumns nullifier =

230 gbuildADT' @_Table @_Columns @f @context @htable @rep toColumns nullifier .

228 gbuildADT' @_Table @_Columns @f @context @htable @rep toColumns nullifier .

231− hlabel hlabeler

229+ hlabel

232

230

233 gunbuildADT fromColumns unnullifier =

231 gunbuildADT fromColumns unnullifier =

234− first (hunlabel hunlabeler) .

232+ first hunlabel .

235 gunbuildADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier

233 gunbuildADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier

236

234

237 gconstructADT toColumns null nullifier mk =

235 gconstructADT toColumns null nullifier mk =

238 gconstructADT' @_Table @_Columns @f @context @htable @rep toColumns null nullifier

236 gconstructADT' @_Table @_Columns @f @context @htable @rep toColumns null nullifier

239− (hlabel hlabeler . mk)

237+ (hlabel . mk)

240

238

241 gdeconstructADT fromColumns unnullifier cases =

239 gdeconstructADT fromColumns unnullifier cases =

242− first (hunlabel hunlabeler) .

240+ first hunlabel .

243 gdeconstructADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier cases

241 gdeconstructADT' @_Table @_Columns @f @context @htable @rep fromColumns unnullifier cases

244

242

245

243

@@ -334,7 +332,6 @@ instance {-# OVERLAPPABLE #-}

334 ( HTable (GColumns _Columns rep)

332 ( HTable (GColumns _Columns rep)

335 , KnownSymbol label

333 , KnownSymbol label

336 , meta ~ 'MetaCons label _fixity _isRecord

334 , meta ~ 'MetaCons label _fixity _isRecord

337− , HLabelable context

338 , GConstructable _Table _Columns f context rep

335 , GConstructable _Table _Columns f context rep

339 , GColumnsADT' _Columns htable (M1 C meta rep) ~

336 , GColumnsADT' _Columns htable (M1 C meta rep) ~

340 HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))

337 HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))

@@ -343,7 +340,7 @@ instance {-# OVERLAPPABLE #-}

343 where

340 where

344 gbuildADT' toColumns nullifier htable =

341 gbuildADT' toColumns nullifier htable =

345 HProduct htable .

342 HProduct htable .

346− hlabel hlabeler .

343+ hlabel .

347 hnullify (nullifier tag) .

344 hnullify (nullifier tag) .

348 gconstruct @_Table @_Columns @f @context @rep toColumns

345 gconstruct @_Table @_Columns @f @context @rep toColumns

349 where

346 where

@@ -354,13 +351,13 @@ instance {-# OVERLAPPABLE #-}

354 , gdeconstruct @_Table @_Columns @f @context @rep fromColumns $

351 , gdeconstruct @_Table @_Columns @f @context @rep fromColumns $

355 runIdentity $

352 runIdentity $

356 hunnullify (\spec -> pure . unnullifier spec) $

353 hunnullify (\spec -> pure . unnullifier spec) $

357− hunlabel hunlabeler

354+ hunlabel

358 a

355 a

359 )

356 )

360

357

361 gconstructADT' toColumns _ nullifier mk =

358 gconstructADT' toColumns _ nullifier mk =

362 HProduct htable .

359 HProduct htable .

363− hlabel hlabeler .

360+ hlabel .

364 hnullify nullifier .

361 hnullify nullifier .

365 gconstruct @_Table @_Columns @f @context @rep toColumns

362 gconstruct @_Table @_Columns @f @context @rep toColumns

366 where

363 where

@@ -375,11 +372,11 @@ instance {-# OVERLAPPABLE #-}

375 a = gdeconstruct @_Table @_Columns @f @context @rep fromColumns $

372 a = gdeconstruct @_Table @_Columns @f @context @rep fromColumns $

376 runIdentity $

373 runIdentity $

377 hunnullify (\spec -> pure . unnullifier spec) $

374 hunnullify (\spec -> pure . unnullifier spec) $

378− hunlabel hunlabeler

375+ hunlabel

379 columns

376 columns

380 tag = Tag $ pack $ symbolVal (Proxy @label)

377 tag = Tag $ pack $ symbolVal (Proxy @label)

381

378

382− gfill null htable = HProduct htable (hlabel hlabeler (hnulls null))

379+ gfill null htable = HProduct htable (hlabel (hnulls null))

383

380

384

381

385type GMakeableADT

382type GMakeableADT

@@ -403,7 +400,6 @@ instance

403 , fallback ~ TypeError (NoConstructor datatype name)

400 , fallback ~ TypeError (NoConstructor datatype name)

404 , fields ~ GFields f (GConstructorADT' name rep fallback)

401 , fields ~ GFields f (GConstructorADT' name rep fallback)

405 , GMakeableADT' _Table _Columns f context htable name rep fields

402 , GMakeableADT' _Table _Columns f context htable name rep fields

406− , HLabelable context

407 , KnownSymbol name

403 , KnownSymbol name

408 )

404 )

409 => GMakeableADT _Table _Columns f context name (M1 D meta rep)

405 => GMakeableADT _Table _Columns f context name (M1 D meta rep)

@@ -414,7 +410,7 @@ instance

414 toColumns null nullifier htable

410 toColumns null nullifier htable

415 where

411 where

416 tag = Tag $ pack $ symbolVal (Proxy @name)

412 tag = Tag $ pack $ symbolVal (Proxy @name)

417− htable = hlabel hlabeler (wrap tag)

413+ htable = hlabel (wrap tag)

418

414

419

415

420type GMakeableADT'

416type GMakeableADT'

@@ -462,8 +458,6 @@ instance {-# OVERLAPS #-}

462

458

463instance {-# OVERLAPS #-}

459instance {-# OVERLAPS #-}

464 ( HTable (GColumns _Columns rep)

460 ( HTable (GColumns _Columns rep)

465− , KnownSymbol name

466− , HLabelable context

467 , GConstructable _Table _Columns f context rep

461 , GConstructable _Table _Columns f context rep

468 , fields ~ GFields f rep

462 , fields ~ GFields f rep

469 , GColumnsADT' _Columns htable (M1 C ('MetaCons name _fixity _isRecord) rep) ~

463 , GColumnsADT' _Columns htable (M1 C ('MetaCons name _fixity _isRecord) rep) ~

@@ -473,15 +467,13 @@ instance {-# OVERLAPS #-}

473 where

467 where

474 gmakeADT' toColumns _ nullifier htable =

468 gmakeADT' toColumns _ nullifier htable =

475 HProduct htable .

469 HProduct htable .

476− hlabel hlabeler .

470+ hlabel .

477 hnullify nullifier .

471 hnullify nullifier .

478 gconstruct @_Table @_Columns @f @context @rep toColumns

472 gconstruct @_Table @_Columns @f @context @rep toColumns

479

473

480

474

481instance {-# OVERLAPPABLE #-}

475instance {-# OVERLAPPABLE #-}

482 ( HTable (GColumns _Columns rep)

476 ( HTable (GColumns _Columns rep)

483− , KnownSymbol label

484− , HLabelable context

485 , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~

477 , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~

486 HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))

478 HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))

487 )

479 )

@@ -489,5 +481,5 @@ instance {-# OVERLAPPABLE #-}

489 where

481 where

490 gmakeADT' _ null _ htable _ =

482 gmakeADT' _ null _ htable _ =

491 HProduct htable $

483 HProduct htable $

492− hlabel hlabeler $

484+ hlabel $

493 hnulls null

485 hnulls null

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

@@ -27,15 +27,13 @@ import GHC.Generics

27 )

28import GHC.TypeLits

29 ( ErrorMessage( (:<>:), Text ), TypeError

30− , Symbol, KnownSymbol

30+ , Symbol

31 )

32import Prelude

33

34-- rel8

35import Rel8.FCF ( Eval, Exp )

36import Rel8.Generic.Table.Record ( GColumns )

37−import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

38−import Rel8.Schema.HTable ( HTable )

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

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

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

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

41import qualified Rel8.Schema.Kind as K

39import qualified Rel8.Schema.Kind as K

@@ -162,12 +160,9 @@ instance

162

160

163instance

161instance

164 ( Eval (_Table a)

162 ( Eval (_Table a)

165− , HTable (Eval (_Columns a))

166− , HLabelable context

167− , KnownSymbol label

168 , meta ~ 'MetaSel ('Just label) _su _ss _ds

163 , meta ~ 'MetaSel ('Just label) _su _ss _ds

169 )

164 )

170 => GConstructable _Table _Columns f context (M1 S meta (K1 i a))

165 => GConstructable _Table _Columns f context (M1 S meta (K1 i a))

171 where

166 where

172− gconstruct toColumns = hlabel hlabeler . toColumns (Proxy @a)

167+ gconstruct toColumns = hlabel . toColumns (Proxy @a)

173− gdeconstruct fromColumns = fromColumns (Proxy @a) . hunlabel hunlabeler

168+ gdeconstruct fromColumns = fromColumns (Proxy @a) . hunlabel

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

@@ -36,7 +36,6 @@ import Rel8.Generic.Table ( GAlgebra )

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

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

38import Rel8.Schema.Context ( Col )

39−import Rel8.Schema.Context.Label ( Labelable )

40import Rel8.Schema.HTable ( HTable )

39import Rel8.Schema.HTable ( HTable )

41import qualified Rel8.Schema.Kind as K

40import qualified Rel8.Schema.Kind as K

42import Rel8.Schema.Reify ( Reify, UnwrapReify )

41import Rel8.Schema.Reify ( Reify, UnwrapReify )

@@ -98,16 +97,16 @@ type Rel8able :: K.Rel8able -> Constraint

98class HTable (GColumns t) => Rel8able t where

97class HTable (GColumns t) => Rel8able t where

99 type GColumns t :: K.HTable

98 type GColumns t :: K.HTable

100

99

101− gfromColumns :: (Labelable context, Reifiable context)

100+ gfromColumns :: Reifiable context

102 => GColumns t (Col (Reify context)) -> t (Reify context)

101 => GColumns t (Col (Reify context)) -> t (Reify context)

103

102

104− gtoColumns :: (Labelable context, Reifiable context)

103+ gtoColumns :: Reifiable context

105 => t (Reify context) -> GColumns t (Col (Reify context))

104 => t (Reify context) -> GColumns t (Col (Reify context))

106

105

107− greify :: (Labelable context, Reifiable context)

106+ greify :: Reifiable context

108 => t context -> t (Reify context)

107 => t context -> t (Reify context)

109

108

110− gunreify :: (Labelable context, Reifiable context)

109+ gunreify :: Reifiable context

111 => t (Reify context) -> t context

110 => t (Reify context) -> t context

112

111

113 type GColumns t = G.GColumns TColumns (GRep t (Reify Result))

112 type GColumns t = G.GColumns TColumns (GRep t (Reify Result))

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

@@ -148,10 +148,10 @@ ggtable :: forall algebra _Table _Columns rep context.

148 , Eval (GGTable algebra _Table _Columns context rep)

149 )

150 => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)

151− -> (forall a labels. ()

151+ -> (forall a. ()

152− => SSpec ('Spec labels a)

152+ => SSpec ('Spec a)

153− -> context ('Spec labels a)

153+ -> context ('Spec a)

154− -> context ('Spec labels (Nullify a)))

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

155 -> Eval (GGColumns algebra _Columns rep) context

156ggtable = case algebraSing @algebra of

157 SProduct -> \table _ -> gtable @_Table @_Columns @_ @rep table

src/Rel8/Generic/Table/ADT.hs+14−17

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

37 ( GTable, GColumns, gtable

38 , GToExprs, gfromResult, gtoResult

39 )

40−import Rel8.Schema.Context.Label ( HLabelable, hlabeler, labeler, unlabeler )

41import Rel8.Schema.HTable ( HTable, hmap )

40import Rel8.Schema.HTable ( HTable, hmap )

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

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

43import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

42import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

@@ -96,10 +95,10 @@ class GTableADT _Table _Columns context rep where

96

95

97 gtableADT :: ()

96 gtableADT :: ()

98 => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)

97 => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)

99− -> (forall a labels. ()

98+ -> (forall a. ()

100− => SSpec ('Spec labels a)

99+ => SSpec ('Spec a)

101− -> context ('Spec labels a)

100+ -> context ('Spec a)

102− -> context ('Spec labels (Nullify a)))

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

103 -> GColumnsADT _Columns rep context

102 -> GColumnsADT _Columns rep context

104

103

105

104

@@ -136,10 +135,10 @@ type GTableADT'

136class GTableADT' _Table _Columns htable context rep where

135class GTableADT' _Table _Columns htable context rep where

137 gtableADT' :: ()

136 gtableADT' :: ()

138 => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)

137 => (forall a proxy. Eval (_Table a) => proxy a -> Eval (_Columns a) context)

139− -> (forall a labels. ()

138+ -> (forall a. ()

140− => SSpec ('Spec labels a)

139+ => SSpec ('Spec a)

141− -> context ('Spec labels a)

140+ -> context ('Spec a)

142− -> context ('Spec labels (Nullify a)))

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

143 -> htable context

142 -> htable context

144 -> GColumnsADT' _Columns htable rep context

143 -> GColumnsADT' _Columns htable rep context

145

144

@@ -165,9 +164,7 @@ instance meta ~ 'MetaCons label _fixity _isRecord =>

165instance {-# OVERLAPPABLE #-}

164instance {-# OVERLAPPABLE #-}

166 ( HTable (GColumns _Columns rep)

165 ( HTable (GColumns _Columns rep)

167 , GTable _Table _Columns context rep

166 , GTable _Table _Columns context rep

168− , HLabelable context

169 , meta ~ 'MetaCons label _fixity _isRecord

167 , meta ~ 'MetaCons label _fixity _isRecord

170− , KnownSymbol label

171 , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~

168 , GColumnsADT' _Columns htable (M1 C ('MetaCons label _fixity _isRecord) rep) ~

172 HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))

169 HProduct htable (HLabel label (HNullify (GColumns _Columns rep)))

173 )

170 )

@@ -175,7 +172,7 @@ instance {-# OVERLAPPABLE #-}

175 where

172 where

176 gtableADT' table hnullifier htable =

173 gtableADT' table hnullifier htable =

177 HProduct htable $

174 HProduct htable $

178− hlabel hlabeler $

175+ hlabel $

179 hnullify hnullifier $

176 hnullify hnullifier $

180 gtable @_Table @_Columns @_ @rep table

177 gtable @_Table @_Columns @_ @rep table

181

178

@@ -219,12 +216,12 @@ instance

219 Just rep -> M1 rep

216 Just rep -> M1 rep

220 _ -> error "ADT.fromColumns: mismatch between tag and data"

217 _ -> error "ADT.fromColumns: mismatch between tag and data"

221 where

218 where

222− tag = (\(HType (R a)) -> a) . hunlabel @_ @"tag" unlabeler

219+ tag = (\(HType (R a)) -> a) . hunlabel @"tag"

223

220

224 gtoResultADT toResult (M1 rep) =

221 gtoResultADT toResult (M1 rep) =

225 gtoResultADT' @_ToExprs @_Columns @_ @exprs toResult tag (Just rep)

222 gtoResultADT' @_ToExprs @_Columns @_ @exprs toResult tag (Just rep)

226 where

223 where

227− tag = hlabel @_ @"tag" labeler . HType . R

224+ tag = hlabel @"tag" . HType . R

228

225

229

226

230type GToExprsADT'

227type GToExprsADT'

@@ -342,15 +339,15 @@ instance {-# OVERLAPPABLE #-}

342 gfromResultADT' fromResult tag (HProduct a b)

339 gfromResultADT' fromResult tag (HProduct a b)

343 | tag a == tag' =

340 | tag a == tag' =

344 M1 . gfromResult @_ToExprs @_Columns @exprs fromResult <$>

341 M1 . gfromResult @_ToExprs @_Columns @exprs fromResult <$>

345− hunnullify unnullifier (hunlabel unlabeler b)

342+ hunnullify unnullifier (hunlabel b)

346 | otherwise = Nothing

343 | otherwise = Nothing

347 where

344 where

348 tag' = Tag $ pack $ symbolVal (Proxy @label)

345 tag' = Tag $ pack $ symbolVal (Proxy @label)

349

346

350 gtoResultADT' toResult tag = \case

347 gtoResultADT' toResult tag = \case

351− Nothing -> HProduct (tag tag') (hlabel labeler (hnulls (const null)))

348+ Nothing -> HProduct (tag tag') (hlabel (hnulls (const null)))

352 Just (M1 rep) -> HProduct (tag tag') $

349 Just (M1 rep) -> HProduct (tag tag') $

353− hlabel labeler $

350+ hlabel $

354 hnullify nullifier $

351 hnullify nullifier $

355 gtoResult @_ToExprs @_Columns @exprs toResult rep

352 gtoResult @_ToExprs @_Columns @exprs toResult rep

356 where

353 where

src/Rel8/Generic/Table/Record.hs+6−12

@@ -26,13 +26,11 @@ import GHC.Generics

26 , C, D, S

27 , Meta( MetaSel )

28 )

29−import GHC.TypeLits ( KnownSymbol )

30import Prelude hiding ( null )

29import Prelude hiding ( null )

31

30

32-- rel8

31-- rel8

33import Rel8.FCF ( Eval, Exp )

32import Rel8.FCF ( Eval, Exp )

34import Rel8.Schema.Context ( Col )

33import Rel8.Schema.Context ( Col )

35−import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

36import Rel8.Schema.HTable ( HTable )

34import Rel8.Schema.HTable ( HTable )

37import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

35import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

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

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

@@ -116,18 +114,15 @@ instance

116

114

117

115

118instance

116instance

119− ( HTable (Eval (_Columns a))

120− , Eval (_Table a)

117+ ( Eval (_Table a)

121− , HLabelable context

122− , KnownSymbol label

123 , meta ~ 'MetaSel ('Just label) _su _ss _ds

118 , meta ~ 'MetaSel ('Just label) _su _ss _ds

124 , k1 ~ K1 i a

119 , k1 ~ K1 i a

125 )

120 )

126 => GTable _Table _Columns context (M1 S meta k1)

121 => GTable _Table _Columns context (M1 S meta k1)

127 where

122 where

128− gfromColumns fromColumns = M1 . K1 . fromColumns . hunlabel hunlabeler

123+ gfromColumns fromColumns = M1 . K1 . fromColumns . hunlabel

129− gtoColumns toColumns (M1 (K1 a)) = hlabel hlabeler (toColumns a)

124+ gtoColumns toColumns (M1 (K1 a)) = hlabel (toColumns a)

130− gtable table = hlabel hlabeler (table (Proxy @a))

125+ gtable table = hlabel (table (Proxy @a))

131

126

132

127

133type GToExprs

128type GToExprs

@@ -193,7 +188,6 @@ instance

193instance

188instance

194 ( Eval (_ToExprs exprs a)

189 ( Eval (_ToExprs exprs a)

195 , HTable (Eval (_Columns exprs))

190 , HTable (Eval (_Columns exprs))

196− , KnownSymbol label

197 , meta ~ 'MetaSel ('Just label) _su _ss _ds

191 , meta ~ 'MetaSel ('Just label) _su _ss _ds

198 , k1 ~ K1 i exprs

192 , k1 ~ K1 i exprs

199 , k1' ~ K1 i a

193 , k1' ~ K1 i a

@@ -201,6 +195,6 @@ instance

201 => GToExprs _ToExprs _Columns (M1 S meta k1) (M1 S meta k1')

195 => GToExprs _ToExprs _Columns (M1 S meta k1) (M1 S meta k1')

202 where

196 where

203 gfromResult fromResult =

197 gfromResult fromResult =

204− M1 . K1 . fromResult (Proxy @exprs) . hunlabel hunlabeler

198+ M1 . K1 . fromResult (Proxy @exprs) . hunlabel

205 gtoResult toResult (M1 (K1 a)) =

199 gtoResult toResult (M1 (K1 a)) =

206− hlabel hlabeler (toResult (Proxy @exprs) a)

200+ hlabel (toResult (Proxy @exprs) a)

src/Rel8/Kind/Context.hs−12

@@ -7,7 +7,6 @@ module Rel8.Kind.Context

7 ( Reifiable( contextSing )

8 , SContext(..)

9 , sReifiable

10− , sLabelable

11 )

10 )

12where

11where

13

12

@@ -20,7 +19,6 @@ import Rel8.Aggregate ( Aggregate )

20import Rel8.Expr ( Expr )

19import Rel8.Expr ( Expr )

21import Rel8.Schema.Dict ( Dict( Dict ) )

20import Rel8.Schema.Dict ( Dict( Dict ) )

22import Rel8.Schema.Context ( Interpretation )

21import Rel8.Schema.Context ( Interpretation )

23−import Rel8.Schema.Context.Label ( Labelable )

24import Rel8.Schema.Kind ( Context )

22import Rel8.Schema.Kind ( Context )

25import Rel8.Schema.Name ( Name )

23import Rel8.Schema.Name ( Name )

26import Rel8.Schema.Reify ( Reify )

24import Rel8.Schema.Reify ( Reify )

@@ -69,13 +67,3 @@ sReifiable = \case

69 SResult -> Dict

67 SResult -> Dict

70 SReify context -> case sReifiable context of

68 SReify context -> case sReifiable context of

71 Dict -> Dict

69 Dict -> Dict

72−

73−

74−sLabelable :: SContext context -> Dict Labelable context

75−sLabelable = \case

76− SAggregate -> Dict

77− SExpr -> Dict

78− SName -> Dict

79− SResult -> Dict

80− SReify context -> case sLabelable context of

81− Dict -> Dict

src/Rel8/Kind/Labels.hsdeleted−57

@@ -1,57 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language FlexibleContexts #-}

3−{-# language FlexibleInstances #-}

4−{-# language GADTs #-}

5−{-# language LambdaCase #-}

6−{-# language StandaloneKindSignatures #-}

7−{-# language TypeOperators #-}

8−

9−module Rel8.Kind.Labels

10− ( Labels

11− , SLabels( SNil, SCons )

12− , KnownLabels( labelsSing )

13− , renderLabels

14− )

15−where

16−

17−-- base

18−import Data.Kind ( Constraint, Type )

19−import Data.List.NonEmpty ( NonEmpty, nonEmpty )

20−import Data.Maybe ( fromMaybe )

21−import Data.Proxy ( Proxy( Proxy ) )

22−import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )

23−import Prelude

24−

25−

26−type Labels :: Type

27−type Labels = [Symbol]

28−

29−

30−type SLabels :: Labels -> Type

31−data SLabels labels where

32− SNil :: SLabels '[]

33− SCons :: KnownSymbol label => Proxy label -> SLabels labels -> SLabels (label ': labels)

34−

35−

36−type KnownLabels :: Labels -> Constraint

37−class KnownLabels labels where

38− labelsSing :: SLabels labels

39−

40−

41−instance KnownLabels '[] where

42− labelsSing = SNil

43−

44−

45−instance (KnownSymbol label, KnownLabels labels) =>

46− KnownLabels (label ': labels)

47− where

48− labelsSing = SCons Proxy labelsSing

49−

50−

51−renderLabels :: SLabels labels -> NonEmpty String

52−renderLabels = fromMaybe (pure "anon") . nonEmpty . go

53− where

54− go :: SLabels labels -> [String]

55− go = \case

56− SNil -> []

57− SCons label labels -> symbolVal label : go labels

src/Rel8/Schema/Context/Label.hsdeleted−62

@@ -1,62 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language FlexibleInstances #-}

3−{-# language StandaloneKindSignatures #-}

4−{-# language TypeFamilies #-}

5−{-# language TypeOperators #-}

6−

7−module Rel8.Schema.Context.Label

8− ( Labelable( labeler, unlabeler )

9− , HLabelable( hlabeler, hunlabeler )

10− )

11−where

12−

13−-- base

14−import Data.Kind ( Constraint )

15−import Prelude hiding ( null )

16−

17−-- rel8

18−import Rel8.Schema.Context ( Interpretation )

19−import Rel8.Schema.Dict ( Dict( Dict ) )

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

21−import Rel8.Schema.Spec ( Spec( Spec ) )

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

23−import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

24−

25−

26−-- | The @Labelable@ class is an internal implementation detail of Rel8, and

27−-- indicates that we can successfully "name" all columns in a type.

28−type Labelable :: Context -> Constraint

29−class Interpretation context => Labelable context where

30− labeler :: ()

31− => Col context ('Spec labels a)

32− -> Col context ('Spec (label ': labels) a)

33−

34− unlabeler :: ()

35− => Col context ('Spec (label ': labels) a)

36− -> Col context ('Spec labels a)

37−

38−

39−instance Labelable Result where

40− labeler (R a) = R a

41− unlabeler (R a) = R a

42−

43−

44−type HLabelable :: HContext -> Constraint

45−class HLabelable context where

46− hlabeler :: ()

47− => context ('Spec labels a)

48− -> context ('Spec (label ': labels) a)

49−

50− hunlabeler :: ()

51− => context ('Spec (label ': labels) a)

52− -> context ('Spec labels a)

53−

54−

55−instance Labelable context => HLabelable (Col context) where

56− hlabeler = labeler

57− hunlabeler = unlabeler

58−

59−

60−instance HLabelable (Dict (ConstrainDBType constraint)) where

61− hlabeler Dict = Dict

62− hunlabeler Dict = Dict

src/Rel8/Schema/Context/Nullify.hs+16−17

@@ -51,31 +51,30 @@ class Interpretation context => Nullifiable context where

51

52 encodeTag ::

53 ( Sql (ConstrainTag context) a

54− , KnownSymbol label

55 , Taggable a

54 , Taggable a

56 )

55 )

57 => Tag label a

56 => Tag label a

58− -> Col context ('Spec labels a)

57+ -> Col context ('Spec a)

59

58

60 decodeTag ::

59 decodeTag ::

61 ( Sql (ConstrainTag context) a

60 ( Sql (ConstrainTag context) a

62 , KnownSymbol label

61 , KnownSymbol label

63 , Taggable a

62 , Taggable a

64 )

63 )

65− => Col context ('Spec labels a)

64+ => Col context ('Spec a)

66 -> Tag label a

65 -> Tag label a

67

66

68 nullifier :: ()

67 nullifier :: ()

69 => Tag label a

68 => Tag label a

70 -> (Expr a -> Expr Bool)

69 -> (Expr a -> Expr Bool)

71− -> SSpec ('Spec labels x)

70+ -> SSpec ('Spec x)

72− -> Col context ('Spec labels x)

71+ -> Col context ('Spec x)

73− -> Col context ('Spec labels (Nullify x))

72+ -> Col context ('Spec (Nullify x))

74

73

75 unnullifier :: ()

74 unnullifier :: ()

76− => SSpec ('Spec labels x)

75+ => SSpec ('Spec x)

77− -> Col context ('Spec labels (Nullify x))

76+ -> Col context ('Spec (Nullify x))

78− -> Col context ('Spec labels x)

77+ -> Col context ('Spec x)

79

78

80

79

81instance Nullifiable Aggregate where

80instance Nullifiable Aggregate where

@@ -147,23 +146,23 @@ class HNullifiable context where

147

146

148 hencodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)

147 hencodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)

149 => Tag label a

148 => Tag label a

150− -> context ('Spec labels a)

149+ -> context ('Spec a)

151

150

152 hdecodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)

151 hdecodeTag :: (Sql (HConstrainTag context) a, KnownSymbol label, Taggable a)

153− => context ('Spec labels a)

152+ => context ('Spec a)

154 -> Tag label a

153 -> Tag label a

155

154

156 hnullifier :: ()

155 hnullifier :: ()

157 => Tag label a

156 => Tag label a

158 -> (Expr a -> Expr Bool)

157 -> (Expr a -> Expr Bool)

159− -> SSpec ('Spec labels x)

158+ -> SSpec ('Spec x)

160− -> context ('Spec labels x)

159+ -> context ('Spec x)

161− -> context ('Spec labels (Nullify x))

160+ -> context ('Spec (Nullify x))

162

161

163 hunnullifier :: ()

162 hunnullifier :: ()

164− => SSpec ('Spec labels x)

163+ => SSpec ('Spec x)

165− -> context ('Spec labels (Nullify x))

164+ -> context ('Spec (Nullify x))

166− -> context ('Spec labels x)

165+ -> context ('Spec x)

167

166

168

167

169instance Nullifiable context => HNullifiable (Col context) where

168instance Nullifiable context => HNullifiable (Col context) where

src/Rel8/Schema/HTable/Either.hs+2−3

@@ -15,17 +15,16 @@ import Prelude ()

15

16-- rel8

17import Rel8.Schema.HTable ( HTable )

18−import Rel8.Schema.HTable.Identity ( HIdentity(..) )

18+import Rel8.Schema.HTable.Identity ( HType )

19import Rel8.Schema.HTable.Label ( HLabel )

20import Rel8.Schema.HTable.Nullify ( HNullify )

21import qualified Rel8.Schema.Kind as K

22−import Rel8.Schema.Spec ( Spec( Spec ) )

23import Rel8.Type.Tag ( EitherTag )

22import Rel8.Type.Tag ( EitherTag )

24

23

25

24

26type HEitherTable :: K.HTable -> K.HTable -> K.HTable

25type HEitherTable :: K.HTable -> K.HTable -> K.HTable

27data HEitherTable left right context = HEitherTable

26data HEitherTable left right context = HEitherTable

28− { htag :: HIdentity ('Spec '["isRight"] EitherTag) context

27+ { htag :: HLabel "isRight" (HType EitherTag) context

29 , hleft :: HLabel "Left" (HNullify left) context

28 , hleft :: HLabel "Left" (HNullify left) context

30 , hright :: HLabel "Right" (HNullify right) context

29 , hright :: HLabel "Right" (HNullify right) context

31 }

30 }

src/Rel8/Schema/HTable/Identity.hs+2−2

@@ -25,10 +25,10 @@ import Rel8.Schema.Spec ( Spec( Spec ), KnownSpec, specSing )

25

26

27type HType :: Type -> K.HTable

28−type HType a = HIdentity ('Spec '[] a)

28+type HType a = HIdentity ('Spec a)

29

30

31−pattern HType :: context ('Spec '[] a) -> HType a context

31+pattern HType :: context ('Spec a) -> HType a context

32pattern HType a = HIdentity a

33{-# COMPLETE HType #-}

34

src/Rel8/Schema/HTable/Label.hs+27−52

@@ -1,83 +1,58 @@

1−{-# LANGUAGE DeriveAnyClass #-}

2−{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE DerivingStrategies #-}

4−{-# LANGUAGE LambdaCase #-}

5−{-# language ConstraintKinds #-}

6{-# language DataKinds #-}

1{-# language DataKinds #-}

7−{-# language FlexibleInstances #-}

8−{-# language GADTs #-}

9−{-# language MultiParamTypeClasses #-}

10−{-# language QuantifiedConstraints #-}

11−{-# language RankNTypes #-}

12{-# language RecordWildCards #-}

2{-# language RecordWildCards #-}

13{-# language ScopedTypeVariables #-}

3{-# language ScopedTypeVariables #-}

14{-# language StandaloneKindSignatures #-}

4{-# language StandaloneKindSignatures #-}

5+{-# language TypeApplications #-}

15{-# language TypeFamilies #-}

6{-# language TypeFamilies #-}

16−{-# language TypeOperators #-}

17−{-# language UndecidableInstances #-}

18

7

19module Rel8.Schema.HTable.Label

8module Rel8.Schema.HTable.Label

20− ( HLabel, Label

21− , hlabel, hunlabel

9+ ( HLabel, hlabel, hrelabel, hunlabel

22 )

10 )

23where

11where

24

12

25-- base

13-- base

14+import Data.Kind ( Type )

26import Data.Proxy ( Proxy( Proxy ) )

15import Data.Proxy ( Proxy( Proxy ) )

27−import GHC.TypeLits ( KnownSymbol, Symbol )

16+import GHC.TypeLits ( KnownSymbol, Symbol, symbolVal )

28import Prelude

17import Prelude

29

18

30-- rel8

19-- rel8

31−import Rel8.Kind.Labels ( SLabels( SCons ) )

32import Rel8.Schema.HTable

20import Rel8.Schema.HTable

33− ( HTable

34− , hfield, htabulate, hspecs

35− )

36import qualified Rel8.Schema.Kind as K

21import qualified Rel8.Schema.Kind as K

37−import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

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

38−import Rel8.FCF

39−import Rel8.Schema.HTable.MapTable

40−import GHC.Generics (Generic)

41

23

42

24

43type HLabel :: Symbol -> K.HTable -> K.HTable

25type HLabel :: Symbol -> K.HTable -> K.HTable

44−newtype HLabel label table context = HLabel (HMapTable (Label label) table context)

26+newtype HLabel label table context = HLabel (table context)

45− deriving stock Generic

46− deriving anyclass HTable

47−

48

27

49−data Label :: Symbol -> Spec -> Exp Spec

50

28

29+type HLabelField :: Symbol -> K.HTable -> Spec -> Type

30+newtype HLabelField label table spec = HLabelField (HField table spec)

51

31

52−type instance Eval (Label label ('Spec labels a)) = 'Spec (label : labels) a

53

32

33+instance (HTable table, KnownSymbol label) => HTable (HLabel label table) where

34+ type HField (HLabel label table) = HLabelField label table

35+ type HConstrainTable (HLabel label table) constraint =

36+ HConstrainTable table constraint

54

37

55−instance KnownSymbol l => MapSpec (Label l) where

38+ hfield (HLabel a) (HLabelField field) = hfield a field

56− mapInfo = \case

39+ htabulate f = HLabel (htabulate (f . HLabelField))

40+ htraverse f (HLabel a) = HLabel <$> htraverse f a

41+ hdicts = HLabel (hdicts @table)

42+ hspecs = HLabel $ htabulate $ \field -> case hfield (hspecs @table) field of

57− SSpec {..} -> SSpec {labels = SCons Proxy labels, ..}

43+ SSpec {..} -> SSpec {labels = symbolVal (Proxy @label) : labels, ..}

58

44

59

45

60−hlabel :: (HTable t, KnownSymbol label)

61− => (forall labels a. ()

62− => context ('Spec labels a)

63− -> context ('Spec (label ': labels) a))

64− -> t context

65− -> HLabel label t context

46+hlabel :: forall label t context. t context -> HLabel label t context

66−hlabel labeler a = HLabel $ htabulate $ \(HMapTableField field) ->

47+hlabel = HLabel

67− case hfield hspecs field of

68− SSpec {} -> labeler (hfield a field)

69{-# INLINABLE hlabel #-}

48{-# INLINABLE hlabel #-}

70

49

71

50

72−hunlabel :: (HTable t, KnownSymbol label)

51+hrelabel :: forall label' label t context. HLabel label t context -> HLabel label' t context

73− => (forall labels a. ()

52+hrelabel = hlabel . hunlabel

74− => context ('Spec (label ': labels) a)

53+{-# INLINABLE hrelabel #-}

75− -> context ('Spec labels a))

54+

76− -> HLabel label t context

55+

77− -> t context

56+hunlabel :: forall label t context. HLabel label t context -> t context

78−hunlabel unlabler (HLabel as) =

57+hunlabel (HLabel a) = a

79− htabulate $ \field ->

80− case hfield hspecs field of

81− SSpec {} -> case hfield as (HMapTableField field) of

82− a -> unlabler a

83{-# INLINABLE hunlabel #-}

58{-# INLINABLE hunlabel #-}

src/Rel8/Schema/HTable/Maybe.hs+2−3

@@ -15,17 +15,16 @@ import Prelude

15

16-- rel8

17import Rel8.Schema.HTable ( HTable )

18−import Rel8.Schema.HTable.Identity ( HIdentity(..) )

18+import Rel8.Schema.HTable.Identity ( HType )

19import Rel8.Schema.HTable.Label ( HLabel )

20import Rel8.Schema.HTable.Nullify ( HNullify )

21import qualified Rel8.Schema.Kind as K

22−import Rel8.Schema.Spec ( Spec( Spec ) )

23import Rel8.Type.Tag ( MaybeTag )

22import Rel8.Type.Tag ( MaybeTag )

24

23

25

24

26type HMaybeTable :: K.HTable -> K.HTable

25type HMaybeTable :: K.HTable -> K.HTable

27data HMaybeTable table context = HMaybeTable

26data HMaybeTable table context = HMaybeTable

28− { htag :: HIdentity ('Spec '["isJust"] (Maybe MaybeTag)) context

27+ { htag :: HLabel "isJust" (HType (Maybe MaybeTag)) context

29 , hjust :: HLabel "Just" (HNullify table) context

28 , hjust :: HLabel "Just" (HNullify table) context

30 }

29 }

31 deriving stock Generic

30 deriving stock Generic

src/Rel8/Schema/HTable/Nullify.hs+17−17

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

10{-# language NamedFieldPuns #-}

11{-# language QuantifiedConstraints #-}

12{-# language RankNTypes #-}

13+{-# language RecordWildCards #-}

13{-# language ScopedTypeVariables #-}

14{-# language ScopedTypeVariables #-}

14{-# language StandaloneKindSignatures #-}

15{-# language StandaloneKindSignatures #-}

15{-# language TypeFamilies #-}

16{-# language TypeFamilies #-}

@@ -50,25 +51,24 @@ newtype HNullify table context = HNullify (HMapTable Nullify table context)

50data Nullify :: Spec -> Exp Spec

51data Nullify :: Spec -> Exp Spec

51

52

53

53−type instance Eval (Nullify ('Spec labels a)) =

54+type instance Eval (Nullify ('Spec a)) =

54− 'Spec labels (Type.Nullify a)

55+ 'Spec (Type.Nullify a)

55

56

57

57instance MapSpec Nullify where

58instance MapSpec Nullify where

58 mapInfo = \case

59 mapInfo = \case

59− SSpec{labels, info, nullity} -> SSpec

60+ SSpec {nullity, ..} -> SSpec

60− { labels

61− , info

62− , nullity = case nullity of

61+ { nullity = case nullity of

63 Null -> Null

62 Null -> Null

64 NotNull -> Null

63 NotNull -> Null

64+ , ..

65 }

66

67

68hnulls :: HTable t

69− => (forall labels a. ()

69+ => (forall a. ()

70− => SSpec ('Spec labels a)

70+ => SSpec ('Spec a)

71− -> context ('Spec labels (Type.Nullify a)))

71+ -> context ('Spec (Type.Nullify a)))

72 -> HNullify t context

73hnulls null = HNullify $ htabulate $ \(HMapTableField field) -> case hfield hspecs field of

74 spec@SSpec {} -> null spec

@@ -76,10 +76,10 @@ hnulls null = HNullify $ htabulate $ \(HMapTableField field) -> case hfield hspe

76

77

78hnullify :: HTable t

79− => (forall labels a. ()

79+ => (forall a. ()

80− => SSpec ('Spec labels a)

80+ => SSpec ('Spec a)

81− -> context ('Spec labels a)

81+ -> context ('Spec a)

82− -> context ('Spec labels (Type.Nullify a)))

82+ -> context ('Spec (Type.Nullify a)))

83 -> t context

84 -> HNullify t context

85hnullify nullifier a = HNullify $ htabulate $ \(HMapTableField field) ->

@@ -89,10 +89,10 @@ hnullify nullifier a = HNullify $ htabulate $ \(HMapTableField field) ->

89

90

91hunnullify :: (HTable t, Apply m)

92− => (forall labels a. ()

92+ => (forall a. ()

93− => SSpec ('Spec labels a)

93+ => SSpec ('Spec a)

94− -> context ('Spec labels (Type.Nullify a))

94+ -> context ('Spec (Type.Nullify a))

95− -> m (context ('Spec labels a)))

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

96 -> HNullify t context

97 -> m (t context)

98hunnullify unnullifier (HNullify as) =

src/Rel8/Schema/HTable/These.hs+3−4

@@ -15,19 +15,18 @@ import Prelude

15

16-- rel8

17import Rel8.Schema.HTable ( HTable )

18−import Rel8.Schema.HTable.Identity ( HIdentity )

18+import Rel8.Schema.HTable.Identity ( HType )

19import Rel8.Schema.HTable.Label ( HLabel )

20import Rel8.Schema.HTable.Nullify ( HNullify )

21import qualified Rel8.Schema.Kind as K

22−import Rel8.Schema.Spec ( Spec( Spec ) )

23import Rel8.Type.Tag ( MaybeTag )

22import Rel8.Type.Tag ( MaybeTag )

24

23

25

24

26type HTheseTable :: K.HTable -> K.HTable -> K.HTable

25type HTheseTable :: K.HTable -> K.HTable -> K.HTable

27data HTheseTable here there context = HTheseTable

26data HTheseTable here there context = HTheseTable

28− { hhereTag :: HIdentity ('Spec '["hasHere"] (Maybe MaybeTag)) context

27+ { hhereTag :: HLabel "hereTag" (HType (Maybe MaybeTag)) context

29 , hhere :: HLabel "Here" (HNullify here) context

28 , hhere :: HLabel "Here" (HNullify here) context

30− , hthereTag :: HIdentity ('Spec '["hasThere"] (Maybe MaybeTag)) context

29+ , hthereTag :: HLabel "thereTag" (HType (Maybe MaybeTag)) context

31 , hthere :: HLabel "There" (HNullify there) context

30 , hthere :: HLabel "There" (HNullify there) context

32 }

31 }

33 deriving stock Generic

32 deriving stock Generic

src/Rel8/Schema/HTable/Vectorize.hs+15−21

@@ -32,7 +32,6 @@ import Data.List.NonEmpty ( NonEmpty )

32import Prelude

33

34-- rel8

35−import Rel8.Schema.Context.Label ( HLabelable, hlabeler, hunlabeler )

36import Rel8.Schema.Dict ( Dict( Dict ) )

35import Rel8.Schema.Dict ( Dict( Dict ) )

37import qualified Rel8.Schema.Kind as K

36import qualified Rel8.Schema.Kind as K

38import Rel8.Schema.HTable

37import Rel8.Schema.HTable

@@ -78,7 +77,7 @@ newtype HVectorize list table context = HVectorize (HMapTable (Vectorize list) t

78data Vectorize :: (Type -> Type) -> Spec -> Exp Spec

77data Vectorize :: (Type -> Type) -> Spec -> Exp Spec

79

78

80

79

81−type instance Eval (Vectorize list ('Spec labels a)) = 'Spec labels (list a)

80+type instance Eval (Vectorize list ('Spec a)) = 'Spec (list a)

82

81

83

82

84instance Vector list => MapSpec (Vectorize list) where

83instance Vector list => MapSpec (Vectorize list) where

@@ -92,10 +91,10 @@ instance Vector list => MapSpec (Vectorize list) where

92

91

93

92

94hvectorize :: (HTable t, Unzip f, Vector list)

93hvectorize :: (HTable t, Unzip f, Vector list)

95− => (forall labels a. ()

94+ => (forall a. ()

96− => SSpec ('Spec labels a)

95+ => SSpec ('Spec a)

97− -> f (context ('Spec labels a))

96+ -> f (context ('Spec a))

98− -> context' ('Spec labels (list a)))

97+ -> context' ('Spec (list a)))

99 -> f (t context)

98 -> f (t context)

100 -> HVectorize list t context'

99 -> HVectorize list t context'

101hvectorize vectorizer as = HVectorize $ htabulate $ \(HMapTableField field) ->

100hvectorize vectorizer as = HVectorize $ htabulate $ \(HMapTableField field) ->

@@ -105,10 +104,10 @@ hvectorize vectorizer as = HVectorize $ htabulate $ \(HMapTableField field) ->

105

104

106

105

107hunvectorize :: (HTable t, Zip f, Vector list)

106hunvectorize :: (HTable t, Zip f, Vector list)

108− => (forall labels a. ()

107+ => (forall a. ()

109− => SSpec ('Spec labels a)

108+ => SSpec ('Spec a)

110− -> context ('Spec labels (list a))

109+ -> context ('Spec (list a))

111− -> f (context' ('Spec labels a)))

110+ -> f (context' ('Spec a)))

112 -> HVectorize list t context

111 -> HVectorize list t context

113 -> f (t context')

112 -> f (t context')

114hunvectorize unvectorizer (HVectorize table) =

113hunvectorize unvectorizer (HVectorize table) =

@@ -119,12 +118,12 @@ hunvectorize unvectorizer (HVectorize table) =

119

118

120

119

121happend :: (HTable t, Vector list) =>

120happend :: (HTable t, Vector list) =>

122− ( forall labels a. ()

121+ ( forall a. ()

123 => Nullity a

122 => Nullity a

124 -> TypeInformation (Unnullify a)

123 -> TypeInformation (Unnullify a)

125− -> context ('Spec labels (list a))

124+ -> context ('Spec (list a))

126− -> context ('Spec labels (list a))

125+ -> context ('Spec (list a))

127− -> context ('Spec labels (list a))

126+ -> context ('Spec (list a))

128 )

127 )

129 -> HVectorize list t context

128 -> HVectorize list t context

130 -> HVectorize list t context

129 -> HVectorize list t context

@@ -136,16 +135,11 @@ happend append (HVectorize as) (HVectorize bs) = HVectorize $

136

135

137

136

138hempty :: HTable t =>

137hempty :: HTable t =>

139− ( forall labels a. ()

138+ ( forall a. ()

140 => Nullity a

139 => Nullity a

141 -> TypeInformation (Unnullify a)

140 -> TypeInformation (Unnullify a)

142− -> context ('Spec labels [a])

141+ -> context ('Spec [a])

143 )

142 )

144 -> HVectorize [] t context

143 -> HVectorize [] t context

145hempty empty = HVectorize $ htabulate $ \(HMapTableField field) -> case hfield hspecs field of

144hempty empty = HVectorize $ htabulate $ \(HMapTableField field) -> case hfield hspecs field of

146 SSpec {nullity, info} -> empty nullity info

145 SSpec {nullity, info} -> empty nullity info

147−

148−

149−instance HLabelable g => HLabelable (Precompose (Vectorize list) g) where

150− hlabeler = Precompose . hlabeler . precomposed

151− hunlabeler = Precompose . hunlabeler . precomposed

src/Rel8/Schema/Name.hs+1−7

@@ -28,7 +28,6 @@ import Prelude

28-- rel8

29import Rel8.Expr ( Expr )

30import Rel8.Schema.Context ( Interpretation, Col )

31−import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )

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

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

33import Rel8.Schema.Null ( Sql )

32import Rel8.Schema.Null ( Sql )

34import Rel8.Schema.Reify ( notReify )

33import Rel8.Schema.Reify ( notReify )

@@ -84,12 +83,7 @@ instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)

84

83

85instance Interpretation Name where

84instance Interpretation Name where

86 data Col Name _spec where

85 data Col Name _spec where

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

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

88−

89−

90−instance Labelable Name where

91− labeler (N a) = N a

92− unlabeler (N a) = N a

93

87

94

88

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

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

src/Rel8/Schema/Reify.hs−6

@@ -23,7 +23,6 @@ import Prelude

23

24-- rel8

25import Rel8.Schema.Context ( Interpretation, Col )

26−import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )

27import Rel8.Schema.HTable ( HTable, hmap )

26import Rel8.Schema.HTable ( HTable, hmap )

28import Rel8.Schema.Kind ( Context )

27import Rel8.Schema.Kind ( Context )

29

28

@@ -36,11 +35,6 @@ instance Interpretation (Reify context) where

36 newtype Col (Reify context) spec = Reify (Col context spec)

35 newtype Col (Reify context) spec = Reify (Col context spec)

37

36

38

37

39−instance Labelable context => Labelable (Reify context) where

40− labeler (Reify a) = Reify (labeler a)

41− unlabeler (Reify a) = Reify (unlabeler a)

42−

43−

44hreify :: HTable t => t (Col context) -> t (Col (Reify context))

38hreify :: HTable t => t (Col context) -> t (Col (Reify context))

45hreify = hmap Reify

39hreify = hmap Reify

46

40

src/Rel8/Schema/Result.hs+14−22

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

6

7module Rel8.Schema.Result

8 ( Col( R, unR ), Result

9− , relabel

10 , null, nullifier, unnullifier

9 , null, nullifier, unnullifier

11 , vectorizer, unvectorizer

10 , vectorizer, unvectorizer

12 )

11 )

@@ -17,7 +16,6 @@ import Prelude hiding ( null )

17

16

18-- rel8

17-- rel8

19import Rel8.Schema.Context ( Interpretation( Col ) )

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

20−import Rel8.Schema.HTable.Identity ( HIdentity(..) )

21import Rel8.Schema.Kind ( Context )

19import Rel8.Schema.Kind ( Context )

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

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

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

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

@@ -33,32 +31,26 @@ data Result a

33

31

34instance Interpretation Result where

32instance Interpretation Result where

35 data Col Result _spec where

33 data Col Result _spec where

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

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

37

35

38

36

39−relabel :: ()

40− => HIdentity ('Spec labels a) (Col Result)

41− -> HIdentity ('Spec relabels a) (Col Result)

42−relabel (HIdentity (R a)) = HIdentity (R a)

43−

44−

45−null :: Col Result ('Spec labels (Maybe a))

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

46null = R Nothing

38null = R Nothing

47

39

48

40

49nullifier :: ()

41nullifier :: ()

50− => SSpec ('Spec labels a)

42+ => SSpec ('Spec a)

51− -> Col Result ('Spec labels a)

43+ -> Col Result ('Spec a)

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

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

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

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

54 Null -> a

46 Null -> a

55 NotNull -> Just a

47 NotNull -> Just a

56

48

57

49

58unnullifier :: ()

50unnullifier :: ()

59− => SSpec ('Spec labels a)

51+ => SSpec ('Spec a)

60− -> Col Result ('Spec labels (Nullify a))

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

61− -> Maybe (Col Result ('Spec labels a))

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

62unnullifier SSpec {nullity} (R a) =

54unnullifier SSpec {nullity} (R a) =

63 case nullity of

55 case nullity of

64 Null -> pure $ R a

56 Null -> pure $ R a

@@ -66,14 +58,14 @@ unnullifier SSpec {nullity} (R a) =

66

58

67

59

68vectorizer :: Functor f

60vectorizer :: Functor f

69− => SSpec ('Spec labels a)

61+ => SSpec ('Spec a)

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

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

71− -> Col Result ('Spec labels (f a))

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

72vectorizer _ = R . fmap unR

64vectorizer _ = R . fmap unR

73

65

74

66

75unvectorizer :: Functor f

67unvectorizer :: Functor f

76− => SSpec ('Spec labels a)

68+ => SSpec ('Spec a)

77− -> Col Result ('Spec labels (f a))

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

78− -> f (Col Result ('Spec labels a))

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

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

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

src/Rel8/Schema/Spec.hs+6−12

@@ -13,27 +13,26 @@ where

13

14-- base

15import Data.Kind ( Constraint, Type )

16−import Prelude ()

16+import Prelude

17

18-- rel8

19−import Rel8.Kind.Labels ( Labels, SLabels, KnownLabels, labelsSing )

20import Rel8.Schema.Null ( Nullity, Sql, Unnullify, nullable )

19import Rel8.Schema.Null ( Nullity, Sql, Unnullify, nullable )

21import Rel8.Type ( DBType, typeInformation )

20import Rel8.Type ( DBType, typeInformation )

22import Rel8.Type.Information ( TypeInformation )

21import Rel8.Type.Information ( TypeInformation )

23

22

24

23

25type Spec :: Type

24type Spec :: Type

26−data Spec = Spec Labels Type

25+newtype Spec = Spec Type

27

26

28

27

29type SSpec :: Spec -> Type

28type SSpec :: Spec -> Type

30data SSpec spec where

29data SSpec spec where

31 SSpec ::

30 SSpec ::

32− { labels :: SLabels labels

31+ { labels :: [String]

33 , info :: TypeInformation (Unnullify a)

32 , info :: TypeInformation (Unnullify a)

34 , nullity :: Nullity a

33 , nullity :: Nullity a

35 }

34 }

36− -> SSpec ('Spec labels a)

35+ -> SSpec ('Spec a)

37

36

38

37

39type KnownSpec :: Spec -> Constraint

38type KnownSpec :: Spec -> Constraint

@@ -41,14 +40,9 @@ class KnownSpec spec where

41 specSing :: SSpec spec

40 specSing :: SSpec spec

42

41

43

42

44−instance

45− ( KnownLabels labels

46− , Sql DBType a

47− )

48− => KnownSpec ('Spec labels a)

43+instance Sql DBType a => KnownSpec ('Spec a) where

49− where

50 specSing = SSpec

44 specSing = SSpec

51− { labels = labelsSing

45+ { labels = []

52 , info = typeInformation

46 , info = typeInformation

53 , nullity = nullable

47 , nullity = nullable

54 }

48 }

src/Rel8/Schema/Spec/ConstrainDBType.hs+14−14

@@ -31,47 +31,47 @@ import Rel8.Schema.Spec ( Spec( Spec ), SSpec( SSpec, nullity ) )

31

32type ConstrainDBType :: (Type -> Constraint) -> Spec -> Constraint

33class

34− ( forall c labels a. ()

34+ ( forall c a. ()

35− => (spec ~ 'Spec labels a)

35+ => (spec ~ 'Spec a)

36 => (forall x. (constraint x => c x)) => Sql c a

37 )

38 => ConstrainDBType constraint spec

39instance

40− ( spec ~ 'Spec labels a

40+ ( spec ~ 'Spec a

41 , Sql constraint a

42 )

43 => ConstrainDBType constraint spec

44

45

46−dbTypeNullity :: Dict (ConstrainDBType c) ('Spec l a) -> Nullity a

46+dbTypeNullity :: Dict (ConstrainDBType c) ('Spec a) -> Nullity a

47dbTypeNullity = step2 . step1

48 where

49− step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a

49+ step1 :: Dict (ConstrainDBType c) ('Spec a) -> Dict (Sql c) a

50 step1 Dict = Dict

51

52 step2 :: Dict (Sql c) a -> Nullity a

53 step2 Dict = nullable

54

55

56−dbTypeDict :: Dict (ConstrainDBType c) ('Spec l a) -> Dict c (Unnullify a)

56+dbTypeDict :: Dict (ConstrainDBType c) ('Spec a) -> Dict c (Unnullify a)

57dbTypeDict = step2 . step1

58 where

59− step1 :: Dict (ConstrainDBType c) ('Spec l a) -> Dict (Sql c) a

59+ step1 :: Dict (ConstrainDBType c) ('Spec a) -> Dict (Sql c) a

60 step1 Dict = Dict

61

62 step2 :: Dict (Sql c) a -> Dict c (Unnullify a)

63 step2 Dict = Dict

64

65

66−fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec l a)

66+fromNullityDict :: Nullity a -> Dict c (Unnullify a) -> Dict (ConstrainDBType c) ('Spec a)

67fromNullityDict Null Dict = Dict

68fromNullityDict NotNull Dict = Dict

69

70

71nullifier :: ()

72− => SSpec ('Spec labels a)

72+ => SSpec ('Spec a)

73− -> Dict (ConstrainDBType c) ('Spec labels a)

73+ -> Dict (ConstrainDBType c) ('Spec a)

74− -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))

74+ -> Dict (ConstrainDBType c) ('Spec (Nullify a))

75nullifier SSpec {} dict = case dbTypeDict dict of

76 Dict -> case dbTypeNullity dict of

77 Null -> Dict

@@ -79,9 +79,9 @@ nullifier SSpec {} dict = case dbTypeDict dict of

79

80

81unnullifier :: ()

82− => SSpec ('Spec labels a)

82+ => SSpec ('Spec a)

83− -> Dict (ConstrainDBType c) ('Spec labels (Nullify a))

83+ -> Dict (ConstrainDBType c) ('Spec (Nullify a))

84− -> Dict (ConstrainDBType c) ('Spec labels a)

84+ -> Dict (ConstrainDBType c) ('Spec a)

85unnullifier SSpec {nullity} dict = case dbTypeDict dict of

86 Dict -> case nullity of

87 Null -> Dict

src/Rel8/Table.hs+27−34

@@ -41,11 +41,10 @@ import Rel8.Generic.Table

41 )

42import Rel8.Generic.Record ( Record(..) )

43import Rel8.Generic.Reify ( ARep )

44−import Rel8.Schema.Context.Label ( Labelable, labeler, unlabeler )

45import Rel8.Schema.HTable ( HTable )

44import Rel8.Schema.HTable ( HTable )

46import Rel8.Schema.HTable.Either ( HEitherTable(..) )

45import Rel8.Schema.HTable.Either ( HEitherTable(..) )

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

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

48−import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

47+import Rel8.Schema.HTable.Label ( hlabel, hrelabel, hunlabel )

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

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

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

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

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

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

@@ -61,7 +60,6 @@ import Rel8.Schema.Reify

61 )

60 )

62import Rel8.Schema.Result

61import Rel8.Schema.Result

63 ( Col( R ), Result

62 ( Col( R ), Result

64− , relabel

65 , null, nullifier, unnullifier

63 , null, nullifier, unnullifier

66 , vectorizer, unvectorizer

64 , vectorizer, unvectorizer

67 )

65 )

@@ -247,20 +245,20 @@ instance (Table Result a, Table Result b) => Table Result (Either a b) where

247

245

248 toColumns = \case

246 toColumns = \case

249 Left table -> HEitherTable

247 Left table -> HEitherTable

250− { htag = HIdentity (R IsLeft)

248+ { htag = hlabel (HType (R IsLeft))

251− , hleft = hlabel labeler (hnullify nullifier (toColumns table))

249+ , hleft = hlabel (hnullify nullifier (toColumns table))

252− , hright = hlabel labeler (hnulls (const null))

250+ , hright = hlabel (hnulls (const null))

253 }

251 }

254 Right table -> HEitherTable

252 Right table -> HEitherTable

255− { htag = HIdentity (R IsRight)

253+ { htag = hlabel (HType (R IsRight))

256− , hleft = hlabel labeler (hnulls (const null))

254+ , hleft = hlabel (hnulls (const null))

257− , hright = hlabel labeler (hnullify nullifier (toColumns table))

255+ , hright = hlabel (hnullify nullifier (toColumns table))

258 }

256 }

259

257

260− fromColumns HEitherTable {htag, hleft, hright} = case htag of

258+ fromColumns HEitherTable {htag, hleft, hright} = case hunlabel htag of

261− HIdentity (R tag) -> case tag of

259+ HType (R tag) -> case tag of

262− IsLeft -> maybe err (Left . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hleft)

260+ IsLeft -> maybe err (Left . fromColumns) $ hunnullify unnullifier (hunlabel hleft)

263− IsRight -> maybe err (Right . fromColumns) $ hunnullify unnullifier (hunlabel unlabeler hright)

261+ IsRight -> maybe err (Right . fromColumns) $ hunnullify unnullifier (hunlabel hright)

264 where

262 where

265 err = error "Either.fromColumns: mismatch between tag and data"

263 err = error "Either.fromColumns: mismatch between tag and data"

266

264

@@ -279,17 +277,17 @@ instance Table Result a => Table Result (Maybe a) where

279

277

280 toColumns = \case

278 toColumns = \case

281 Nothing -> HMaybeTable

279 Nothing -> HMaybeTable

282− { htag = HIdentity (R Nothing)

280+ { htag = hlabel (HIdentity (R Nothing))

283− , hjust = hlabel labeler (hnulls (const null))

281+ , hjust = hlabel (hnulls (const null))

284 }

282 }

285 Just table -> HMaybeTable

283 Just table -> HMaybeTable

286− { htag = HIdentity (R (Just IsJust))

284+ { htag = hlabel (HIdentity (R (Just IsJust)))

287− , hjust = hlabel labeler (hnullify nullifier (toColumns table))

285+ , hjust = hlabel (hnullify nullifier (toColumns table))

288 }

286 }

289

287

290− fromColumns HMaybeTable {htag, hjust} = case htag of

288+ fromColumns HMaybeTable {htag, hjust} = case hunlabel htag of

291− HIdentity (R tag) -> tag $>

289+ HType (R tag) -> tag $>

292− case hunnullify unnullifier (hunlabel unlabeler hjust) of

290+ case hunnullify unnullifier (hunlabel hjust) of

293 Nothing -> error "Maybe.fromColumns: mismatch between tag and data"

291 Nothing -> error "Maybe.fromColumns: mismatch between tag and data"

294 Just just -> fromColumns just

292 Just just -> fromColumns just

295

293

@@ -307,10 +305,10 @@ instance (Table Result a, Table Result b) => Table Result (These a b) where

307 type Context (These a b) = Result

305 type Context (These a b) = Result

308

306

309 toColumns tables = HTheseTable

307 toColumns tables = HTheseTable

310− { hhereTag = relabel hhereTag

308+ { hhereTag = hrelabel hhereTag

311− , hhere = hlabel labeler (hunlabel unlabeler (toColumns hhere))

309+ , hhere = hrelabel (toColumns hhere)

312− , hthereTag = relabel hthereTag

310+ , hthereTag = hrelabel hthereTag

313− , hthere = hlabel labeler (hunlabel unlabeler (toColumns hthere))

311+ , hthere = hrelabel (toColumns hthere)

314 }

312 }

315 where

313 where

316 HMaybeTable

314 HMaybeTable

@@ -330,29 +328,27 @@ instance (Table Result a, Table Result b) => Table Result (These a b) where

330 _ -> error "These.fromColumns: mismatch between tags and data"

328 _ -> error "These.fromColumns: mismatch between tags and data"

331 where

329 where

332 mhere = HMaybeTable

330 mhere = HMaybeTable

333− { htag = relabel hhereTag

331+ { htag = hrelabel hhereTag

334− , hjust = hlabel labeler (hunlabel unlabeler hhere)

332+ , hjust = hrelabel hhere

335 }

333 }

336 mthere = HMaybeTable

334 mthere = HMaybeTable

337− { htag = relabel hthereTag

335+ { htag = hrelabel hthereTag

338− , hjust = hlabel labeler (hunlabel unlabeler hthere)

336+ , hjust = hrelabel hthere

339 }

337 }

340

338

341

339

342−instance (Table context a, Table context b, Labelable context)

340+instance (Table context a, Table context b)

343 => Table context (a, b)

341 => Table context (a, b)

344

342

345

343

346instance

344instance

347 ( Table context a, Table context b, Table context c

345 ( Table context a, Table context b, Table context c

348− , Labelable context

349 )

346 )

350 => Table context (a, b, c)

347 => Table context (a, b, c)

351

348

352

349

353instance

350instance

354 ( Table context a, Table context b, Table context c, Table context d

351 ( Table context a, Table context b, Table context c, Table context d

355− , Labelable context

356 )

352 )

357 => Table context (a, b, c, d)

353 => Table context (a, b, c, d)

358

354

@@ -360,7 +356,6 @@ instance

360instance

356instance

361 ( Table context a, Table context b, Table context c, Table context d

357 ( Table context a, Table context b, Table context c, Table context d

362 , Table context e

358 , Table context e

363− , Labelable context

364 )

359 )

365 => Table context (a, b, c, d, e)

360 => Table context (a, b, c, d, e)

366

361

@@ -368,7 +363,6 @@ instance

368instance

363instance

369 ( Table context a, Table context b, Table context c, Table context d

364 ( Table context a, Table context b, Table context c, Table context d

370 , Table context e, Table context f

365 , Table context e, Table context f

371− , Labelable context

372 )

366 )

373 => Table context (a, b, c, d, e, f)

367 => Table context (a, b, c, d, e, f)

374

368

@@ -376,7 +370,6 @@ instance

376instance

370instance

377 ( Table context a, Table context b, Table context c, Table context d

371 ( Table context a, Table context b, Table context c, Table context d

378 , Table context e, Table context f, Table context g

372 , Table context e, Table context f, Table context g

379− , Labelable context

380 )

373 )

381 => Table context (a, b, c, d, e, f, g)

374 => Table context (a, b, c, d, e, f, g)

382

375

src/Rel8/Table/Either.hs+9−15

@@ -32,10 +32,6 @@ import Prelude hiding ( undefined )

32-- rel8

33import Rel8.Expr ( Expr )

34import Rel8.Expr.Serialize ( litExpr )

35−import Rel8.Schema.Context.Label

36− ( Labelable

37− , HLabelable, hlabeler, hunlabeler

38− )

39import Rel8.Schema.Context.Nullify

35import Rel8.Schema.Context.Nullify

40 ( Nullifiable, ConstrainTag

36 ( Nullifiable, ConstrainTag

41 , HNullifiable, HConstrainTag

37 , HNullifiable, HConstrainTag

@@ -111,7 +107,7 @@ instance (Table Expr a, Table Expr b) => Semigroup (EitherTable a b) where

111

107

112instance

108instance

113 ( Table context a, Table context b

109 ( Table context a, Table context b

114− , Labelable context, Nullifiable context, ConstrainTag context EitherTag

110+ , Nullifiable context, ConstrainTag context EitherTag

115 ) =>

111 ) =>

116 Table context (EitherTable a b)

112 Table context (EitherTable a b)

117 where

113 where

@@ -125,8 +121,8 @@ instance

125

121

126

122

127instance

123instance

128− ( Nullifiable from, Labelable from, ConstrainTag from EitherTag

124+ ( Nullifiable from, ConstrainTag from EitherTag

129− , Nullifiable to, Labelable to, ConstrainTag to EitherTag

125+ , Nullifiable to, ConstrainTag to EitherTag

130 , Recontextualize from to a1 b1

126 , Recontextualize from to a1 b1

131 , Recontextualize from to a2 b2

127 , Recontextualize from to a2 b2

132 )

128 )

@@ -206,7 +202,6 @@ toColumns2 ::

206 ( HTable t

202 ( HTable t

207 , HTable u

203 , HTable u

208 , HConstrainTag context EitherTag

204 , HConstrainTag context EitherTag

209− , HLabelable context

210 , HNullifiable context

205 , HNullifiable context

211 )

206 )

212 => (a -> t context)

207 => (a -> t context)

@@ -215,18 +210,17 @@ toColumns2 ::

215 -> HEitherTable t u context

210 -> HEitherTable t u context

216toColumns2 f g EitherTable {tag, left, right} = HEitherTable

211toColumns2 f g EitherTable {tag, left, right} = HEitherTable

217 { htag

212 { htag

218− , hleft = hlabel hlabeler $ hnullify (hnullifier tag isLeft) $ f left

213+ , hleft = hlabel $ hnullify (hnullifier tag isLeft) $ f left

219− , hright = hlabel hlabeler $ hnullify (hnullifier tag isRight) $ g right

214+ , hright = hlabel $ hnullify (hnullifier tag isRight) $ g right

220 }

215 }

221 where

216 where

222− htag = HIdentity (hencodeTag tag)

217+ htag = hlabel $ HType $ hencodeTag tag

223

218

224

219

225fromColumns2 ::

220fromColumns2 ::

226 ( HTable t

221 ( HTable t

227 , HTable u

222 , HTable u

228 , HConstrainTag context EitherTag

223 , HConstrainTag context EitherTag

229− , HLabelable context

230 , HNullifiable context

224 , HNullifiable context

231 )

225 )

232 => (t context -> a)

226 => (t context -> a)

@@ -237,12 +231,12 @@ fromColumns2 f g HEitherTable {htag, hleft, hright} = EitherTable

237 { tag

231 { tag

238 , left = f $ runIdentity $

232 , left = f $ runIdentity $

239 hunnullify (\a -> pure . hunnullifier a) $

233 hunnullify (\a -> pure . hunnullifier a) $

240− hunlabel hunlabeler

234+ hunlabel

241 hleft

235 hleft

242 , right = g $ runIdentity $

236 , right = g $ runIdentity $

243 hunnullify (\a -> pure . hunnullifier a) $

237 hunnullify (\a -> pure . hunnullifier a) $

244− hunlabel hunlabeler

238+ hunlabel

245 hright

239 hright

246 }

240 }

247 where

241 where

248− tag = hdecodeTag $ unHIdentity htag

242+ tag = hdecodeTag $ unHIdentity $ hunlabel htag

src/Rel8/Table/Maybe.hs+8−13

@@ -30,9 +30,6 @@ import Prelude hiding ( null, undefined )

30import Rel8.Expr ( Expr )

31import Rel8.Expr.Bool ( boolExpr )

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

33−import Rel8.Schema.Context.Label

34− ( Labelable, HLabelable, hlabeler, hunlabeler

35− )

36import Rel8.Schema.Context.Nullify

33import Rel8.Schema.Context.Nullify

37 ( Nullifiable, ConstrainTag

34 ( Nullifiable, ConstrainTag

38 , HNullifiable, HConstrainTag

35 , HNullifiable, HConstrainTag

@@ -131,7 +128,7 @@ instance (Table Expr a, Semigroup a) => Monoid (MaybeTable a) where

131

128

132instance

129instance

133 ( Table context a

130 ( Table context a

134− , Labelable context, Nullifiable context

131+ , Nullifiable context

135 , ConstrainTag context MaybeTag

132 , ConstrainTag context MaybeTag

136 ) => Table context (MaybeTable a)

133 ) => Table context (MaybeTable a)

137 where

134 where

@@ -145,8 +142,8 @@ instance

145

142

146

143

147instance

144instance

148− ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag

145+ ( Nullifiable from, ConstrainTag from MaybeTag

149− , Labelable to, Nullifiable to, ConstrainTag to MaybeTag

146+ , Nullifiable to, ConstrainTag to MaybeTag

150 , Recontextualize from to a b

147 , Recontextualize from to a b

151 )

148 )

152 => Recontextualize from to (MaybeTable a) (MaybeTable b)

149 => Recontextualize from to (MaybeTable a) (MaybeTable b)

@@ -222,7 +219,6 @@ nameMaybeTable = MaybeTable . fromName

222toColumns1 ::

219toColumns1 ::

223 ( HTable t

220 ( HTable t

224 , HConstrainTag context MaybeTag

221 , HConstrainTag context MaybeTag

225− , HLabelable context

226 , HNullifiable context

222 , HNullifiable context

227 )

223 )

228 => (a -> t context)

224 => (a -> t context)

@@ -230,25 +226,24 @@ toColumns1 ::

230 -> HMaybeTable t context

226 -> HMaybeTable t context

231toColumns1 f MaybeTable {tag, just} = HMaybeTable

227toColumns1 f MaybeTable {tag, just} = HMaybeTable

232 { htag

228 { htag

233− , hjust = hlabel hlabeler $ hnullify (hnullifier tag isNonNull) $ f just

229+ , hjust = hlabel $ hnullify (hnullifier tag isNonNull) $ f just

234 }

230 }

235 where

231 where

236− htag = HIdentity (hencodeTag tag)

232+ htag = hlabel (HType (hencodeTag tag))

237

233

238

234

239fromColumns1 ::

235fromColumns1 ::

240 ( HTable t

236 ( HTable t

241 , HConstrainTag context MaybeTag

237 , HConstrainTag context MaybeTag

242− , HLabelable context

243 , HNullifiable context

238 , HNullifiable context

244 )

239 )

245 => (t context -> a)

240 => (t context -> a)

246 -> HMaybeTable t context

241 -> HMaybeTable t context

247 -> MaybeTable a

242 -> MaybeTable a

248−fromColumns1 f HMaybeTable {htag = HIdentity htag, hjust} = MaybeTable

243+fromColumns1 f HMaybeTable {htag, hjust} = MaybeTable

249 { tag

244 { tag

250 , just = f $ runIdentity $

245 , just = f $ runIdentity $

251− hunnullify (\a -> pure . hunnullifier a) (hunlabel hunlabeler hjust)

246+ hunnullify (\a -> pure . hunnullifier a) (hunlabel hjust)

252 }

247 }

253 where

248 where

254− tag = hdecodeTag htag

249+ tag = hdecodeTag (unHIdentity (hunlabel htag))

src/Rel8/Table/Name.hs+6−2

@@ -17,7 +17,8 @@ where

17-- base

18import Data.Foldable ( fold )

19import Data.Functor.Const ( Const( Const ), getConst )

20−import Data.List.NonEmpty ( NonEmpty, intersperse )

20+import Data.List.NonEmpty ( NonEmpty, intersperse, nonEmpty )

21+import Data.Maybe ( fromMaybe )

21import Prelude

22import Prelude

22

23

23-- opaleye

24-- opaleye

@@ -26,7 +27,6 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

26-- rel8

27-- rel8

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

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

28import Rel8.Expr.Opaleye ( toPrimExpr )

29import Rel8.Expr.Opaleye ( toPrimExpr )

29−import Rel8.Kind.Labels ( renderLabels )

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

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

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

@@ -82,3 +82,7 @@ showNames :: forall a. Table Name a => a -> [String]

82showNames (toColumns -> names) = getConst $

83 htabulateA @(Columns a) $ \field -> case hfield names field of

84 N (Name name) -> Const [name]

85+

86+

87+renderLabels :: [String] -> NonEmpty String

88+renderLabels labels = fromMaybe (pure "anon") (nonEmpty labels )

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

@@ -18,7 +18,6 @@ import Prelude ()

18

19-- rel8

20import Rel8.Schema.Context ( Col )

21−import Rel8.Schema.Context.Label ( Labelable )

22import Rel8.Schema.HTable ( HTable )

21import Rel8.Schema.HTable ( HTable )

23import qualified Rel8.Schema.Kind as K

22import qualified Rel8.Schema.Kind as K

24import Rel8.Schema.Null ( Sql )

23import Rel8.Schema.Null ( Sql )

@@ -54,8 +53,6 @@ instance HTable t => Recontextualize from to (t (Col from)) (t (Col to))

54instance

53instance

55 ( Recontextualize from to a1 b1

54 ( Recontextualize from to a1 b1

56 , Recontextualize from to a2 b2

55 , Recontextualize from to a2 b2

57− , Labelable from

58− , Labelable to

59 )

56 )

60 => Recontextualize from to (a1, a2) (b1, b2)

57 => Recontextualize from to (a1, a2) (b1, b2)

61

58

@@ -64,7 +61,6 @@ instance

64 ( Recontextualize from to a1 b1

61 ( Recontextualize from to a1 b1

65 , Recontextualize from to a2 b2

62 , Recontextualize from to a2 b2

66 , Recontextualize from to a3 b3

63 , Recontextualize from to a3 b3

67− , Labelable from, Labelable to

68 )

64 )

69 => Recontextualize from to (a1, a2, a3) (b1, b2, b3)

65 => Recontextualize from to (a1, a2, a3) (b1, b2, b3)

70

66

@@ -74,7 +70,6 @@ instance

74 , Recontextualize from to a2 b2

70 , Recontextualize from to a2 b2

75 , Recontextualize from to a3 b3

71 , Recontextualize from to a3 b3

76 , Recontextualize from to a4 b4

72 , Recontextualize from to a4 b4

77− , Labelable from, Labelable to

78 )

73 )

79 => Recontextualize from to (a1, a2, a3, a4) (b1, b2, b3, b4)

74 => Recontextualize from to (a1, a2, a3, a4) (b1, b2, b3, b4)

80

75

@@ -85,6 +80,28 @@ instance

85 , Recontextualize from to a3 b3

80 , Recontextualize from to a3 b3

86 , Recontextualize from to a4 b4

81 , Recontextualize from to a4 b4

87 , Recontextualize from to a5 b5

82 , Recontextualize from to a5 b5

88− , Labelable from, Labelable to

89 )

83 )

90 => Recontextualize from to (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)

84 => Recontextualize from to (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5)

85+

86+

87+instance

88+ ( Recontextualize from to a1 b1

89+ , Recontextualize from to a2 b2

90+ , Recontextualize from to a3 b3

91+ , Recontextualize from to a4 b4

92+ , Recontextualize from to a5 b5

93+ , Recontextualize from to a6 b6

94+ )

95+ => Recontextualize from to (a1, a2, a3, a4, a5, a6) (b1, b2, b3, b4, b5, b6)

96+

97+

98+instance

99+ ( Recontextualize from to a1 b1

100+ , Recontextualize from to a2 b2

101+ , Recontextualize from to a3 b3

102+ , Recontextualize from to a4 b4

103+ , Recontextualize from to a5 b5

104+ , Recontextualize from to a6 b6

105+ , Recontextualize from to a7 b7

106+ )

107+ => Recontextualize from to (a1, a2, a3, a4, a5, a6, a7) (b1, b2, b3, b4, b5, b6, b7)

src/Rel8/Table/Rel8able.hs+8−11

@@ -25,7 +25,7 @@ import qualified Rel8.Kind.Algebra as K

25import Rel8.Kind.Context

26 ( SContext( SReify )

27 , Reifiable, contextSing

28− , sLabelable, sReifiable

28+ , sReifiable

29 )

30import Rel8.Generic.Rel8able

31 ( Rel8able, Algebra

@@ -33,7 +33,6 @@ import Rel8.Generic.Rel8able

33 , greify, gunreify

34 )

35import Rel8.Schema.Context ( Col )

36−import Rel8.Schema.Context.Label ( Labelable )

37import Rel8.Schema.Dict ( Dict( Dict ) )

36import Rel8.Schema.Dict ( Dict( Dict ) )

38import qualified Rel8.Schema.Kind as K

37import qualified Rel8.Schema.Kind as K

39import Rel8.Schema.HTable ( HConstrainTable, hdicts )

38import Rel8.Schema.HTable ( HConstrainTable, hdicts )

@@ -54,7 +53,7 @@ import Rel8.Type.Eq ( DBEq )

54import Rel8.Type.Ord ( DBOrd )

53import Rel8.Type.Ord ( DBOrd )

55

54

56

55

57−instance (Rel8able t, Labelable context, Reifiable context) =>

56+instance (Rel8able t, Reifiable context) =>

58 Table context (t context)

57 Table context (t context)

59 where

58 where

60 type Columns (t context) = GColumns t

59 type Columns (t context) = GColumns t

@@ -65,20 +64,18 @@ instance (Rel8able t, Labelable context, Reifiable context) =>

65 toColumns = hunreify . gtoColumns . greify

64 toColumns = hunreify . gtoColumns . greify

66

65

67 reify Refl = case contextSing @context of

66 reify Refl = case contextSing @context of

68− SReify context -> case sLabelable context of

67+ SReify context -> case sReifiable context of

69− Dict -> case sReifiable context of

70− Dict -> greify

68+ Dict -> greify

71

69

72 unreify Refl = case contextSing @context of

70 unreify Refl = case contextSing @context of

73− SReify context -> case sLabelable context of

71+ SReify context -> case sReifiable context of

74− Dict -> case sReifiable context of

75− Dict -> gunreify

72+ Dict -> gunreify

76

73

77

74

78instance

75instance

79 ( Rel8able t

76 ( Rel8able t

80− , Labelable from, Reifiable from

77+ , Reifiable from

81− , Labelable to, Reifiable to

78+ , Reifiable to

82 , Congruent (t from) (t to)

79 , Congruent (t from) (t to)

83 )

80 )

84 => Recontextualize from to (t from) (t to)

81 => Recontextualize from to (t from) (t to)

src/Rel8/Table/These.hs+11−17

@@ -36,10 +36,6 @@ import Prelude hiding ( undefined )

36import Rel8.Expr ( Expr )

37import Rel8.Expr.Bool ( (&&.), not_ )

38import Rel8.Expr.Null ( isNonNull )

39−import Rel8.Schema.Context.Label

40− ( Labelable

41− , HLabelable, hlabeler, hunlabeler

42− )

43import Rel8.Schema.Context.Nullify

39import Rel8.Schema.Context.Nullify

44 ( Nullifiable, ConstrainTag

40 ( Nullifiable, ConstrainTag

45 , HNullifiable, HConstrainTag

41 , HNullifiable, HConstrainTag

@@ -136,7 +132,7 @@ instance (Table Expr a, Table Expr b, Semigroup a, Semigroup b) =>

136

132

137instance

133instance

138 ( Table context a, Table context b

134 ( Table context a, Table context b

139− , Labelable context, Nullifiable context, ConstrainTag context MaybeTag

135+ , Nullifiable context, ConstrainTag context MaybeTag

140 ) => Table context (TheseTable a b)

136 ) => Table context (TheseTable a b)

141 where

137 where

142 type Columns (TheseTable a b) = HTheseTable (Columns a) (Columns b)

138 type Columns (TheseTable a b) = HTheseTable (Columns a) (Columns b)

@@ -149,8 +145,8 @@ instance

149

145

150

146

151instance

147instance

152− ( Labelable from, Nullifiable from, ConstrainTag from MaybeTag

148+ ( Nullifiable from, ConstrainTag from MaybeTag

153− , Labelable to, Nullifiable to, ConstrainTag to MaybeTag

149+ , Nullifiable to, ConstrainTag to MaybeTag

154 , Recontextualize from to a1 b1

150 , Recontextualize from to a1 b1

155 , Recontextualize from to a2 b2

151 , Recontextualize from to a2 b2

156 ) =>

152 ) =>

@@ -285,7 +281,6 @@ toColumns2 ::

285 ( HTable t

281 ( HTable t

286 , HTable u

282 , HTable u

287 , HConstrainTag context MaybeTag

283 , HConstrainTag context MaybeTag

288− , HLabelable context

289 , HNullifiable context

284 , HNullifiable context

290 )

285 )

291 => (a -> t context)

286 => (a -> t context)

@@ -293,12 +288,12 @@ toColumns2 ::

293 -> TheseTable a b

288 -> TheseTable a b

294 -> HTheseTable t u context

289 -> HTheseTable t u context

295toColumns2 f g TheseTable {here, there} = HTheseTable

290toColumns2 f g TheseTable {here, there} = HTheseTable

296− { hhereTag = HIdentity $ hencodeTag (toHereTag (tag here))

291+ { hhereTag = hlabel $ HType $ hencodeTag (toHereTag (tag here))

297 , hhere =

292 , hhere =

298− hlabel hlabeler $ hnullify (hnullifier (tag here) isNonNull) $ f (just here)

293+ hlabel $ hnullify (hnullifier (tag here) isNonNull) $ f (just here)

299− , hthereTag = HIdentity $ hencodeTag (toThereTag (tag there))

294+ , hthereTag = hlabel $ HType $ hencodeTag (toThereTag (tag there))

300 , hthere =

295 , hthere =

301− hlabel hlabeler $ hnullify (hnullifier (tag there) isNonNull) $ g (just there)

296+ hlabel $ hnullify (hnullifier (tag there) isNonNull) $ g (just there)

302 }

297 }

303

298

304

299

@@ -306,7 +301,6 @@ fromColumns2 ::

306 ( HTable t

301 ( HTable t

307 , HTable u

302 , HTable u

308 , HConstrainTag context MaybeTag

303 , HConstrainTag context MaybeTag

309− , HLabelable context

310 , HNullifiable context

304 , HNullifiable context

311 )

305 )

312 => (t context -> a)

306 => (t context -> a)

@@ -316,26 +310,26 @@ fromColumns2 ::

316fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} = TheseTable

310fromColumns2 f g HTheseTable {hhereTag, hhere, hthereTag, hthere} = TheseTable

317 { here =

311 { here =

318 let

312 let

319− tag = hdecodeTag $ unHIdentity hhereTag

313+ tag = hdecodeTag $ unHIdentity $ hunlabel hhereTag

320 in

314 in

321 MaybeTable

315 MaybeTable

322 { tag

316 { tag

323 , just = f $

317 , just = f $

324 runIdentity $

318 runIdentity $

325 hunnullify (\a -> pure . hunnullifier a) $

319 hunnullify (\a -> pure . hunnullifier a) $

326− hunlabel hunlabeler

320+ hunlabel

327 hhere

321 hhere

328 }

322 }

329 , there =

323 , there =

330 let

324 let

331− tag = hdecodeTag $ unHIdentity hthereTag

325+ tag = hdecodeTag $ unHIdentity $ hunlabel hthereTag

332 in

326 in

333 MaybeTable

327 MaybeTable

334 { tag

328 { tag

335 , just = g $

329 , just = g $

336 runIdentity $

330 runIdentity $

337 hunnullify (\a -> pure . hunnullifier a) $

331 hunnullify (\a -> pure . hunnullifier a) $

338− hunlabel hunlabeler

332+ hunlabel

339 hthere

333 hthere

340 }

334 }

341 }

335 }