97d89cf · rel8 · git.iko.soy

rel8.cabal+1−1

compare with master

unifiedsplit

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

114 Rel8.Query.These

115 Rel8.Query.Values

116

117− Rel8.Schema.Context

118 Rel8.Schema.Context.Nullify

117 Rel8.Schema.Context.Nullify

119 Rel8.Schema.Context.Virtual

118 Rel8.Schema.Context.Virtual

120 Rel8.Schema.Dict

119 Rel8.Schema.Dict

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

150 Rel8.Table.Aggregate

149 Rel8.Table.Aggregate

151 Rel8.Table.Alternative

150 Rel8.Table.Alternative

152 Rel8.Table.Bool

151 Rel8.Table.Bool

152+ Rel8.Table.Cols

153 Rel8.Table.Either

154 Rel8.Table.Eq

155 Rel8.Table.HKD

src/Rel8/Aggregate.hs+7−14

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

5{-# language MultiParamTypeClasses #-}

6{-# language NamedFieldPuns #-}

7{-# language PolyKinds #-}

8+{-# language RankNTypes #-}

8{-# language StandaloneKindSignatures #-}

9{-# language StandaloneKindSignatures #-}

9{-# language TypeFamilies #-}

10{-# language TypeFamilies #-}

10{-# language UndecidableInstances #-}

11{-# language UndecidableInstances #-}

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

14 ( Aggregate(..), foldInputs, mapInputs

15 ( Aggregate(..), foldInputs, mapInputs

15 , Aggregator(..), unsafeMakeAggregate

16 , Aggregator(..), unsafeMakeAggregate

16 , Aggregates

17 , Aggregates

17− , Col( A, unA )

18 )

19where

20

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

30

31-- rel8

32import Rel8.Expr ( Expr )

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

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

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

35import Rel8.Schema.Name ( Name )

34import Rel8.Schema.Name ( Name )

36import Rel8.Schema.Null ( Sql )

35import Rel8.Schema.Null ( Sql )

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

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

38import Rel8.Schema.Spec ( Spec( Spec ) )

37import Rel8.Schema.Spec ( Spec( Spec ) )

39import Rel8.Table

38import Rel8.Table

40 ( Table, Columns, Context, fromColumns, toColumns

39 ( Table, Columns, Context, fromColumns, toColumns

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

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

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

52type Aggregate :: k -> Type

51type Aggregate :: k -> Type

53data Aggregate a where

52data Aggregate a where

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

53+ Aggregate :: forall (a :: Type). !(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) }

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

61− -> Col Aggregate ('Spec a)

62

55

63

56

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

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

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

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

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

100

93

101

94

102−foldInputs :: Monoid b

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

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

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

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

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

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

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

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

109 Aggregator {operation, ordering, distinction}

102 Aggregator {operation, ordering, distinction}

110

103

111

104

112−mapInputs :: ()

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

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

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

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

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

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

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

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

124 }

117 }

125

118

126

119

127−unsafeMakeAggregate :: ()

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

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

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

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

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

130 -> Maybe Aggregator

123 -> Maybe Aggregator

src/Rel8/Expr.hs+4−14

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

13{-# language UndecidableInstances #-}

14{-# language UndecidableSuperClasses #-}

15

16−module Rel8.Expr

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

17− ( Expr(..)

18− , Col( E, unE )

19− )

20−where

21

17

22-- base

18-- base

23import Data.Kind ( Type )

19import Data.Kind ( Type )

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

37 , zipPrimExprsWith

33 , zipPrimExprsWith

38 )

34 )

39import Rel8.Expr.Serialize ( litExpr )

35import Rel8.Expr.Serialize ( litExpr )

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

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

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

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

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

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

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

44import Rel8.Schema.Spec ( Spec( Spec ) )

39import Rel8.Schema.Spec ( Spec( Spec ) )

45import Rel8.Table

40import Rel8.Table

46 ( Table, Columns, Context, fromColumns, toColumns

41 ( Table, Columns, Context, fromColumns, toColumns

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

54

49

55

50

56-- | Typed SQL expressions.

51-- | Typed SQL expressions.

57−type role Expr representational

58type Expr :: k -> Type

52type Expr :: k -> Type

59data Expr a where

53data 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)

61

56

62

57

63deriving stock instance Show (Expr a)

58deriving stock instance Show (Expr a)

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

124 atanh = function "atanh"

119 atanh = function "atanh"

125

120

126

121

127−instance Interpretation Expr where

128− data Col Expr _spec where

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

130−

131−

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

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

133 type Columns (Expr a) = HType a

123 type Columns (Expr a) = HType a

134 type Context (Expr a) = Expr

124 type Context (Expr a) = Expr

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

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

1+{-# language DataKinds #-}

1{-# language GADTs #-}

2{-# language GADTs #-}

2{-# language PolyKinds #-}

3{-# language PolyKinds #-}

4+{-# language RankNTypes #-}

3{-# language RoleAnnotations #-}

5{-# language RoleAnnotations #-}

4{-# language StandaloneKindSignatures #-}

6{-# language StandaloneKindSignatures #-}

5

7

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

15-- opaleye

17-- opaleye

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

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

17

19

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

21+

18

22

19−type role Expr representational

20type Expr :: k -> Type

23type Expr :: k -> Type

21data Expr a where

24data 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 )

29import Prelude

30

31-- rel8

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

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

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

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

34import Rel8.Expr.Aggregate ( groupByExpr )

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

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

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

59import Rel8.Schema.HTable ( HTable )

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

61import qualified Rel8.Schema.Kind as K

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

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

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

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

65import Rel8.Table

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

86 GGBuildable' 'K.Product name rep =

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

88 , 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))

90 )

91 GGBuildable' 'K.Sum name rep =

92 ( 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))

94 )

95

96

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

103

104

105ggbuild :: 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)

107 -> GGBuild algebra name rep a

108ggbuild gfromColumns = case algebraSing @algebra of

109 SProduct ->

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

113 @(TTable Expr)

114 @TColumns

115 @Id

116− @(Col Expr)

116+ @Expr

117 @(Eval (rep Expr))

118 (const toColumns)

119 SSum ->

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

123 @(TTable Expr)

124 @TColumns

125 @Id

126− @(Col Expr)

126+ @Expr

127 @name

128 @(Eval (rep Expr))

129 (const toColumns)

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

151 ( Representable Id (Eval (rep Aggregate))

152 , Representable Id (Eval (rep Expr))

153 , Representable Id (Eval (rep Name))

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

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

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

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

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

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

157 )

158 GGConstructable' 'K.Sum rep =

159 ( RepresentableConstructors Id (Eval (rep Expr))

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

161 , RepresentableFields Id (Eval (rep Expr))

162 , RepresentableFields Id (Eval (rep Name))

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

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

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

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

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

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

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

167 )

168

169

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

174

175

176ggconstruct :: 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)

178 -> GGConstruct algebra rep a -> a

179ggconstruct gfromColumns f = case algebraSing @algebra of

180 SProduct ->

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

185 @(TTable Expr)

186 @TColumns

187 @Id

188− @(Col Expr)

188+ @Expr

189 @(Eval (rep Expr))

190 (const toColumns)

191 SSum ->

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

195 @(TTable Expr)

196 @TColumns

197 @Id

198− @(Col Expr)

198+ @Expr

199 @(Eval (rep Expr))

200 (const toColumns)

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

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

214

215

216ggdeconstruct :: 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)

218 -> GGDeconstruct algebra rep a r

219ggdeconstruct gtoColumns = case algebraSing @algebra of

220 SProduct -> \build ->

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

223 @(TTable Expr)

224 @TColumns

225 @Id

226− @(Col Expr)

226+ @Expr

227 @(Eval (rep Expr))

228 (const fromColumns) .

229 gtoColumns

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

235 @(TTable Expr)

236 @TColumns

237 @Id

238− @(Col Expr)

238+ @Expr

239 @(Eval (rep Expr))

240 (const fromColumns)

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

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

256

257

258ggname :: 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)

260 -> GGName algebra rep a

261ggname gfromColumns = case algebraSing @algebra of

262 SProduct ->

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

266 @(TTable Name)

267 @TColumns

268 @Id

269− @(Col Name)

269+ @Name

270 @(Eval (rep Name))

271 (const toColumns)

272 SSum -> \tag ->

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

276 @(TTable Name)

277 @TColumns

278 @Id

279− @(Col Name)

279+ @Name

280 @(Eval (rep Name))

281 (const toColumns)

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

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

294

295

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

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

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

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

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

299 -> GGAggregate algebra rep agg -> exprs -> agg

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

301 SProduct -> flip f exprs $

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

304 @(TTable Aggregate)

305 @TColumns

306 @Id

307− @(Col Aggregate)

307+ @Aggregate

308 @(Eval (rep Aggregate))

309 (const toColumns)

310 where

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

317 @(TTable Expr)

318 @TColumns

319 @Id

320− @(Col Expr)

320+ @Expr

321 @(Eval (rep Expr))

322 (const fromColumns) $

323 gtoColumns es

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

327 @(TTable Aggregate)

328 @TColumns

329 @Id

330− @(Col Aggregate)

330+ @Aggregate

331 @(Eval (rep Aggregate))

332 (const toColumns)

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

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

343 @(TTable Expr)

344 @TColumns

345 @Id

346− @(Col Expr)

346+ @Expr

347 @(Eval (rep Expr))

348 (const fromColumns)

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

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

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

62import Data.Text ( pack )

63

64

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

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

66type Null context = forall a. ()

67 => SSpec ('Spec a)

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

69

70

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

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

72type Nullifier context = forall a. ()

73 => SSpec ('Spec a)

74 -> context ('Spec a)

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

76

77

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

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

79type Unnullifier context = forall a. ()

80 => SSpec ('Spec a)

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

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

188 :: (Type -> Exp Constraint)

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

190 -> (Type -> Exp Type)

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

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

192class GConstructableADT _Table _Columns f context rep where

193 gbuildADT :: ()

194 => ToColumns _Table _Columns f context

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

245 :: (Type -> Exp Constraint)

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

247 -> (Type -> Exp Type)

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

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

249class GConstructableADT' _Table _Columns f context htable rep where

250 gbuildADT' :: ()

251 => ToColumns _Table _Columns f context

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

383 :: (Type -> Exp Constraint)

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

385 -> (Type -> Exp Type)

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

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

387class GMakeableADT _Table _Columns f context name rep where

388 gmakeADT :: ()

389 => ToColumns _Table _Columns f context

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

417 :: (Type -> Exp Constraint)

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

419 -> (Type -> Exp Type)

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

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

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

422 gmakeADT' :: ()

423 => ToColumns _Table _Columns f context

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

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

43 :: (Type -> Exp Constraint)

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

45 -> (Type -> Exp Type)

46− -> K.HContext

46+ -> K.Context

47 -> Type

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

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

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

53 :: (Type -> Exp Constraint)

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

55 -> (Type -> Exp Type)

56− -> K.HContext

56+ -> K.Context

57 -> Type

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

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

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

117 :: (Type -> Exp Constraint)

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

119 -> (Type -> Exp Type)

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

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

121class GConstructable _Table _Columns f context rep where

122 gconstruct :: ()

123 => ToColumns _Table _Columns f context

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

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

8{-# language StandaloneKindSignatures #-}

9{-# language TypeApplications #-}

10{-# language TypeFamilies #-}

11+{-# language TypeFamilyDependencies #-}

11{-# language UndecidableInstances #-}

12{-# language UndecidableInstances #-}

12

13

13module Rel8.Generic.Rel8able

14module Rel8.Generic.Rel8able

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

32import Rel8.Generic.Table ( GAlgebra )

33import Rel8.Generic.Table ( GAlgebra )

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

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

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

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

35−import Rel8.Schema.Context ( Col )

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

37import Rel8.Schema.HTable ( HTable )

38import qualified Rel8.Schema.Kind as K

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

96 type GColumns t :: K.HTable

97 type GFromExprs t :: Type

98

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

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

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

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

101

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

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

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

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

104

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

106 type GFromExprs t = t Result

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

110 , VRel8able t Expr

111 , VRel8able t Name

112 )

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

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

114 gfromColumns = \case

115 VAggregate -> vfromColumns

116 VExpr -> vfromColumns

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

121 , VRel8able t Expr

122 , VRel8able t Name

123 )

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

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

125 gtoColumns = \case

126 VAggregate -> vtoColumns

127 VExpr -> vtoColumns

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

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

135 , GFromExprs t ~ t Result

136 )

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

137+ => GColumns t Result -> GFromExprs t

138 gfromResult =

139 unrecord .

140 to .

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

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

153 , GFromExprs t ~ t Result

154 )

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

155+ => GFromExprs t -> GColumns t Result

156 gtoResult =

157 G.gtoResult

158 @(TTable Expr)

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

181

182

183vfromColumns :: forall t context. VRel8able t context

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

184+ => GColumns t context -> t context

185vfromColumns =

186 unrecord .

187 to .

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

189

190

191vtoColumns :: forall t context. VRel8able t context

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

192+ => t context -> GColumns t context

193vtoColumns =

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

195 from .

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

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

34 , SAlgebra( SProduct, SSum )

35 , KnownAlgebra, algebraSing

36 )

37−import Rel8.Schema.Context ( Col )

38import qualified Rel8.Schema.Kind as K

37import qualified Rel8.Schema.Kind as K

39import Rel8.Schema.Result ( Result )

38import Rel8.Schema.Result ( Result )

40

39

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

84 , Eval (GGTable algebra _Table _Columns _FromExprs rep)

83 , Eval (GGTable algebra _Table _Columns _FromExprs rep)

85 )

84 )

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

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

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

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

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

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

89 -> GMap _FromExprs rep x

88 -> GMap _FromExprs rep x

90ggfromResult f x = case algebraSing @algebra of

89ggfromResult f x = case algebraSing @algebra of

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

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

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

97 , Eval (GGTable algebra _Table _Columns _FromExprs rep)

96 , Eval (GGTable algebra _Table _Columns _FromExprs rep)

98 )

97 )

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

98 => (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)

101 -> GMap _FromExprs rep x

100 -> GMap _FromExprs rep x

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

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

103ggtoResult f x = case algebraSing @algebra of

102ggtoResult f x = case algebraSing @algebra of

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

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

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

104 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 )

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

40import qualified Rel8.Schema.Kind as K

41import Rel8.Schema.Result

42− ( Col( R ), Result

42+ ( Result( R )

43 , null, nullifier, unnullifier

44 )

45import Rel8.Type.Tag ( Tag( Tag ) )

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

75class GTableADT _Table _Columns _FromExprs rep where

76 gfromResultADT :: ()

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

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

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

79− -> GColumnsADT _Columns rep (Col Result)

79+ -> GColumnsADT _Columns rep Result

80 -> GMap _FromExprs rep x

81

82 gtoResultADT :: ()

83 => (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)

85 -> GMap _FromExprs rep x

86− -> GColumnsADT _Columns rep (Col Result)

86+ -> GColumnsADT _Columns rep Result

87

88

89instance

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

91− , Eval (_Table (htable context))

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

93 , GTableADT' _Table _Columns _FromExprs htable rep

91 , GTableADT' _Table _Columns _FromExprs htable rep

94 )

92 )

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

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

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

113 -> (Type -> Exp Type)

111 -> (Type -> Exp Type)

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

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

115class GTableADT' _Table _Columns _FromExprs htable rep where

113class GTableADT' _Table _Columns _FromExprs htable rep where

116− gfromResultADT' :: context ~ Col Result

114+ gfromResultADT' :: context ~ Result

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

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

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

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

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

117+ -> (htable Result -> Tag)

120 -> GColumnsADT' _Columns htable rep context

118 -> GColumnsADT' _Columns htable rep context

121 -> Maybe (GMap _FromExprs rep x)

119 -> Maybe (GMap _FromExprs rep x)

122

120

123− gtoResultADT' :: context ~ Col Result

121+ gtoResultADT' :: context ~ Result

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

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

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

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

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

124+ -> (Tag -> htable Result)

127 -> Maybe (GMap _FromExprs rep x)

125 -> Maybe (GMap _FromExprs rep x)

128 -> GColumnsADT' _Columns htable rep context

126 -> GColumnsADT' _Columns htable rep context

129

127

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

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

17import Rel8.Query.Opaleye ( fromOpaleye )

18import Rel8.Schema.Name ( Selects )

19import Rel8.Schema.Table ( TableSchema )

20−import Rel8.Table ( fromColumns, toColumns )

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

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

22

23

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

25-- table@.

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

27each =

28− fmap fromColumns .

28+ fmap fromCols .

29 fromOpaleye .

30 Opaleye.selectTableExplicit unpackspec .

31 table .

32− fmap toColumns

32+ fmap toCols

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

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

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

20

21-- rel8

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

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

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

24import Rel8.Expr.Opaleye ( mapPrimExpr )

25import Rel8.Query ( Query )

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

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

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

31import 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 )

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

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

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

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

35import Rel8.Table.Maybe ( maybeTable )

36import Rel8.Table.Maybe ( maybeTable )

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

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

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

52 optional .

53 optional .

53 aggregate .

54 aggregate .

54− fmap (listAgg . toColumns)

55+ fmap (listAgg . toCols)

55

56

57

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

58-- | 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)

66some =

67some =

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

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

68 aggregate .

69 aggregate .

69− fmap (nonEmptyAgg . toColumns)

70+ fmap (nonEmptyAgg . toCols)

70

71

72

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

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

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

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

1{-# language GADTs #-}

2+{-# language LambdaCase #-}

2{-# language NamedFieldPuns #-}

3{-# language NamedFieldPuns #-}

3

4

4module Rel8.Query.Maybe

5module Rel8.Query.Maybe

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

18import qualified Opaleye.Internal.MaybeFields as Opaleye

19import qualified Opaleye.Internal.MaybeFields as Opaleye

19

20

20-- rel8

21-- rel8

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

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

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

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

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

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

24import Rel8.Query ( Query )

25import Rel8.Query ( Query )

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

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

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

55--

56--

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

57-- 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

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

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

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

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

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

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

61-- back.

62-- back.

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

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

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

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

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

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

66+ MaybeTable (E output) b -> do

65− where_ $ output ==. input

67+ where_ $ output ==. input

66− pure $ MaybeTable (E input) b

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 )

23import qualified Opaleye.Internal.Sql as Opaleye

24

25-- rel8

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

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

27import Rel8.Expr.Opaleye ( toPrimExpr )

28import Rel8.Query ( Query )

29import Rel8.Query.Opaleye ( toOpaleye )

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

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

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

32import Rel8.Table ( Table, toColumns )

33+import Rel8.Table.Cols ( toCols )

33import Rel8.Table.Name ( namesFromLabels )

34import Rel8.Table.Name ( namesFromLabels )

34import Rel8.Table.Opaleye ( castTable )

35import Rel8.Table.Opaleye ( castTable )

35

36

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

42

43

43sqlForQuery :: Table Expr a

44sqlForQuery :: Table Expr a

44 => Query a -> Maybe String

45 => Query a -> Maybe String

45−sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toColumns

46+sqlForQuery = sqlForQueryWithNames namesFromLabels . fmap toCols

46

47

48

48sqlForQueryWithNames :: Selects names exprs

49sqlForQueryWithNames :: Selects names exprs

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

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

25import qualified Opaleye.Internal.Tag as Opaleye

26

27-- rel8

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

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

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

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

31import 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

25

26-- rel8

27import Rel8.Aggregate

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

28+ ( Aggregate( A, Aggregate )

29 , foldInputs, mapInputs

30 )

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

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

32import Rel8.Expr.Bool ( boolExpr )

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

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

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

36import qualified Rel8.Schema.Kind as K

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

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

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

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

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

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

41

42

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

88

89guarder :: ()

90 => SContext context

91− -> Col context ('Spec tag)

91+ -> context ('Spec tag)

92 -> (tag -> Bool)

93 -> (Expr tag -> Expr Bool)

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

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

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

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

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

97 A $

98 mapInputs (toPrimExpr . run . fromPrimExpr) $

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

113nullifier :: ()

114 => Nullifiability context

115 -> SSpec ('Spec a)

116− -> Col context ('Spec a)

116+ -> context ('Spec a)

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

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

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

119 A $ Aggregate $ snullify nullity <$> a

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

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

124unnullifier :: ()

125 => Nullifiability context

126 -> SSpec ('Spec a)

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

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

128− -> Col context ('Spec a)

128+ -> context ('Spec a)

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

130 A $ Aggregate $ sunnullify nullity <$> a

131unnullifier 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

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

130

131

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

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

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

134 type GHColumns rep :: K.HTable

135 toGHColumns :: rep x -> GHColumns rep context

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

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

1{-# language StandaloneKindSignatures #-}

2

3−module Rel8.Schema.Kind

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

4− ( Context, Rel8able

5− , HContext, HTable

6− )

7−where

8

4

9-- base

5-- base

10import Data.Kind ( Type )

6import Data.Kind ( Type )

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

14import Rel8.Schema.Spec ( Spec )

10import Rel8.Schema.Spec ( Spec )

15

11

16

12

17−type HContext :: Type

13+type Context :: Type

18−type HContext = Spec -> Type

14+type Context = Spec -> Type

19

15

20

16

21type HTable :: Type

17type 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

30

19

31

20

32type Rel8able :: Type

21type Rel8able :: Type

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

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

14

15module Rel8.Schema.Name

16 ( Name(..)

17− , Col( N, unN )

18 , Selects

17 , Selects

19 )

18 )

20where

19where

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

26

25

27-- rel8

26-- rel8

28import Rel8.Expr ( Expr )

27import Rel8.Expr ( Expr )

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

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

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

31import Rel8.Schema.Null ( Sql )

29import Rel8.Schema.Null ( Sql )

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

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

33import Rel8.Schema.Spec ( Spec( Spec ) )

31import Rel8.Schema.Spec ( Spec( Spec ) )

34import Rel8.Table

32import Rel8.Table

35 ( Table, Columns, Context, fromColumns, toColumns

33 ( Table, Columns, Context, fromColumns, toColumns

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

45-- a 'TableSchema' value.

43-- a 'TableSchema' value.

46type Name :: k -> Type

44type Name :: k -> Type

47data Name a where

45data 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)

49

48

50

49

51deriving stock instance Show (Name a)

50deriving stock instance Show (Name a)

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

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

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

76

75

77

76

78−instance Interpretation Name where

79− data Col Name _spec where

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

81−

82−

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

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

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

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

85type Selects :: Type -> Type -> Constraint

79type Selects :: Type -> Type -> Constraint

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

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

1{-# language DataKinds #-}

2+{-# language EmptyCase #-}

2{-# language GADTs #-}

3{-# language GADTs #-}

4+{-# language LambdaCase #-}

3{-# language NamedFieldPuns #-}

5{-# language NamedFieldPuns #-}

6+{-# language PolyKinds #-}

4{-# language StandaloneKindSignatures #-}

7{-# language StandaloneKindSignatures #-}

5{-# language TypeFamilies #-}

8{-# language TypeFamilies #-}

6

9

7module Rel8.Schema.Result

10module Rel8.Schema.Result

8− ( Col( R, unR ), Result

11+ ( Result( R, unR )

12+ , NotResult( NotResult ), absurd

9 , null, nullifier, unnullifier

13 , null, nullifier, unnullifier

10 , vectorizer, unvectorizer

14 , vectorizer, unvectorizer

11 )

15 )

12where

16where

13

17

14-- base

18-- base

19+import Data.Kind ( Type )

15import Prelude hiding ( null )

20import Prelude hiding ( null )

16

21

17-- rel8

22-- rel8

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

19import Rel8.Schema.Kind ( Context )

23import Rel8.Schema.Kind ( Context )

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

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

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

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

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

25--

29--

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

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

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

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

28−type Result :: Context

32+type Result :: k -> Type

29−data Result a

33+data Result a where

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

30

35

31

36

32−instance Interpretation Result where

37+type IsResult :: Context -> Bool

33− data Col Result _spec where

38+type family IsResult context where

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

39+ IsResult Result = 'True

40+ IsResult _ = 'False

35

41

36

42

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+

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

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

38null = R Nothing

53null = R Nothing

39

54

40

55

41nullifier :: ()

56nullifier :: ()

42 => SSpec ('Spec a)

57 => SSpec ('Spec a)

43− -> Col Result ('Spec a)

58+ -> Result ('Spec a)

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

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

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

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

46 Null -> a

61 Null -> a

47 NotNull -> Just a

62 NotNull -> Just a

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

49

64

50unnullifier :: ()

65unnullifier :: ()

51 => SSpec ('Spec a)

66 => SSpec ('Spec a)

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

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

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

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

54unnullifier SSpec {nullity} (R a) =

69unnullifier SSpec {nullity} (R a) =

55 case nullity of

70 case nullity of

56 Null -> pure $ R a

71 Null -> pure $ R a

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

59

74

60vectorizer :: Functor f

75vectorizer :: Functor f

61 => SSpec ('Spec a)

76 => SSpec ('Spec a)

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

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

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

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

64vectorizer _ = R . fmap unR

79vectorizer _ = R . fmap unR

65

80

66

81

67unvectorizer :: Functor f

82unvectorizer :: Functor f

68 => SSpec ('Spec a)

83 => SSpec ('Spec a)

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

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

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

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

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

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

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

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

32import Rel8.Schema.Name ( Selects )

33import Rel8.Schema.Table ( TableSchema )

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

35−import Rel8.Table ( fromColumns, toColumns )

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

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

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

38

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

69 prepare = False

70 sql = Opaleye.arrangeDeleteSql from' where'

71 where

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

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

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

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

74

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

76 where

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

83 sql =

84 Opaleye.arrangeDeleteReturningSql unpackspec from' where' project'

85 where

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

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

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

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

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

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

89 where

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

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

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

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

33import Rel8.Schema.Name ( Selects )

34import Rel8.Schema.Table ( TableSchema )

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

36−import Rel8.Table ( fromColumns, toColumns )

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

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

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

39

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

84 prepare = False

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

86 where

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

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

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

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

89

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

91 where

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

103 project'

104 onConflict'

105 where

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

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

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

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

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

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

109

110 where

111 onConflict' =

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

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

31import Rel8.Schema.Name ( Selects )

32import Rel8.Schema.Table ( TableSchema )

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

34−import Rel8.Table ( fromColumns, toColumns )

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

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

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

37

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

70 prepare = False

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

72 where

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

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

74− set' = toColumns . set . fromColumns

74+ set' = toCols . set . fromCols

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

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

76

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

78 where

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

90 where'

91 project'

92 where

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

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

94− set' = toColumns . set . fromColumns

94+ set' = toCols . set . fromCols

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

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

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

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

97

98 where

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

src/Rel8/Table.hs+12−27

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

33 , gfromColumns, gtoColumns, gfromResult, gtoResult

34 )

35import Rel8.Generic.Record ( Record(..) )

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

37import Rel8.Schema.HTable ( HTable )

36import Rel8.Schema.HTable ( HTable )

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

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

39import qualified Rel8.Schema.Kind as K

38import qualified Rel8.Schema.Kind as K

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

64 -- corresponding Haskell type.

63 -- corresponding Haskell type.

65 type FromExprs a :: Type

64 type FromExprs a :: Type

66

65

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

66+ toColumns :: a -> Columns a context

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

67+ fromColumns :: Columns a context -> a

69

68

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

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

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

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

72

71

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

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

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

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

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

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

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

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

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

81 )

80 )

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

81+ => a -> Columns a context

83 toColumns =

82 toColumns =

84 gtoColumns

83 gtoColumns

85 @(TTable context)

84 @(TTable context)

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

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

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

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

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

96 )

95 )

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

96+ => Columns a context -> a

98 fromColumns =

97 fromColumns =

99 unrecord .

98 unrecord .

100 to .

99 to .

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

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

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

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

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

112 )

111 )

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

112+ => FromExprs a -> Columns a Result

114 toResult =

113 toResult =

115 gtoResult

114 gtoResult

116 @(TTable context)

115 @(TTable context)

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

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

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

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

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

129 )

128 )

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

129+ => Columns a Result -> FromExprs a

131 fromResult =

130 fromResult =

132 unrecord .

131 unrecord .

133 to .

132 to .

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

172type instance Eval (TFromExprs a) = FromExprs a

171type instance Eval (TFromExprs a) = FromExprs a

173

172

174

173

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−

189-- | Any context is trivially a table.

174-- | Any context is trivially a table.

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

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

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

176+ type Columns (context spec) = HIdentity spec

192− type Context (Col context spec) = context

177+ type Context (context spec) = context

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

178+ type FromExprs (context spec) = Result spec

194

179

195 toColumns = HIdentity

180 toColumns = HIdentity

196 fromColumns = unHIdentity

181 fromColumns = unHIdentity

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

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

8{-# language StandaloneKindSignatures #-}

9{-# language TypeApplications #-}

10{-# language TypeFamilies #-}

11+{-# language TypeFamilyDependencies #-}

11{-# language UndecidableInstances #-}

12{-# language UndecidableInstances #-}

12{-# language UndecidableSuperClasses #-}

13{-# language UndecidableSuperClasses #-}

13

14

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

53 )

54 )

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

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

55import qualified Rel8.Kind.Algebra as K

56import qualified Rel8.Kind.Algebra as K

56−import Rel8.Schema.Context ( Col )

57+import Rel8.Schema.Context.Virtual

57import Rel8.Schema.HTable ( HTable )

58import Rel8.Schema.HTable ( HTable )

58import qualified Rel8.Schema.Kind as K

59import qualified Rel8.Schema.Kind as K

59import Rel8.Schema.Name ( Name )

60import Rel8.Schema.Name ( Name )

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

65

66

67

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

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

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

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

69

70

71

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

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

72 type GColumns (ADT t) = GColumnsADT t

73 type GColumns (ADT t) = GColumnsADT t

73 type GFromExprs (ADT t) = t Result

74 type GFromExprs (ADT t) = t Result

74

75

75− gfromColumns _ = ADT

76+ gfromColumns VAggregate = ADT

77+ gfromColumns VExpr = ADT

78+ gfromColumns VName = ADT

79+

76− gtoColumns _ (ADT a) = a

80+ gtoColumns VAggregate (ADT a) = a

81+ gtoColumns VExpr (ADT a) = a

82+ gtoColumns VName (ADT a) = a

77

83

78 gfromResult =

84 gfromResult =

79 unrecord .

85 unrecord .

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

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

16import Prelude

17

18-- rel8

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

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

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

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

21import Rel8.Expr.Aggregate

22 ( groupByExpr

23 , slistAggExpr

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

44

45

46hgroupBy :: HTable t

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

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

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

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

49 case hfield eqs field of

50 Dict -> case hfield exprs field of

51 E expr -> A $ groupByExpr expr

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

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

13import Prelude

14

15-- rel8

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

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

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

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

19import 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 #-}

7+

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 )

32import Control.Comonad ( extract )

33

34-- rel8

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

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

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

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

37import Rel8.Expr.Aggregate ( groupByExpr )

38import Rel8.Expr.Serialize ( litExpr )

39import Rel8.Kind.Context ( Reifiable )

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

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

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

45import qualified Rel8.Schema.Kind as K

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

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

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

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

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

49import Rel8.Table

50 ( Table, Columns, Context, fromColumns, toColumns

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

72-- adapted to work with Rel8.

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

74data EitherTable context a b = EitherTable

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

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

76 , left :: Nullify context a

77 , right :: Nullify context b

78 }

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

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

28import Prelude

29

30-- rel8

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

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

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

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

34import Rel8.FCF ( Eval, Exp )

35import Rel8.Generic.Record ( Record )

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

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

38−import Rel8.Schema.HTable

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

39− ( HTable, HConstrainTable

40− , htabulateA, hfield, hdicts

41− )

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

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

43import Rel8.Schema.Null ( Sql )

40import Rel8.Schema.Null ( Sql )

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

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

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

73type instance Eval (TEqTable a) = EqTable a

70type instance Eval (TEqTable a) = EqTable a

74

71

75

72

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−

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

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

87 eqTable = HType Dict

74 eqTable = HType Dict

88

75

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

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

61 )

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

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

64−import Rel8.Schema.Context ( Col )

65import qualified Rel8.Schema.Kind as K

64import qualified Rel8.Schema.Kind as K

66import Rel8.Schema.HTable ( HTable )

65import Rel8.Schema.HTable ( HTable )

67import Rel8.Schema.Name ( Name )

66import Rel8.Schema.Name ( Name )

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

77

76

78

77

79type HKD :: Type -> K.Rel8able

78type HKD :: Type -> K.Rel8able

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

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

81

80

82

81

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

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

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

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

21import Prelude

22

23-- rel8

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

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

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

26import Rel8.Schema.Dict ( Dict( Dict ) )

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

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

29import qualified Rel8.Schema.Kind as K

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

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

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

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

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

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

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

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

51newtype ListTable context a =

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

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

53

54

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

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

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

31import Control.Comonad ( extract )

32

33-- rel8

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

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

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

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

36import Rel8.Expr.Aggregate ( groupByExpr )

37import Rel8.Expr.Bool ( boolExpr )

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

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

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

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

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

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

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

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

47import qualified Rel8.Schema.Null as N

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

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

49import Rel8.Schema.Spec ( Spec( Spec ) )

50import Rel8.Table

51 ( Table, Columns, Context, fromColumns, toColumns

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

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

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

82data MaybeTable context a = MaybeTable

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

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

84 , just :: Nullify context a

85 }

86 deriving stock Functor

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

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

1+{-# language DataKinds #-}

1{-# language FlexibleContexts #-}

2{-# language FlexibleContexts #-}

3+{-# language FlexibleInstances #-}

4+{-# language MultiParamTypeClasses #-}

2{-# language NamedFieldPuns #-}

5{-# language NamedFieldPuns #-}

3{-# language ScopedTypeVariables #-}

6{-# language ScopedTypeVariables #-}

4{-# language TypeApplications #-}

7{-# language TypeApplications #-}

5{-# language TypeFamilies #-}

8{-# language TypeFamilies #-}

9+{-# language UndecidableInstances #-}

6{-# language ViewPatterns #-}

10{-# language ViewPatterns #-}

7

11

8module Rel8.Table.Name

12module Rel8.Table.Name

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

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

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

26

30

27-- rel8

31-- rel8

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

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

29import Rel8.Expr.Opaleye ( toPrimExpr )

33import Rel8.Expr.Opaleye ( toPrimExpr )

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

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

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

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

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

36import 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 ) )

34

39

35

40

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

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

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

67

72

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

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

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

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

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

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

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

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

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

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

73

78

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

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

22import Prelude hiding ( id )

23

24-- rel8

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

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

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

27import Rel8.Schema.Dict ( Dict( Dict ) )

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

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

30import qualified Rel8.Schema.Kind as K

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

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

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

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

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

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

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

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

49newtype NonEmptyTable context a =

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

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

51

52

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

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

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

28import Rel8.Aggregate ( Aggregate )

29import Rel8.Expr ( Expr )

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

31−import Rel8.Schema.Context ( Col )

32import Rel8.Schema.Context.Nullify

31import Rel8.Schema.Context.Nullify

33 ( Nullifiability( NAggregate, NExpr )

32 ( Nullifiability( NAggregate, NExpr )

34 , NonNullifiability

33 , NonNullifiability

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

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

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

62data Nullify context a

61data Nullify context a

63 = Table (Nullifiability context) a

62 = Table (Nullifiability context) a

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

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

65

64

66

65

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

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

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

173

172

174

173

175guard :: (Reifiable context, HTable t)

174guard :: (Reifiable context, HTable t)

176− => Col context ('Spec tag)

175+ => context ('Spec tag)

177 -> (tag -> Bool)

176 -> (tag -> Bool)

178 -> (Expr tag -> Expr Bool)

177 -> (Expr tag -> Expr Bool)

179− -> HNullify t (Col context)

178+ -> HNullify t context

180− -> HNullify t (Col context)

179+ -> HNullify t context

181guard tag isNonNull isNonNullExpr =

180guard tag isNonNull isNonNullExpr =

182 hguard (guarder contextSing tag isNonNull isNonNullExpr)

181 hguard (guarder contextSing tag isNonNull isNonNullExpr)

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

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

1{-# language BlockArguments #-}

2+{-# language DataKinds #-}

2{-# language DisambiguateRecordFields #-}

3{-# language DisambiguateRecordFields #-}

3{-# language FlexibleContexts #-}

4{-# language FlexibleContexts #-}

4{-# language LambdaCase #-}

5{-# language LambdaCase #-}

5{-# language NamedFieldPuns #-}

6{-# language NamedFieldPuns #-}

7+{-# language RankNTypes #-}

6{-# language TypeFamilies #-}

8{-# language TypeFamilies #-}

7{-# language ViewPatterns #-}

9{-# language ViewPatterns #-}

8

10

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

35import Data.Profunctor ( dimap, lmap )

37import Data.Profunctor ( dimap, lmap )

36

38

37-- rel8

39-- rel8

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

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

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

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

40import Rel8.Expr.Opaleye

42import Rel8.Expr.Opaleye

41 ( fromPrimExpr, toPrimExpr

43 ( fromPrimExpr, toPrimExpr

42 , traversePrimExpr

44 , traversePrimExpr

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

44 , scastExpr

46 , scastExpr

45 )

47 )

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

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

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

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

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

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

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

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

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

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

51import Rel8.Table.Undefined ( undefined )

53import Rel8.Table.Undefined ( undefined )

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

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

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

89

91

90

92

91−tableFields ::Selects names exprs

93+tableFields :: Selects names exprs

92 => names -> Opaleye.TableFields exprs exprs

94 => names -> Opaleye.TableFields exprs exprs

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

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

94 unwrapApplicative $ htabulateA $ \field -> WrapApplicative $

96 unwrapApplicative $ htabulateA $ \field -> WrapApplicative $

95 case hfield names field of

97 case hfield names field of

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

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

97 where

99 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)

99 go (N (Name name)) =

101 go (N (Name name)) =

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

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

101 E . fromPrimExpr . fromColumn <$>

103 E . fromPrimExpr . fromColumn <$>

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

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

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

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

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

132 case hfield hspecs i of

134 case hfield hspecs i of

133− SSpec{info} ->

135+ SSpec{info} ->

134 case hfield as i of

136 case hfield as i of

135 E expr ->

137 E expr ->

136 E (scastExpr info expr)

138 E (scastExpr info expr)

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

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

25import Prelude hiding ( seq )

26

27-- rel8

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

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

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

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

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

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

33import Rel8.Generic.Record ( Record )

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

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

36−import Rel8.Schema.HTable

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

37− ( HTable, HConstrainTable

38− , htabulateA, hfield, hdicts

39− )

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

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

41import Rel8.Schema.Null (Sql)

38import Rel8.Schema.Null (Sql)

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

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

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

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

44import Rel8.Table.Bool ( bool )

41import Rel8.Table.Bool ( bool )

45import Rel8.Table.Eq ( EqTable )

42import Rel8.Table.Eq ( EqTable )

46−import Rel8.Type.Eq ( DBEq )

47import Rel8.Type.Ord ( DBOrd )

43import Rel8.Type.Ord ( DBOrd )

48

44

49

45

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

74type instance Eval (TOrdTable a) = OrdTable a

70type instance Eval (TOrdTable a) = OrdTable a

75

71

76

72

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−

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

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

89 ordTable = HType Dict

74 ordTable = HType Dict

90

75

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

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

16import Prelude ()

17

18-- rel8

19−import Rel8.Schema.Context ( Col )

20−import Rel8.Schema.HTable ( HTable )

21import qualified Rel8.Schema.Kind as K

19import qualified Rel8.Schema.Kind as K

22import Rel8.Schema.Spec ( KnownSpec )

20import Rel8.Schema.Spec ( KnownSpec )

23import Rel8.Table ( Table, Congruent )

21import Rel8.Table ( Table, Congruent )

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

41 , b from -> a

39 , b from -> a

42

40

43

41

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

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

45−

46−

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

48

43

49

44

50instance

45instance

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

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

44import Rel8.Type.Ord ( DBOrd )

45

46

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

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

48− type Columns (t context) = GColumns t

48+ type Columns (t g) = GColumns t

49− type Context (t context) = context

49+ type Context (t g) = g

50− type FromExprs (t context) = GFromExprs t

50+ type FromExprs (t g) = GFromExprs t

51

52 fromColumns = gfromColumns virtual

53 toColumns = gtoColumns virtual

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

60 , Virtual from

61 , Virtual to

62 , Congruent (t from) (t to)

63+ , from ~ from'

64+ , to ~ to'

63 )

65 )

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

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

65

67

66

68

67instance

69instance

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

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

10{-# language UndecidableInstances #-}

11

12module Rel8.Table.Serialize

13− ( Serializable, lit, parse

13+ ( Serializable, lit, litHTable, parse

14 , ToExprs

15 )

16where

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

24import qualified Hasql.Decoders as Hasql

25

26-- rel8

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

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

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

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

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

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

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

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

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

34import Rel8.Type ( DBType )

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

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

116

117

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) =>

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

123− ToExprs x (Col Result spec)

119+ ToExprs x (Result spec)

124

120

125

121

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

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

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

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

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

143

139

144

140

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

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

146litHTable as = htabulate $ \field ->

142litHTable as = htabulate $ \field ->

147 case hfield hspecs field of

143 case hfield hspecs field of

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

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

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

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

150

146

151

147

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

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

153parseHTable = unwrapApplicative $ htabulateA $ \field ->

149parseHTable = unwrapApplicative $ htabulateA $ \field ->

154 WrapApplicative $ case hfield hspecs field of

150 WrapApplicative $ case hfield hspecs field of

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

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

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

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

11import Prelude hiding ( undefined )

12

13-- rel8

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

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

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

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

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

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

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

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

31

32-- rel8

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

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

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

35import 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 ) )

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

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

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

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

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

41import Rel8.Table.Eq ( EqTable )

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

43import Rel8.Table.Ord ( OrdTable )

44import Rel8.Table.Rel8able ()

45−import Rel8.Table.Serialize ( lit )

45+import Rel8.Table.Serialize ( litHTable )

46import Rel8.Type ( DBType, typeInformation )

47import Rel8.Type.Eq ( DBEq )

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

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

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

69 typeInformation = TypeInformation

70 { 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

72 , typeName = compositeTypeName @a

73 }

74

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

118 names = toColumns (compositeFields @a)

119

120

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

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

122decoder = unwrapApplicative $ htabulateA \field ->

123 case hfield hspecs field of

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

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

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

128

129

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

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

131encoder a = Opaleye.FunExpr "ROW" exprs

132 where

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