0b34a14 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Clean up Serializable and introduce litTable

0b34a14Shane O'Brien6 years ago

src/Rel8/Aggregate.hs+2−2

compare with master

unifiedsplit

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

36-- rel8

37import Rel8.Expr ( Expr, Col(..) )

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

39−import Rel8.Opaque ( Opaque, Opaque1 )

39+import Rel8.Opaque ( Opaque )

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

41import Rel8.Schema.Context.Label ( Labelable(..) )

42import Rel8.Schema.Context.Nullify

@@ -146,7 +146,7 @@ instance Nullifiable Aggregate where

146type Aggregates :: Type -> Type -> Constraint

147class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

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

149−instance {-# OVERLAPPING #-} Aggregates (Opaque1 Aggregate Opaque) (Opaque1 Expr Opaque)

149+instance {-# OVERLAPPING #-} Aggregates (Opaque Aggregate Opaque) (Opaque Expr Opaque)

150

151

152foldInputs :: Monoid b

src/Rel8/Expr.hs+1−10

@@ -1,6 +1,5 @@

1{-# language DataKinds #-}

2{-# language DerivingStrategies #-}

3−{-# language FlexibleContexts #-}

4{-# language FlexibleInstances #-}

3{-# language FlexibleInstances #-}

5{-# language GADTs #-}

4{-# language GADTs #-}

6{-# language MultiParamTypeClasses #-}

5{-# language MultiParamTypeClasses #-}

@@ -16,13 +15,12 @@

16module Rel8.Expr

15module Rel8.Expr

17 ( Expr(..)

16 ( Expr(..)

18 , Col( DB, unDB )

17 , Col( DB, unDB )

19− , Encodes

20 )

18 )

21where

19where

23-- base

21-- base

24import Data.Functor.Identity ( Identity )

22import Data.Functor.Identity ( Identity )

25−import Data.Kind ( Constraint, Type )

23+import Data.Kind ( Type )

26import Data.String ( IsString, fromString )

24import Data.String ( IsString, fromString )

27import Prelude hiding ( null )

25import Prelude hiding ( null )

@@ -38,7 +36,6 @@ import Rel8.Expr.Opaleye

38 , zipPrimExprsWith

36 , zipPrimExprsWith

39 )

37 )

40import Rel8.Expr.Serialize ( litExpr )

38import Rel8.Expr.Serialize ( litExpr )

41−import Rel8.Opaque ( Opaque, Opaque1 )

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

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

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

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

44import Rel8.Schema.Context.Nullify

41import Rel8.Schema.Context.Nullify

@@ -143,9 +140,3 @@ instance Nullifiable Expr where

143 {-# INLINABLE decodeTag #-}

140 {-# INLINABLE decodeTag #-}

144 {-# INLINABLE nullifier #-}

141 {-# INLINABLE nullifier #-}

145 {-# INLINABLE unnullifier #-}

142 {-# INLINABLE unnullifier #-}

146−

147−

148−type Encodes :: Type -> Type -> Constraint

149−class Recontextualize Identity Expr a exprs => Encodes a exprs

150−instance Recontextualize Identity Expr a exprs => Encodes a exprs

151−instance {-# OVERLAPPING #-} Encodes (Opaque1 Identity Opaque) (Opaque1 Expr Opaque)

src/Rel8/Opaque.hs+3−8

@@ -1,20 +1,15 @@

1{-# language PolyKinds #-}

2{-# language StandaloneKindSignatures #-}

3+{-# language TypeFamilies #-}

4module Rel8.Opaque

5module Rel8.Opaque

5 ( Opaque

6 ( Opaque

6− , Opaque1

7 )

8where

10-- base

11−import Data.Kind ( Type )

12import Prelude ()

11import Prelude ()

15−type Opaque :: Type

14+type Opaque :: k

16−data Opaque

15+data family Opaque :: k

17−

18−

19−type Opaque1 :: k -> Type -> Type

20−data Opaque1 a x

src/Rel8/Schema/Insert.hs+2−2

@@ -31,7 +31,7 @@ import Prelude

31import Rel8.Aggregate ( Aggregate )

32import Rel8.Expr ( Expr )

33import Rel8.Kind.Necessity ( Necessity(Optional, Required) )

34−import Rel8.Opaque ( Opaque, Opaque1 )

34+import Rel8.Opaque ( Opaque )

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

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

37import Rel8.Schema.Context.Nullify

@@ -157,4 +157,4 @@ instance Nullifiable Insert where

157type Inserts :: Type -> Type -> Constraint

158class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts

159instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts

160−instance {-# OVERLAPPING #-} Inserts (Opaque1 Expr Opaque) (Opaque1 Insert Opaque)

160+instance {-# OVERLAPPING #-} Inserts (Opaque Expr Opaque) (Opaque Insert Opaque)

src/Rel8/Schema/Name.hs+2−2

@@ -29,7 +29,7 @@ import Prelude

29-- rel8

30import Rel8.Expr ( Expr )

31import Rel8.Kind.Labels ( KnownLabels, labelsSing, renderLabels )

32−import Rel8.Opaque ( Opaque, Opaque1 )

32+import Rel8.Opaque ( Opaque )

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

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

35import Rel8.Schema.Context.Nullify

@@ -109,4 +109,4 @@ nameFromLabel = case labelsSing @labels of

109type Selects :: Type -> Type -> Constraint

110class Recontextualize Name Expr names exprs => Selects names exprs

111instance Recontextualize Name Expr names exprs => Selects names exprs

112−instance {-# OVERLAPPING #-} Selects (Opaque1 Name Opaque) (Opaque1 Expr Opaque)

112+instance {-# OVERLAPPING #-} Selects (Opaque Name Opaque) (Opaque Expr Opaque)

src/Rel8/Schema/Nullability.hs+6−6

@@ -56,8 +56,8 @@ type Nullify a = Maybe (Unnullify a)

58type NotNull :: Type -> Constraint

59−class IsMaybe a ~ 'False => NotNull a

59+class (HasNullability a, IsMaybe a ~ 'False) => NotNull a

60−instance IsMaybe a ~ 'False => NotNull a

60+instance (HasNullability a, IsMaybe a ~ 'False) => NotNull a

61instance {-# OVERLAPPING #-} NotNull Opaque

@@ -76,18 +76,18 @@ data Nullability a where

76type HasNullability' :: Bool -> Type -> Constraint

77class

78 ( IsMaybe a ~ isMaybe

79− , NotNull (Unnullify a)

79+ , IsMaybe (Unnullify a) ~ 'False

80 , Nullify' isMaybe (Unnullify a) ~ a

81 ) => HasNullability' isMaybe a

82 where

83 nullabilization' :: Nullability a

86−instance NotNull a => HasNullability' 'False a where

86+instance IsMaybe a ~ 'False => HasNullability' 'False a where

87 nullabilization' = NonNullable

90−instance NotNull a => HasNullability' 'True (Maybe a) where

90+instance IsMaybe a ~ 'False => HasNullability' 'True (Maybe a) where

91 nullabilization' = Nullable

@@ -115,4 +115,4 @@ class

115 )

116 => Sql constraint a

117instance (constraint (Unnullify a), HasNullability a) => Sql constraint a

118−instance {-# OVERLAPPING #-} (constraint Opaque, Sql constraint Opaque) => Sql constraint Opaque

118+instance {-# OVERLAPPING #-} (c Opaque, Sql c Opaque) => Sql c Opaque

src/Rel8/Table.hs+4−4

@@ -21,7 +21,7 @@ import Prelude

22-- rel8

23import {-# SOURCE #-} Rel8.Expr ( Expr )

24−import Rel8.Opaque ( Opaque, Opaque1 )

24+import Rel8.Opaque ( Opaque )

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

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

27import Rel8.Schema.HTable ( HTable )

@@ -207,9 +207,9 @@ instance Table Expr Opaque where

207 toColumns = error "opaque"

208

209

210−instance Table context (Opaque1 context a) where

210+instance Table context (Opaque context a) where

211− type Columns (Opaque1 context a) = HType Opaque

211+ type Columns (Opaque context a) = HType Opaque

212− type Context (Opaque1 context a) = context

212+ type Context (Opaque context a) = context

213

214 fromColumns = error "opaque"

215 toColumns = error "opaque"

src/Rel8/Table/Recontextualize.hs+2−13

@@ -17,7 +17,7 @@ import Data.Kind ( Constraint, Type )

17import Prelude ()

19-- rel8

20−import Rel8.Opaque ( Opaque1 )

20+import Rel8.Opaque ( Opaque )

21import Rel8.Schema.Context ( Col )

22import Rel8.Schema.Context.Label ( Labelable )

23import Rel8.Schema.HTable ( HTable )

@@ -85,7 +85,7 @@ instance Sql DBType a => Recontextualize Name Insertion (Name a) (Insertion a)

85-}

88−instance Recontextualize from to (Opaque1 from a) (Opaque1 to a)

88+instance Recontextualize from to (Opaque from a) (Opaque to a)

91instance HTable t => Recontextualize from to (t (Col from)) (t (Col to))

@@ -131,14 +131,3 @@ instance

131 , Recontextualize from to a5 b5

132 , Labelable from, Labelable to

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

134−

135−

136−{-

137−

138−-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting

139−-- with the table @b@.

140−type Inserts :: Type -> Type -> Constraint

141−class Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts

142−instance Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts

143−instance {-# OVERLAPPING #-} Inserts (Opaque1 Expr Opaque) (Opaque1 Insertion Opaque)

144−-}

src/Rel8/Table/Serialize.hs+84−188

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

15module Rel8.Table.Serialize

16 ( Serializable, lit, parse

17+ , Encodes, litTable

17 )

18 )

18where

19where

@@ -28,9 +29,8 @@ import Prelude

28import qualified Hasql.Decoders as Hasql

29import qualified Hasql.Decoders as Hasql

30-- rel8

31-- rel8

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

32+import Rel8.Expr ( Expr, Col(..) )

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

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

33−import Rel8.Opaque ( Opaque )

34import Rel8.Schema.Context ( Col(..) )

35import Rel8.Schema.Context.Identity

36 ( fromHEitherTable, toHEitherTable

@@ -54,6 +54,7 @@ import Rel8.Table.Either ( EitherTable )

54import Rel8.Table.List ( ListTable )

55import Rel8.Table.Maybe ( MaybeTable )

56import Rel8.Table.NonEmpty ( NonEmptyTable )

57+import Rel8.Table.Recontextualize ( Recontextualize )

57import Rel8.Table.These ( TheseTable )

58import Rel8.Table.These ( TheseTable )

58import Rel8.Type ( DBType )

59import Rel8.Type ( DBType )

@@ -64,160 +65,44 @@ import Data.Functor.Apply ( WrappedApplicative(..) )

64import Data.These ( These )

65import Data.These ( These )

67−type IsPlainColumn :: Type -> Bool

68−type family IsPlainColumn a where

69− IsPlainColumn (Either _ _) = 'False

70− IsPlainColumn [_] = 'False

71− IsPlainColumn (Maybe _) = 'False

72− IsPlainColumn (NonEmpty _) = 'False

73− IsPlainColumn (These _ _) = 'False

74− IsPlainColumn (_, _) = 'False

75− IsPlainColumn (_, _, _) = 'False

76− IsPlainColumn (_, _, _, _) = 'False

77− IsPlainColumn (_, _, _, _, _) = 'False

78− IsPlainColumn (_ Identity) = 'False

79− IsPlainColumn (_ (Col Identity _)) = 'False

80− IsPlainColumn (Identity _) = 'False

81− IsPlainColumn _ = 'True

82−

83−

84−type IsTabular :: Type -> Bool

85−type family IsTabular a where

86− IsTabular (Either _ _) = 'True

87− IsTabular [a] = IsListTabular a

88− IsTabular (Maybe a) = IsMaybeTabular a

89− IsTabular (NonEmpty a) = IsListTabular a

90− IsTabular (These _ _) = 'True

91− IsTabular (_, _) = 'True

92− IsTabular (_, _, _) = 'True

93− IsTabular (_, _, _, _) = 'True

94− IsTabular (_, _, _, _, _) = 'True

95− IsTabular (_ Identity) = 'True

96− IsTabular (_ (Col Identity)) = 'True

97− IsTabular (Col Identity _) = 'True

98− IsTabular _ = 'False

99−

100−

101−type IsTabular' :: Bool -> Type -> Bool

102−type family IsTabular' isTabular exprs where

103− IsTabular' _ (Expr _) = 'False

104− IsTabular' 'False _ = 'False

105− IsTabular' _ _ = 'True

106−

107−

108−type IsMaybeTabular :: Type -> Bool

109−type family IsMaybeTabular a where

110− IsMaybeTabular (Maybe _) = 'True

111− IsMaybeTabular a = IsTabular a

112−

113−

114−type IsListTabular :: Type -> Bool

115−type family IsListTabular a where

116− IsListTabular (Maybe a) = IsMaybeTabular a

117− IsListTabular a = IsTabular a

118−

119−

120−type ToExprs :: Type -> Type -> Constraint

121−class ExprsFor (IsPlainColumn a) (IsTabular' (IsTabular a) exprs) a exprs => ToExprs a exprs

122−instance ExprsFor (IsPlainColumn a) (IsTabular' (IsTabular a) exprs) a exprs => ToExprs a exprs

123−

124−

125fromIdentity' :: forall exprs a. ToExprs a exprs => Columns exprs (Col Identity) -> a

68fromIdentity' :: forall exprs a. ToExprs a exprs => Columns exprs (Col Identity) -> a

126−fromIdentity' = fromIdentity @(IsPlainColumn a) @_ @_ @exprs

69+fromIdentity' = fromIdentity @_ @exprs

127

128

129toIdentity' :: forall exprs a. ToExprs a exprs => a -> Columns exprs (Col Identity)

72toIdentity' :: forall exprs a. ToExprs a exprs => a -> Columns exprs (Col Identity)

130−toIdentity' = toIdentity @(IsPlainColumn a) @_ @_ @exprs

73+toIdentity' = toIdentity @_ @exprs

131

132

133−type ExprsFor :: Bool -> Bool -> Type -> Type -> Constraint

76+type ToExprs :: Type -> Type -> Constraint

134−class (Table Expr exprs, isTabular ~ IsTabular a) =>

77+class Table Expr exprs => ToExprs a exprs where

135− ExprsFor isPlainColumn isTabular a exprs where

136 fromIdentity :: Columns exprs (Col Identity) -> a

78 fromIdentity :: Columns exprs (Col Identity) -> a

137 toIdentity :: a -> Columns exprs (Col Identity)

79 toIdentity :: a -> Columns exprs (Col Identity)

138

139

140−instance

82+instance {-# OVERLAPPABLE #-} (Sql DBType a, x ~ Expr a) => ToExprs a x where

141− ( DBType a

142− , NotNull a

143− , IsTabular a ~ 'False

144− , x ~ Expr a

145− )

146− => ExprsFor 'True 'False a x

147− where

148 fromIdentity (HType (Result a)) = a

83 fromIdentity (HType (Result a)) = a

149 toIdentity = HType . Result

84 toIdentity = HType . Result

150

151

152−instance

153− ( Sql DBType a

87+instance (Sql DBType a, x ~ [a]) => ToExprs [a] (Expr x) where

154− , IsListTabular a ~ 'False

155− , x ~ [a]

156− ) => ExprsFor 'False 'False [a] (Expr x)

157− where

158 fromIdentity (HType (Result a)) = a

88 fromIdentity (HType (Result a)) = a

159 toIdentity = HType . Result

89 toIdentity = HType . Result

160

161

162−instance

92+instance (Sql DBType a, NotNull a, x ~ Maybe a) => ToExprs (Maybe a) (Expr x)

163− ( Sql DBType a

164− , isTabular ~ 'False

165− , NotNull a

166− , IsMaybeTabular a ~ 'False

167− , x ~ Maybe a

168− ) => ExprsFor 'False 'False (Maybe a) (Expr x)

169 where

93 where

170 fromIdentity (HType (Result a)) = a

94 fromIdentity (HType (Result a)) = a

171 toIdentity = HType . Result

95 toIdentity = HType . Result

172

173

174−instance

98+instance (Sql DBType a, NotNull a, x ~ NonEmpty a) => ToExprs (NonEmpty a) (Expr x)

175− ( Sql DBType a

176− , IsListTabular a ~ 'False

177− , x ~ NonEmpty a

178− ) => ExprsFor 'False 'False (NonEmpty a) (Expr x)

179 where

99 where

180 fromIdentity (HType (Result a)) = a

100 fromIdentity (HType (Result a)) = a

181 toIdentity = HType . Result

101 toIdentity = HType . Result

182

102

183

103

184−instance

185− ( ToExprs a exprs

186− , IsListTabular a ~ 'False

187− ) => ExprsFor 'False 'False [a] (ListTable exprs)

188− where

189− fromIdentity = fmap (fromIdentity' @exprs) . fromHListTable

190− toIdentity = toHListTable . fmap (toIdentity' @exprs)

191−

192−

193−instance

194− ( ToExprs a exprs

195− , IsMaybeTabular a ~ 'False

196− ) => ExprsFor 'False 'False (Maybe a) (MaybeTable exprs)

197− where

198− fromIdentity =

199− fmap (fromIdentity' @exprs . hunlabel unlabeler) .

200− fromHMaybeTable

201− toIdentity =

202− toHMaybeTable .

203− fmap (hlabel labeler . toIdentity' @exprs)

204−

205−

206−instance

207− ( ToExprs a exprs

208− , IsListTabular a ~ 'False

209− ) => ExprsFor 'False 'False (NonEmpty a) (NonEmptyTable exprs)

210− where

211− fromIdentity = fmap (fromIdentity' @exprs) . fromHNonEmptyTable

212− toIdentity = toHNonEmptyTable . fmap (toIdentity' @exprs)

213−

214−

215−instance

216− ( ToExprs a exprs1

217− , ToExprs b exprs2

218− , isTabular ~ 'True

219− , x ~ EitherTable exprs1 exprs2

104+instance (ToExprs a exprs1, ToExprs b exprs2, x ~ EitherTable exprs1 exprs2) =>

220− ) => ExprsFor 'False isTabular (Either a b) x

105+ ToExprs (Either a b) x

221 where

106 where

222 fromIdentity =

107 fromIdentity =

223 bimap

108 bimap

@@ -231,22 +116,12 @@ instance

231 (hlabel labeler . toIdentity' @exprs2)

116 (hlabel labeler . toIdentity' @exprs2)

232

117

233

118

234−instance

235− ( ToExprs a exprs

236− , IsListTabular a ~ 'True

237− , x ~ ListTable exprs

119+instance ToExprs a exprs => ToExprs [a] (ListTable exprs) where

238− ) => ExprsFor 'False 'True [a] x

239− where

240 fromIdentity = fmap (fromIdentity' @exprs) . fromHListTable

120 fromIdentity = fmap (fromIdentity' @exprs) . fromHListTable

241 toIdentity = toHListTable . fmap (toIdentity' @exprs)

121 toIdentity = toHListTable . fmap (toIdentity' @exprs)

242

122

243

123

244−instance

124+instance ToExprs a exprs => ToExprs (Maybe a) (MaybeTable exprs) where

245− ( ToExprs a exprs

246− , IsMaybeTabular a ~ 'True

247− , x ~ MaybeTable exprs

248− ) => ExprsFor 'False 'True (Maybe a) x

249− where

250 fromIdentity =

125 fromIdentity =

251 fmap (fromIdentity' @exprs . hunlabel unlabeler) .

126 fmap (fromIdentity' @exprs . hunlabel unlabeler) .

252 fromHMaybeTable

127 fromHMaybeTable

@@ -255,22 +130,14 @@ instance

255 fmap (hlabel labeler . toIdentity' @exprs)

130 fmap (hlabel labeler . toIdentity' @exprs)

256

131

257

132

258−instance

133+instance ToExprs a exprs => ToExprs (NonEmpty a) (NonEmptyTable exprs)

259− ( ToExprs a exprs

260− , IsListTabular a ~ 'True

261− , x ~ NonEmptyTable exprs

262− ) => ExprsFor 'False 'True (NonEmpty a) x

263 where

134 where

264 fromIdentity = fmap (fromIdentity' @exprs) . fromHNonEmptyTable

135 fromIdentity = fmap (fromIdentity' @exprs) . fromHNonEmptyTable

265 toIdentity = toHNonEmptyTable . fmap (toIdentity' @exprs)

136 toIdentity = toHNonEmptyTable . fmap (toIdentity' @exprs)

266

137

267

138

268−instance

269− ( ToExprs a exprs1

270− , ToExprs b exprs2

271− , isTabular ~ 'True

272− , x ~ TheseTable exprs1 exprs2

139+instance (ToExprs a exprs1, ToExprs b exprs2, x ~ TheseTable exprs1 exprs2) =>

273− ) => ExprsFor 'False isTabular (These a b) x

140+ ToExprs (These a b) x

274 where

141 where

275 fromIdentity =

142 fromIdentity =

276 bimap

143 bimap

@@ -284,12 +151,8 @@ instance

284 (hlabel labeler . toIdentity' @exprs2)

151 (hlabel labeler . toIdentity' @exprs2)

285

152

286

153

287−instance

288− ( ToExprs a exprs1

154+instance (ToExprs a exprs1, ToExprs b exprs2, x ~ (exprs1, exprs2)) =>

289− , ToExprs b exprs2

155+ ToExprs (a, b) x

290− , isTabular ~ 'True

291− , x ~ (exprs1, exprs2)

292− ) => ExprsFor 'False isTabular (a, b) x

293 where

156 where

294 fromIdentity (HPair a b) =

157 fromIdentity (HPair a b) =

295 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

158 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

@@ -305,9 +168,8 @@ instance

305 ( ToExprs a exprs1

168 ( ToExprs a exprs1

306 , ToExprs b exprs2

169 , ToExprs b exprs2

307 , ToExprs c exprs3

170 , ToExprs c exprs3

308− , isTabular ~ 'True

309 , x ~ (exprs1, exprs2, exprs3)

171 , x ~ (exprs1, exprs2, exprs3)

310− ) => ExprsFor 'False isTabular (a, b, c) x

172+ ) => ToExprs (a, b, c) x

311 where

173 where

312 fromIdentity (HTrio a b c) =

174 fromIdentity (HTrio a b c) =

313 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

175 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

@@ -326,9 +188,8 @@ instance

326 , ToExprs b exprs2

188 , ToExprs b exprs2

327 , ToExprs c exprs3

189 , ToExprs c exprs3

328 , ToExprs d exprs4

190 , ToExprs d exprs4

329− , isTabular ~ 'True

330 , x ~ (exprs1, exprs2, exprs3, exprs4)

191 , x ~ (exprs1, exprs2, exprs3, exprs4)

331− ) => ExprsFor 'False isTabular (a, b, c, d) x

192+ ) => ToExprs (a, b, c, d) x

332 where

193 where

333 fromIdentity (HQuartet a b c d) =

194 fromIdentity (HQuartet a b c d) =

334 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

195 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

@@ -350,9 +211,8 @@ instance

350 , ToExprs c exprs3

211 , ToExprs c exprs3

351 , ToExprs d exprs4

212 , ToExprs d exprs4

352 , ToExprs e exprs5

213 , ToExprs e exprs5

353− , isTabular ~ 'True

354 , x ~ (exprs1, exprs2, exprs3, exprs4, exprs5)

214 , x ~ (exprs1, exprs2, exprs3, exprs4, exprs5)

355− ) => ExprsFor 'False isTabular (a, b, c, d, e) x

215+ ) => ToExprs (a, b, c, d, e) x

356 where

216 where

357 fromIdentity (HQuintet a b c d e) =

217 fromIdentity (HQuintet a b c d e) =

358 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

218 ( fromIdentity' @exprs1 $ hunlabel unlabeler a

@@ -370,34 +230,22 @@ instance

370 }

230 }

371

231

372

232

373−instance

374− ( HTable t

375− , isTabular ~ 'True

376− , result ~ Col Identity

233+instance (HTable t, result ~ Col Identity, x ~ t (Col Expr)) =>

377− , x ~ t (Col Expr)

234+ ToExprs (t result) x

378− ) => ExprsFor 'False isTabular (t result) x

379 where

235 where

380 fromIdentity = id

236 fromIdentity = id

381 toIdentity = id

237 toIdentity = id

382

238

383

239

384−instance

240+instance (Recontextualize Identity Expr (t Identity) (t Expr), result ~ Identity, x ~ t Expr) =>

385− ( Encodes (t Identity) (t Expr)

241+ ToExprs (t result) x

386− , isTabular ~ 'True

387− , result ~ Identity

388− , x ~ t Expr

389− ) => ExprsFor 'False isTabular (t result) x

390 where

242 where

391 fromIdentity = fromColumns

243 fromIdentity = fromColumns

392 toIdentity = toColumns

244 toIdentity = toColumns

393

245

394

246

395−instance

396− ( KnownSpec spec

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

397− , isTabular ~ 'True

398− , isSpecial ~ 'True

399− , x ~ Col Expr spec

400− ) => ExprsFor 'False isTabular (Col Identity spec) x

248+ ToExprs (Col Identity spec) x

401 where

249 where

402 fromIdentity = fromColumns

250 fromIdentity = fromColumns

403 toIdentity = toColumns

251 toIdentity = toColumns

@@ -425,27 +273,75 @@ type family FromExprs a where

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

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

426-- @sql@, which contains SQL expressions, and the type @haskell@, which

274-- @sql@, which contains SQL expressions, and the type @haskell@, which

427-- contains the Haskell decoding of rows containing @sql@ SQL expressions.

275-- contains the Haskell decoding of rows containing @sql@ SQL expressions.

276+type Serializable :: Type -> Type -> Constraint

428class (ToExprs a exprs, a ~ FromExprs exprs) => Serializable exprs a | exprs -> a

277class (ToExprs a exprs, a ~ FromExprs exprs) => Serializable exprs a | exprs -> a

429instance (ToExprs a exprs, a ~ FromExprs exprs) => Serializable exprs a

278instance (ToExprs a exprs, a ~ FromExprs exprs) => Serializable exprs a

430−instance Serializable (Expr Opaque) Opaque

279+instance {-# OVERLAPPING #-} Sql DBType a => Serializable (Expr a) a

431

280

432

281

433lit :: forall exprs a. Serializable exprs a => a -> exprs

282lit :: forall exprs a. Serializable exprs a => a -> exprs

434−lit = fromColumns . litTable . toIdentity' @exprs

283+lit = fromColumns . litHTable . toIdentity' @exprs

435

284

436

285

437parse :: forall exprs a. Serializable exprs a => Hasql.Row a

286parse :: forall exprs a. Serializable exprs a => Hasql.Row a

438−parse = fromIdentity' @exprs <$> parseTable

287+parse = fromIdentity' @exprs <$> parseHTable

288+

289+

290+type Encodes :: Type -> Type -> Constraint

291+class Serializable exprs a => Encodes a exprs | a -> exprs, exprs -> a

292+

293+

294+instance KnownSpec spec => Encodes (Col Identity spec) (Col Expr spec)

295+

296+

297+instance Serializable (t Identity) (t Expr) => Encodes (t Expr) (t Identity)

298+

299+

300+instance HTable t => Encodes (t (Col Identity)) (t (Col Expr))

301+

302+

303+instance (Encodes a x, Encodes b y) => Encodes (Either a b) (EitherTable x y)

304+

305+

306+instance Encodes a x => Encodes [a] (ListTable x)

307+

308+

309+instance Encodes a x => Encodes (Maybe a) (MaybeTable x)

310+

311+

312+instance Encodes a x => Encodes (NonEmpty a) (NonEmptyTable x)

313+

314+

315+instance (Encodes a x, Encodes b y) => Encodes (These a b) (TheseTable x y)

316+

317+

318+instance (Encodes a x, Encodes b y) => Encodes (a, b) (x, y)

319+

320+

321+instance (Encodes a x, Encodes b y, Encodes c z) =>

322+ Encodes (a, b, c) (x, y, z)

323+

324+

325+instance (Encodes a w, Encodes b x, Encodes c y, Encodes d z) =>

326+ Encodes (a, b, c, d) (w, x, y, z)

327+

328+

329+instance (Encodes a v, Encodes b w, Encodes c x, Encodes d y, Encodes e z) =>

330+ Encodes (a, b, c, d, e) (v, w, x, y, z)

331+

332+

333+litTable :: Encodes a exprs => a -> exprs

334+litTable = lit

439

335

440

336

441−litTable :: Encodes a b => a -> b

337+litHTable :: HTable t => t (Col Identity) -> t (Col Expr)

442−litTable (toColumns -> as) = fromColumns $ htabulate $ \field ->

338+litHTable as = htabulate $ \field ->

443 case hfield hspecs field of

339 case hfield hspecs field of

444 SSpec {nullability, info} -> case hfield as field of

340 SSpec {nullability, info} -> case hfield as field of

445 Result value -> DB (slitExpr nullability info value)

341 Result value -> DB (slitExpr nullability info value)

446

342

447

343

448−parseTable :: Table Identity a => Hasql.Row a

344+parseHTable :: HTable t => Hasql.Row (t (Col Identity))

449−parseTable = fmap fromColumns $ unwrapApplicative $ htabulateA $ \field ->

345+parseHTable = unwrapApplicative $ htabulateA $ \field ->

450 WrapApplicative $ case hfield hspecs field of

346 WrapApplicative $ case hfield hspecs field of

451 SSpec {nullability, info} -> Result <$> sparseValue nullability info

347 SSpec {nullability, info} -> Result <$> sparseValue nullability info

src/Rel8/Type.hs+11−1

@@ -1,7 +1,9 @@

1{-# language FlexibleInstances #-}

2+{-# language MultiParamTypeClasses #-}

2{-# language StandaloneKindSignatures #-}

3{-# language StandaloneKindSignatures #-}

3{-# language TypeApplications #-}

4{-# language TypeApplications #-}

4{-# language UndecidableInstances #-}

5{-# language UndecidableInstances #-}

6+{-# language UndecidableInstances #-}

6module Rel8.Type

8module Rel8.Type

7 ( DBType (typeInformation)

9 ( DBType (typeInformation)

@@ -36,7 +38,11 @@ import qualified Opaleye.Internal.HaskellDB.Sql.Default as Opaleye ( quote )

37-- rel8

39-- rel8

38import Rel8.Opaque ( Opaque )

40import Rel8.Opaque ( Opaque )

39−import Rel8.Schema.Nullability ( NotNull, Sql, nullabilization )

41+import Rel8.Schema.Nullability

42+ ( NotNull, Unnullify

43+ , HasNullability, nullabilization

44+ , Sql

45+ )

40import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )

46import Rel8.Type.Array ( listTypeInformation, nonEmptyTypeInformation )

41import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )

47import Rel8.Type.Information ( TypeInformation(..), mapTypeInformation )

@@ -311,3 +317,7 @@ instance Sql DBType a => DBType (NonEmpty a) where

311

317

312instance {-# OVERLAPPING #-} DBType Opaque where

318instance {-# OVERLAPPING #-} DBType Opaque where

313 typeInformation = error "opaque"

319 typeInformation = error "opaque"

320+

321+

322+instance {-# INCOHERENT #-} (HasNullability a, DBType (Unnullify a)) =>

323+ Sql DBType a

src/Rel8/Type/Eq.hs+6−1

@@ -1,5 +1,6 @@

1{-# language FlexibleContexts #-}

2{-# language FlexibleInstances #-}

3+{-# language MultiParamTypeClasses #-}

3{-# language StandaloneKindSignatures #-}

4{-# language StandaloneKindSignatures #-}

4{-# language UndecidableInstances #-}

5{-# language UndecidableInstances #-}

@@ -26,7 +27,7 @@ import Data.CaseInsensitive ( CI )

27-- rel8

28-- rel8

28import Rel8.Opaque ( Opaque )

29import Rel8.Opaque ( Opaque )

29−import Rel8.Schema.Nullability ( Sql )

30+import Rel8.Schema.Nullability ( Unnullify, HasNullability, Sql )

30import Rel8.Type ( DBType )

31import Rel8.Type ( DBType )

32-- scientific

33-- scientific

@@ -107,3 +108,7 @@ instance DBEq Value

107instance Sql DBEq a => DBEq [a]

108instance Sql DBEq a => DBEq [a]

108instance Sql DBEq a => DBEq (NonEmpty a)

109instance Sql DBEq a => DBEq (NonEmpty a)

109instance DBEq Opaque

110instance DBEq Opaque

111+

112+

113+instance {-# INCOHERENT #-} (HasNullability a, DBEq (Unnullify a)) =>

114+ Sql DBEq a

src/Rel8/Type/Monoid.hs+9−1

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

1{-# language DataKinds #-}

2{-# language FlexibleContexts #-}

3{-# language FlexibleInstances #-}

4+{-# language MultiParamTypeClasses #-}

4{-# language OverloadedStrings #-}

5{-# language OverloadedStrings #-}

5{-# language StandaloneKindSignatures #-}

6{-# language StandaloneKindSignatures #-}

6{-# language TypeFamilies #-}

7{-# language TypeFamilies #-}

@@ -26,7 +27,10 @@ import Data.CaseInsensitive ( CI )

26import {-# SOURCE #-} Rel8.Expr ( Expr )

27import {-# SOURCE #-} Rel8.Expr ( Expr )

27import Rel8.Expr.Array ( sempty )

28import Rel8.Expr.Array ( sempty )

28import Rel8.Expr.Serialize ( litExpr )

29import Rel8.Expr.Serialize ( litExpr )

29−import Rel8.Schema.Nullability ( Sql, nullabilization )

30+import Rel8.Schema.Nullability

31+ ( Unnullify

32+ , Sql, HasNullability, nullabilization

33+ )

30import Rel8.Type ( DBType, typeInformation )

34import Rel8.Type ( DBType, typeInformation )

31import Rel8.Type.Semigroup ( DBSemigroup )

35import Rel8.Type.Semigroup ( DBSemigroup )

@@ -80,3 +84,7 @@ instance DBMonoid ByteString where

81instance DBMonoid Lazy.ByteString where

85instance DBMonoid Lazy.ByteString where

82 memptyExpr = litExpr ""

86 memptyExpr = litExpr ""

87+

88+

89+instance {-# INCOHERENT #-} (HasNullability a, DBMonoid (Unnullify a)) =>

90+ Sql DBMonoid a

src/Rel8/Type/Num.hs+17

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

1{-# language DataKinds #-}

2+{-# language FlexibleContexts #-}

3+{-# language FlexibleInstances #-}

4+{-# language MultiParamTypeClasses #-}

2{-# language StandaloneKindSignatures #-}

5{-# language StandaloneKindSignatures #-}

3{-# language TypeFamilies #-}

6{-# language TypeFamilies #-}

7+{-# language UndecidableInstances #-}

5module Rel8.Type.Num

9module Rel8.Type.Num

6 ( DBNum, DBIntegral, DBFractional

10 ( DBNum, DBIntegral, DBFractional

@@ -13,6 +17,7 @@ import Data.Kind ( Constraint, Type )

13import Prelude

17import Prelude

15-- rel8

19-- rel8

20+import Rel8.Schema.Nullability ( HasNullability, Unnullify, Sql )

16import Rel8.Type ( DBType )

21import Rel8.Type ( DBType )

18-- scientific

23-- scientific

@@ -31,6 +36,10 @@ instance DBNum Double

31instance DBNum Scientific

36instance DBNum Scientific

39+instance {-# INCOHERENT #-} (HasNullability a, DBNum (Unnullify a)) =>

40+ Sql DBNum a

41+

42+

34type DBIntegral :: Type -> Constraint

43type DBIntegral :: Type -> Constraint

35class DBNum a => DBIntegral a

44class DBNum a => DBIntegral a

36instance DBIntegral Int16

45instance DBIntegral Int16

@@ -38,8 +47,16 @@ instance DBIntegral Int32

38instance DBIntegral Int64

47instance DBIntegral Int64

50+instance {-# INCOHERENT #-} (HasNullability a, DBIntegral (Unnullify a)) =>

51+ Sql DBIntegral a

52+

53+

41-- | The class of database types that support the @/@ operator.

54-- | The class of database types that support the @/@ operator.

42class DBNum a => DBFractional a

55class DBNum a => DBFractional a

43instance DBFractional Float

56instance DBFractional Float

44instance DBFractional Double

57instance DBFractional Double

45instance DBFractional Scientific

58instance DBFractional Scientific

59+

60+

61+instance {-# INCOHERENT #-} (HasNullability a, DBFractional (Unnullify a)) =>

62+ Sql DBFractional a

src/Rel8/Type/Ord.hs+14−1

@@ -1,5 +1,6 @@

1{-# language FlexibleContexts #-}

2{-# language FlexibleInstances #-}

3+{-# language MultiParamTypeClasses #-}

3{-# language StandaloneKindSignatures #-}

4{-# language StandaloneKindSignatures #-}

4{-# language UndecidableInstances #-}

5{-# language UndecidableInstances #-}

@@ -24,7 +25,7 @@ import Data.CaseInsensitive ( CI )

25-- rel8

26-- rel8

26import Rel8.Opaque ( Opaque )

27import Rel8.Opaque ( Opaque )

27−import Rel8.Schema.Nullability ( Sql )

28+import Rel8.Schema.Nullability ( Unnullify, Sql, HasNullability )

28import Rel8.Type.Eq ( DBEq )

29import Rel8.Type.Eq ( DBEq )

30-- scientific

31-- scientific

@@ -73,6 +74,10 @@ instance Sql DBOrd a => DBOrd (NonEmpty a)

73instance {-# OVERLAPPING #-} DBOrd Opaque

74instance {-# OVERLAPPING #-} DBOrd Opaque

77+instance {-# INCOHERENT #-} (HasNullability a, DBOrd (Unnullify a)) =>

78+ Sql DBOrd a

79+

80+

76-- | The class of database types that support the @max@ aggregation function.

81-- | The class of database types that support the @max@ aggregation function.

77type DBMax :: Type -> Constraint

82type DBMax :: Type -> Constraint

78class DBOrd a => DBMax a

83class DBOrd a => DBMax a

@@ -100,6 +105,10 @@ instance Sql DBMax a => DBMax [a]

100instance Sql DBMax a => DBMax (NonEmpty a)

105instance Sql DBMax a => DBMax (NonEmpty a)

101

106

102

107

108+instance {-# INCOHERENT #-} (HasNullability a, DBMax (Unnullify a)) =>

109+ Sql DBMax a

110+

111+

103-- | The class of database types that support the @min@ aggregation function.

112-- | The class of database types that support the @min@ aggregation function.

104type DBMin :: Type -> Constraint

113type DBMin :: Type -> Constraint

105class DBOrd a => DBMin a

114class DBOrd a => DBMin a

@@ -125,3 +134,7 @@ instance DBMin ByteString

125instance DBMin Lazy.ByteString

134instance DBMin Lazy.ByteString

126instance Sql DBMin a => DBMin [a]

135instance Sql DBMin a => DBMin [a]

127instance Sql DBMin a => DBMin (NonEmpty a)

136instance Sql DBMin a => DBMin (NonEmpty a)

137+

138+

139+instance {-# INCOHERENT #-} (HasNullability a, DBMin (Unnullify a)) =>

140+ Sql DBMin a

src/Rel8/Type/Semigroup.hs+6−1

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

1{-# language DataKinds #-}

2{-# language FlexibleContexts #-}

3{-# language FlexibleInstances #-}

4+{-# language MultiParamTypeClasses #-}

4{-# language ScopedTypeVariables #-}

5{-# language ScopedTypeVariables #-}

5{-# language StandaloneKindSignatures #-}

6{-# language StandaloneKindSignatures #-}

6{-# language TypeApplications #-}

7{-# language TypeApplications #-}

@@ -30,7 +31,7 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

30-- rel8

31-- rel8

31import {-# SOURCE #-} Rel8.Expr ( Expr )

32import {-# SOURCE #-} Rel8.Expr ( Expr )

32import Rel8.Expr.Opaleye ( zipPrimExprsWith )

33import Rel8.Expr.Opaleye ( zipPrimExprsWith )

33−import Rel8.Schema.Nullability ( Sql )

34+import Rel8.Schema.Nullability ( Unnullify, Sql, HasNullability )

34import Rel8.Type ( DBType )

35import Rel8.Type ( DBType )

36-- text

37-- text

@@ -88,3 +89,7 @@ instance DBSemigroup ByteString where

89instance DBSemigroup Lazy.ByteString where

90instance DBSemigroup Lazy.ByteString where

90 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))

91 (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))

92+

93+

94+instance {-# INCOHERENT #-} (HasNullability a, DBSemigroup (Unnullify a)) =>

95+ Sql DBSemigroup a

src/Rel8/Type/String.hs+8

@@ -1,5 +1,8 @@

1+{-# language FlexibleContexts #-}

1{-# language FlexibleInstances #-}

2{-# language FlexibleInstances #-}

3+{-# language MultiParamTypeClasses #-}

2{-# language StandaloneKindSignatures #-}

4{-# language StandaloneKindSignatures #-}

5+{-# language UndecidableInstances #-}

4module Rel8.Type.String

7module Rel8.Type.String

5 ( DBString

8 ( DBString

@@ -18,6 +21,7 @@ import qualified Data.ByteString.Lazy as Lazy ( ByteString )

18import Data.CaseInsensitive ( CI )

21import Data.CaseInsensitive ( CI )

20-- rel8

23-- rel8

24+import Rel8.Schema.Nullability ( HasNullability, Unnullify, Sql )

21import Rel8.Type ( DBType )

25import Rel8.Type ( DBType )

23-- text

27-- text

@@ -35,3 +39,7 @@ instance DBString (CI Text)

35instance DBString (CI Lazy.Text)

39instance DBString (CI Lazy.Text)

36instance DBString ByteString

40instance DBString ByteString

37instance DBString Lazy.ByteString

41instance DBString Lazy.ByteString

42+

43+

44+instance {-# INCOHERENT #-} (HasNullability a, DBString (Unnullify a)) =>

45+ Sql DBString a

src/Rel8/Type/Sum.hs+9

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

1{-# language DataKinds #-}

2+{-# language FlexibleContexts #-}

3+{-# language FlexibleInstances #-}

4+{-# language MultiParamTypeClasses #-}

2{-# language TypeFamilies #-}

5{-# language TypeFamilies #-}

3{-# language StandaloneKindSignatures #-}

6{-# language StandaloneKindSignatures #-}

7+{-# language UndecidableInstances #-}

5module Rel8.Type.Sum

9module Rel8.Type.Sum

6 ( DBSum

10 ( DBSum

@@ -13,6 +17,7 @@ import Data.Kind ( Constraint, Type )

13import Prelude

17import Prelude

15-- rel8

19-- rel8

20+import Rel8.Schema.Nullability ( HasNullability, Unnullify, Sql )

16import Rel8.Type ( DBType )

21import Rel8.Type ( DBType )

18-- scientific

23-- scientific

@@ -33,3 +38,7 @@ instance DBSum Double

33instance DBSum Scientific

38instance DBSum Scientific

34instance DBSum DiffTime

39instance DBSum DiffTime

35instance DBSum NominalDiffTime

40instance DBSum NominalDiffTime

41+

42+

43+instance {-# INCOHERENT #-} (HasNullability a, DBSum (Unnullify a)) =>

44+ Sql DBSum a

tests/Main.hs+6−22

@@ -404,19 +404,13 @@ testDBType getTestDatabase = testGroup "DBType instances"

404 ]

405

406 where

407− dbTypeTest ::

408− ( Eq a, Show a

409− , Rel8.Sql Rel8.DBType a

410− , Rel8.IsMaybe a ~ 'False

411− , Rel8.Serializable (Rel8.Expr a) a

412− , Rel8.Serializable (Rel8.Expr (Maybe a)) (Maybe a)

413− ) => TestName -> Gen a -> TestTree

407+ dbTypeTest :: (Eq a, Show a, Rel8.DBType a) => TestName -> Gen a -> TestTree

414 dbTypeTest name generator = testGroup name

408 dbTypeTest name generator = testGroup name

415 [ databasePropertyTest name (t (==) generator) getTestDatabase

409 [ databasePropertyTest name (t (==) generator) getTestDatabase

416 , databasePropertyTest ("Maybe " <> name) (t (==) (Gen.maybe generator)) getTestDatabase

410 , databasePropertyTest ("Maybe " <> name) (t (==) (Gen.maybe generator)) getTestDatabase

417 ]

411 ]

418

412

419− t :: forall a b. (Show a, Rel8.Sql Rel8.DBType a, Rel8.Serializable (Rel8.Expr a) a)

413+ t :: forall a b. (Show a, Rel8.Sql Rel8.DBType a)

420 => (a -> a -> Bool)

414 => (a -> a -> Bool)

421 -> Gen a

415 -> Gen a

422 -> ((Connection -> TestT IO ()) -> PropertyT IO b)

416 -> ((Connection -> TestT IO ()) -> PropertyT IO b)

@@ -425,7 +419,7 @@ testDBType getTestDatabase = testGroup "DBType instances"

425 x <- forAll generator

419 x <- forAll generator

426

420

427 transaction \connection -> do

421 transaction \connection -> do

428− [res] <- liftIO $ Rel8.select connection $ pure (Rel8.lit x :: Rel8.Expr a)

422+ [res] <- liftIO $ Rel8.select connection $ pure (Rel8.litExpr x)

429 diff res eq x

423 diff res eq x

430

424

431 genDay :: Gen Day

425 genDay :: Gen Day

@@ -460,23 +454,13 @@ testDBEq getTestDatabase = testGroup "DBEq instances"

460 ]

454 ]

461

455

462 where

456 where

463− dbEqTest ::

464− ( Eq a, Show a

465− , Rel8.Sql Rel8.DBEq a

466− , Rel8.IsMaybe a ~ 'False

467− , Rel8.Serializable (Rel8.Expr a) a

468− , Rel8.Serializable (Rel8.Expr (Maybe a)) (Maybe a)

469− ) => TestName -> Gen a -> TestTree

457+ dbEqTest :: (Eq a, Show a, Rel8.DBEq a) => TestName -> Gen a -> TestTree

470 dbEqTest name generator = testGroup name

458 dbEqTest name generator = testGroup name

471 [ databasePropertyTest name (t generator) getTestDatabase

459 [ databasePropertyTest name (t generator) getTestDatabase

472 , databasePropertyTest ("Maybe " <> name) (t (Gen.maybe generator)) getTestDatabase

460 , databasePropertyTest ("Maybe " <> name) (t (Gen.maybe generator)) getTestDatabase

473 ]

461 ]

474

462

475− t :: forall a.

476− ( Eq a, Show a

477− , Rel8.Sql Rel8.DBEq a

463+ t :: forall a. (Eq a, Show a, Rel8.Sql Rel8.DBEq a)

478− , Rel8.Serializable (Rel8.Expr a) a

479− )

480 => Gen a

464 => Gen a

481 -> ((Connection -> TestT IO ()) -> PropertyT IO ())

465 -> ((Connection -> TestT IO ()) -> PropertyT IO ())

482 -> PropertyT IO ()

466 -> PropertyT IO ()

@@ -484,7 +468,7 @@ testDBEq getTestDatabase = testGroup "DBEq instances"

484 (x, y) <- forAll (liftA2 (,) generator generator)

468 (x, y) <- forAll (liftA2 (,) generator generator)

485

469

486 transaction \connection -> do

470 transaction \connection -> do

487− [res] <- liftIO $ Rel8.select connection $ pure $ Rel8.lit @(Rel8.Expr a) x Rel8.==. Rel8.lit y

471+ [res] <- liftIO $ Rel8.select connection $ pure $ Rel8.litExpr x Rel8.==. Rel8.litExpr y

488 res === (x == y)

472 res === (x == y)

489

473

490 cover 1 "Equal" $ x == y

474 cover 1 "Equal" $ x == y