0f76861 · rel8 · git.iko.soy

git.iko.soy/rel8

Make all Col constructors single letter wrappers

commit0f7686152038d2c81f65a7215786581b955bbc1f authorShane O'Brien <shane.obrien@circuithub.com> dateSun 13 Jun 2021, 16:50 (5 years ago) parent5824baa

26 files changed+214−212

compare with master

unifiedsplit

src/Rel8/Aggregate.hs+8−8

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

1515 ( Aggregate(..), foldInputs, mapInputs

1616 , Aggregator(..), unsafeMakeAggregate

1717 , Aggregates

18− , Col( Aggregation )

18+ , Col( A, unA )

1919 )

2020where

2121

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

3131import qualified Opaleye.Internal.PackMap as Opaleye

3232

3333-- rel8

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

34+import Rel8.Expr ( Expr, Col( E, unE ) )

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

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

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

@@ -71,8 +71,8 @@ instance Apply Aggregate where

7171

7272instance Interpretation Aggregate where

7373 data Col Aggregate _spec where

74− Aggregation :: ()

75− => Aggregate (Expr a)

74+ A :: ()

75+ => { unA :: !(Aggregate (Expr a)) }

7676 -> Col Aggregate ('Spec labels necessity a)

7777

7878

@@ -81,10 +81,10 @@ instance Table Expr a => Table Aggregate (Aggregate a) where

8181 type Context (Aggregate a) = Aggregate

8282

8383 toColumns a = htabulate $ \field -> case hfield hspecs field of

84− SSpec {} -> Aggregation $ unDB . (`hfield` field) . toColumns <$> a

84+ SSpec {} -> A $ unE . (`hfield` field) . toColumns <$> a

8585 fromColumns as = fmap fromColumns $ htabulateA $ \field ->

8686 case hfield as field of

87− Aggregation a -> DB <$> a

87+ A a -> E <$> a

8888

8989 reify = notReify

9090 unreify = notReify

@@ -119,8 +119,8 @@ instance Sql DBType a =>

119119

120120

121121instance Labelable Aggregate where

122− labeler (Aggregation aggregate) = Aggregation aggregate

123− unlabeler (Aggregation aggregate) = Aggregation aggregate

122+ labeler (A aggregate) = A aggregate

123+ unlabeler (A aggregate) = A aggregate

124124

125125

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

src/Rel8/Aggregate/Legacy.hs+5−5

@@ -31,8 +31,8 @@ import Prelude

3131import qualified Opaleye.Aggregate as Opaleye

3232

3333-- rel8

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

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

34+import Rel8.Aggregate ( Aggregate, Aggregates, Col( A ) )

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

3636import Rel8.Expr.Aggregate ( groupByExpr, listAggExpr, nonEmptyAggExpr )

3737import Rel8.Generic.Construction ( GGAggregate', ggaggregate' )

3838import Rel8.Generic.Table ( GAlgebra )

@@ -73,7 +73,7 @@ groupBy :: forall exprs aggregates. (EqTable exprs, Aggregates aggregates exprs)

7373groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

7474 case hfield (eqTable @exprs) field of

7575 Dict -> case hfield exprs field of

76− DB expr -> Aggregation $ groupByExpr expr

76+ E expr -> A $ groupByExpr expr

7777

7878

7979-- | Aggregate rows into a single row containing an array of all aggregated

@@ -95,7 +95,7 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

9595listAgg :: Aggregates aggregates exprs => exprs -> ListTable aggregates

9696listAgg (toColumns -> exprs) = fromColumns $

9797 hvectorize

98− (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)

98+ (\_ (Identity (E a)) -> A $ listAggExpr a)

9999 (pure exprs)

100100

101101

@@ -103,7 +103,7 @@ listAgg (toColumns -> exprs) = fromColumns $

103103nonEmptyAgg :: Aggregates aggregates exprs => exprs -> NonEmptyTable aggregates

104104nonEmptyAgg (toColumns -> exprs) = fromColumns $

105105 hvectorize

106− (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)

106+ (\_ (Identity (E a)) -> A $ nonEmptyAggExpr a)

107107 (pure exprs)

108108

109109

src/Rel8/Column/Field.hs+18−18

@@ -15,8 +15,8 @@ import Data.Kind ( Type )

1515import Prelude

1616

1717-- rel8

18−import Rel8.Aggregate ( Aggregate, Col(..) )

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

18+import Rel8.Aggregate ( Aggregate, Col( A ) )

19+import Rel8.Expr ( Expr, Col( E ) )

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

2121import Rel8.Kind.Necessity

2222 ( Necessity( Required, Optional )

@@ -24,12 +24,12 @@ import Rel8.Kind.Necessity

2424 , KnownNecessity, necessitySing

2525 )

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

27−import Rel8.Schema.Insert ( Insert, Insertion(..), Col(..) )

27+import Rel8.Schema.Insert ( Insert, Insertion(..), Col( I ) )

2828import qualified Rel8.Schema.Kind as K

29−import Rel8.Schema.Name ( Name(..), Col(..) )

29+import Rel8.Schema.Name ( Name(..), Col( N ) )

3030import Rel8.Schema.Null ( Sql )

3131import Rel8.Schema.Reify ( Reify, Col(..) )

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

32+import Rel8.Schema.Result ( Col( R ), Result )

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

3434import Rel8.Table

3535 ( Table, Columns, Context, fromColumns, toColumns

@@ -84,16 +84,16 @@ sfromColumn :: ()

8484 -> Col context ('Spec labels necessity a)

8585 -> AField context necessity a

8686sfromColumn = \case

87− SAggregate -> \_ (Aggregation a) -> AField a

88− SExpr -> \_ (DB a) -> AField a

89− SResult -> \_ (Result a) -> AField a

87+ SAggregate -> \_ (A a) -> AField a

88+ SExpr -> \_ (E a) -> AField a

9089 SInsert -> \case

9190 SRequired -> \case

92− InsertCol (Insertion a) -> AField a

91+ I (Insertion a) -> AField a

9392 SOptional -> \case

94− InsertCol Default -> AField Nothing

95− InsertCol (Insertion a) -> AField (Just a)

96− SName -> \_ (NameCol a) -> AField (Name a)

93+ I Default -> AField Nothing

94+ I (Insertion a) -> AField (Just a)

95+ SName -> \_ (N a) -> AField a

96+ SResult -> \_ (R a) -> AField a

9797 SReify context ->

9898 \necessity (Reify a) -> AField (sfromColumn context necessity a)

9999

@@ -104,12 +104,12 @@ stoColumn :: ()

104104 -> AField context necessity a

105105 -> Col context ('Spec labels necessity a)

106106stoColumn = \case

107− SAggregate -> \_ (AField a) -> Aggregation a

108− SExpr -> \_ (AField a) -> DB a

109− SResult -> \_ (AField a) -> Result a

107+ SAggregate -> \_ (AField a) -> A a

108+ SExpr -> \_ (AField a) -> E a

110109 SInsert -> \case

111− SRequired -> \(AField a) -> InsertCol (Insertion a)

112− SOptional -> \(AField ma) -> InsertCol $ maybe Default Insertion ma

113− SName -> \_ (AField (Name a)) -> NameCol a

110+ SRequired -> \(AField a) -> I (Insertion a)

111+ SOptional -> \(AField ma) -> I $ maybe Default Insertion ma

112+ SName -> \_ (AField a) -> N a

113+ SResult -> \_ (AField a) -> R a

114114 SReify context ->

115115 \necessity (AField a) -> Reify (stoColumn context necessity a)

src/Rel8/Expr.hs+6−6

@@ -15,7 +15,7 @@

1515

1616module Rel8.Expr

1717 ( Expr(..)

18− , Col( DB, unDB )

18+ , Col( E, unE )

1919 )

2020where

2121

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

128128

129129instance Interpretation Expr where

130130 data Col Expr _spec where

131− DB :: {unDB :: Expr a} -> Col Expr ('Spec labels necessity a)

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

132132

133133

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

135135 type Columns (Expr a) = HType a

136136 type Context (Expr a) = Expr

137137

138− toColumns a = HType (DB a)

139− fromColumns (HType (DB a)) = a

138+ toColumns a = HType (E a)

139+ fromColumns (HType (E a)) = a

140140 reify = notReify

141141 unreify = notReify

142142

@@ -151,5 +151,5 @@ instance Sql DBType a => Recontextualize Result Expr (Identity a) (Expr a)

151151

152152

153153instance Labelable Expr where

154− labeler (DB a) = DB a

155− unlabeler (DB a) = DB a

154+ labeler (E a) = E a

155+ unlabeler (E a) = E a

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

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

3535import Prelude

3636

3737-- rel8

38−import Rel8.Aggregate ( Col( Aggregation ), Aggregate )

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

38+import Rel8.Aggregate ( Col( A ), Aggregate )

39+import Rel8.Expr ( Col( E ), Expr )

4040import Rel8.Expr.Aggregate ( groupByExpr )

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

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

@@ -64,9 +64,9 @@ import qualified Rel8.Kind.Algebra as K

6464import Rel8.Schema.Context.Nullify ( runTag )

6565import Rel8.Schema.HTable ( HTable )

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

67−import Rel8.Schema.Insert ( Col( InsertCol ), Insert, Insertion(..) )

67+import Rel8.Schema.Insert ( Col( I ), Insert, Insertion(..) )

6868import qualified Rel8.Schema.Kind as K

69−import Rel8.Schema.Name ( Col( NameCol ), Name( Name ) )

69+import Rel8.Schema.Name ( Col( N ), Name( Name ) )

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

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

7272import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify )

@@ -147,11 +147,11 @@ ggbuild gfromColumns = case algebraSing @algebra of

147147 @name

148148 @(Eval (rep (Reify Expr)))

149149 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

150− (\SSpec {info} -> Reify (DB (snull info)))

150+ (\SSpec {info} -> Reify (E (snull info)))

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

152152 Null -> id

153− NotNull -> \(Reify (DB a)) -> Reify (DB (nullify a)))

154− (HType . Reify . DB . litExpr)

153+ NotNull -> \(Reify (E a)) -> Reify (E (nullify a)))

154+ (HType . Reify . E . litExpr)

155155

156156

157157type GGInsert :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) -> Type -> Type

@@ -189,13 +189,13 @@ gginsert gfromColumns = case algebraSing @algebra of

189189 @name

190190 @(Eval (rep (Reify Insert)))

191191 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

192− (\SSpec {info} -> Reify $ InsertCol (Insertion (snull info)))

192+ (\SSpec {info} -> Reify $ I (Insertion (snull info)))

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

194194 Null -> id

195195 NotNull -> \case

196− Reify (InsertCol Default) -> Reify (InsertCol Default)

197− Reify (InsertCol (Insertion a)) -> Reify (InsertCol (Insertion (nullify a))))

198− (HType . Reify . InsertCol . Insertion . litExpr)

196+ Reify (I Default) -> Reify (I Default)

197+ Reify (I (Insertion a)) -> Reify (I (Insertion (nullify a))))

198+ (HType . Reify . I . Insertion . litExpr)

199199

200200

201201type GGConstructable :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Constraint

@@ -273,11 +273,11 @@ ggconstruct gfromColumns f = case algebraSing @algebra of

273273 @(Col (Reify Expr))

274274 @(Eval (rep (Reify Expr)))

275275 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

276− (\SSpec {info} -> Reify (DB (snull info)))

276+ (\SSpec {info} -> Reify (E (snull info)))

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

278278 Null -> id

279− NotNull -> \(Reify (DB a)) -> Reify (DB (nullify a)))

280− (HType . Reify . DB . litExpr)

279+ NotNull -> \(Reify (E a)) -> Reify (E (nullify a)))

280+ (HType . Reify . E . litExpr)

281281

282282

283283type GGDeconstruct :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type -> Type

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

306306 SSum ->

307307 gctabulate @TUnreify @(Eval (rep (Reify Expr))) @r @(a -> r) $ \constructors as ->

308308 let

309− (HType (Reify (DB tag)), cases) =

309+ (HType (Reify (E tag)), cases) =

310310 gdeconstructADT

311311 @(TTable (Reify Expr))

312312 @TColumns

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

316316 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)

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

318318 Null -> id

319− NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a)))

319+ NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a)))

320320 constructors $

321321 hreify $

322322 gtoColumns as

@@ -358,8 +358,8 @@ ggname gfromColumns = case algebraSing @algebra of

358358 @(Col (Reify Name))

359359 @(Eval (rep (Reify Name)))

360360 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

361− (\_ _ (Reify (NameCol a)) -> Reify (NameCol a))

362− (HType ((\(Name a) -> Reify (NameCol a)) tag))

361+ (\_ _ (Reify (N (Name a))) -> Reify (N (Name a)))

362+ (HType (Reify (N tag)))

363363

364364

365365type GGAggregate :: K.Algebra -> (K.Context -> Exp (Type -> Type)) -> Type -> Type

@@ -418,9 +418,9 @@ ggaggregate gfromColumns gtoColumns agg es = case algebraSing @algebra of

418418 @(Col (Reify Expr))

419419 @(Eval (rep (Reify Expr)))

420420 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

421− (\tag'' SSpec {nullity} (Reify (DB a)) ->

422− Reify $ DB $ runTag nullity (tag ==. litExpr tag'') a)

423− (HType (Reify (DB tag'))))

421+ (\tag'' SSpec {nullity} (Reify (E a)) ->

422+ Reify $ E $ runTag nullity (tag ==. litExpr tag'') a)

423+ (HType (Reify (E tag'))))

424424 (groupByExpr tag) .

425425 gftraverse @TUnreify @(Eval (rep (Reify Expr))) @_ @Aggregate (MaybeApply . Left)

426426 where

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

428428 gfindex @TUnreify @(Eval (rep (Reify Expr))) @(Aggregate a) .

429429 agg .

430430 gftabulate @(Compose Aggregate TUnreify) @(Eval (rep (Reify Expr))) @(Aggregate a)

431− (HType (Reify (DB tag)), exprs) =

431+ (HType (Reify (E tag)), exprs) =

432432 gunbuildADT

433433 @(TTable (Reify Expr))

434434 @TColumns

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

438438 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)

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

440440 Null -> id

441− NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a))) $

441+ NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a))) $

442442 hreify $

443443 gtoColumns es

444444

@@ -493,15 +493,15 @@ ggaggregate' gfromColumns gtoColumns agg es = case algebraSing @algebra of

493493 @(Col (Reify Aggregate))

494494 @(Eval (rep (Reify Aggregate)))

495495 (\(_ :: proxy x) -> toColumns . reify @_ @x Refl)

496− (\tag' SSpec {nullity} (Reify (Aggregation a)) ->

497− Reify $ Aggregation $ runTag nullity (tag ==. litExpr tag') <$> a)

498− (HType (Reify (Aggregation (groupByExpr tag))))

496+ (\tag' SSpec {nullity} (Reify (A a)) ->

497+ Reify $ A $ runTag nullity (tag ==. litExpr tag') <$> a)

498+ (HType (Reify (A (groupByExpr tag))))

499499 where

500500 f =

501501 gfindex @TUnreify @(Eval (rep (Reify Expr))) @agg .

502502 agg .

503503 gftabulate @TUnreify @(Eval (rep (Reify Aggregate))) @agg

504− (HType (Reify (DB tag)), exprs) =

504+ (HType (Reify (E tag)), exprs) =

505505 gunbuildADT

506506 @(TTable (Reify Expr))

507507 @TColumns

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

511511 (\(_ :: proxy x) -> unreify @_ @x Refl . fromColumns)

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

513513 Null -> id

514− NotNull -> \(Reify (DB a)) -> Reify (DB (unsafeUnnullify a))) $

514+ NotNull -> \(Reify (E a)) -> Reify (E (unsafeUnnullify a))) $

515515 hreify $

516516 gtoColumns es

517517

src/Rel8/Generic/Table/ADT.hs+3−3

@@ -47,7 +47,7 @@ import qualified Rel8.Schema.Kind as K

4747import Rel8.Schema.Null ( Nullify )

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

4949import Rel8.Schema.Result

50− ( Col( Result ), Result

50+ ( Col( R ), Result

5151 , null, nullifier, unnullifier

5252 )

5353import Rel8.Type.Tag ( Tag( Tag ) )

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

219219 Just rep -> M1 rep

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

221221 where

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

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

223223

224224 gtoResultADT toResult (M1 rep) =

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

226226 where

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

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

228228

229229

230230type GToExprsADT'

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

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

2323import qualified Opaleye.Internal.Sql as Opaleye

2424

2525-- rel8

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

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

2727import Rel8.Expr.Opaleye ( toPrimExpr )

2828import Rel8.Query ( Query )

2929import Rel8.Query.Opaleye ( toOpaleye )

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

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

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

3232import Rel8.Table ( Table, toColumns )

3333import Rel8.Table.Name ( namesFromLabels )

@@ -68,7 +68,7 @@ selectFrom (toColumns -> names) (toColumns . castTable -> exprs) query =

6868 where

6969 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query

7070 attributes = getConst $ htabulateA $ \field -> case hfield names field of

71− NameCol name -> case hfield exprs field of

72− DB (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))

71+ N (Name name) -> case hfield exprs field of

72+ E (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))

7373 makeAttr label expr =

7474 (Opaleye.sqlExpr expr, Just (Opaleye.SqlColumn label))

src/Rel8/Schema/Context/Label.hs+3−3

@@ -19,7 +19,7 @@ import Rel8.Schema.Context ( Interpretation )

1919import Rel8.Schema.Dict ( Dict( Dict ) )

2020import Rel8.Schema.Kind ( Context, HContext )

2121import Rel8.Schema.Spec ( Spec( Spec ) )

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

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

2323import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

2424

2525

@@ -35,8 +35,8 @@ class Interpretation context => Labelable context where

3535

3636

3737instance Labelable Result where

38− labeler (Result a) = Result a

39− unlabeler (Result a) = Result a

38+ labeler (R a) = R a

39+ unlabeler (R a) = R a

4040

4141

4242type HLabelable :: HContext -> Constraint

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

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

2525

2626-- rel8

2727import Rel8.Aggregate

28− ( Aggregate, Col(..)

28+ ( Aggregate, Col( A )

2929 , mapInputs

3030 , unsafeMakeAggregate

3131 )

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

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

3333import Rel8.Expr.Bool ( boolExpr )

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

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

3636import Rel8.Kind.Necessity ( Necessity( Required ) )

3737import Rel8.Schema.Context ( Interpretation )

3838import qualified Rel8.Schema.Kind as K

39−import Rel8.Schema.Name ( Name( Name ), Col(..) )

39+import Rel8.Schema.Name ( Name( Name ), Col( N ) )

4040import Rel8.Schema.Null ( Nullify, Nullity( Null, NotNull ), Sql )

4141import Rel8.Schema.Dict ( Dict( Dict ) )

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

@@ -81,19 +81,19 @@ class Interpretation context => Nullifiable context where

8181

8282instance Nullifiable Aggregate where

8383 encodeTag Tag {aggregator, expr} =

84− Aggregation $ unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr

84+ A $ unsafeMakeAggregate toPrimExpr fromPrimExpr aggregator expr

8585

86− decodeTag (Aggregation aggregate) = fromAggregate aggregate

86+ decodeTag (A aggregate) = fromAggregate aggregate

8787

88− nullifier Tag {expr} test SSpec {nullity} (Aggregation aggregate) =

89− Aggregation $

88+ nullifier Tag {expr} test SSpec {nullity} (A aggregate) =

89+ A $

9090 mapInputs (toPrimExpr . runTag nullity condition . fromPrimExpr) $

9191 runTag nullity condition <$> aggregate

9292 where

9393 condition = test expr

9494

95− unnullifier SSpec {nullity} (Aggregation aggregate) =

96− Aggregation $ unnull nullity <$> aggregate

95+ unnullifier SSpec {nullity} (A aggregate) =

96+ A $ unnull nullity <$> aggregate

9797

9898 {-# INLINABLE encodeTag #-}

9999 {-# INLINABLE decodeTag #-}

@@ -102,11 +102,11 @@ instance Nullifiable Aggregate where

102102

103103

104104instance Nullifiable Expr where

105− encodeTag Tag {expr} = DB expr

106− decodeTag (DB a) = fromExpr a

107− nullifier Tag {expr} test SSpec {nullity} (DB a) =

108− DB $ runTag nullity (test expr) a

109− unnullifier SSpec {nullity} (DB a) = DB $ unnull nullity a

105+ encodeTag Tag {expr} = E expr

106+ decodeTag (E a) = fromExpr a

107+ nullifier Tag {expr} test SSpec {nullity} (E a) =

108+ E $ runTag nullity (test expr) a

109+ unnullifier SSpec {nullity} (E a) = E $ unnull nullity a

110110

111111 {-# INLINABLE encodeTag #-}

112112 {-# INLINABLE decodeTag #-}

@@ -115,10 +115,10 @@ instance Nullifiable Expr where

115115

116116

117117instance Nullifiable Name where

118− encodeTag Tag {name = Name name} = NameCol name

119− decodeTag (NameCol name) = fromName (Name name)

120− nullifier _ _ _ (NameCol name) = NameCol name

121− unnullifier _ (NameCol name) = NameCol name

118+ encodeTag Tag {name} = N name

119+ decodeTag (N name) = fromName name

120+ nullifier _ _ _ (N (Name name)) = N (Name name)

121+ unnullifier _ (N (Name name)) = N (Name name)

122122

123123 {-# INLINABLE encodeTag #-}

124124 {-# INLINABLE decodeTag #-}

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

@@ -15,7 +15,7 @@

1515module Rel8.Schema.Insert

1616 ( Insert(..)

1717 , OnConflict(..)

18− , Col( InsertCol )

18+ , Col( I, unI )

1919 , Inserts

2020 , Insertion(..)

2121 )

@@ -79,7 +79,7 @@ data Insert a where

7979

8080instance Interpretation Insert where

8181 data Col Insert _spec where

82− InsertCol :: Insertion necessity a -> Col Insert ('Spec labels necessity a)

82+ I :: {unI :: !(Insertion necessity a)} -> Col Insert ('Spec labels necessity a)

8383

8484

8585type Insertion :: Necessity -> Type -> Type

@@ -94,8 +94,8 @@ instance (KnownNecessity necessity, Sql DBType a) =>

9494 type Columns (Insertion necessity a) = HIdentity ('Spec '[] necessity a)

9595 type Context (Insertion necessity a) = Insert

9696

97− toColumns = HIdentity . InsertCol

98− fromColumns (HIdentity (InsertCol a)) = a

97+ toColumns = HIdentity . I

98+ fromColumns (HIdentity (I a)) = a

9999 reify = notReify

100100 unreify = notReify

101101

@@ -132,25 +132,25 @@ instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion 'Requir

132132

133133

134134instance Labelable Insert where

135− labeler (InsertCol a) = InsertCol a

136− unlabeler (InsertCol a) = InsertCol a

135+ labeler (I a) = I a

136+ unlabeler (I a) = I a

137137

138138

139139instance Nullifiable Insert where

140− encodeTag = InsertCol . Insertion . expr

140+ encodeTag = I . Insertion . expr

141141

142− decodeTag (InsertCol (Insertion a)) = fromExpr a

142+ decodeTag (I (Insertion a)) = fromExpr a

143143

144144 nullifier Tag {expr} test SSpec {nullity} = \case

145− InsertCol Default -> InsertCol Default

146− InsertCol (Insertion a) ->

147− InsertCol $ Insertion $ runTag nullity condition a

145+ I Default -> I Default

146+ I (Insertion a) ->

147+ I $ Insertion $ runTag nullity condition a

148148 where

149149 condition = test expr

150150

151151 unnullifier SSpec {nullity} = \case

152− InsertCol Default -> InsertCol Default

153− InsertCol (Insertion a) -> InsertCol $ Insertion $ unnull nullity a

152+ I Default -> I Default

153+ I (Insertion a) -> I $ Insertion $ unnull nullity a

154154

155155 {-# INLINABLE encodeTag #-}

156156 {-# INLINABLE decodeTag #-}

src/Rel8/Schema/Name.hs+8−6

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

1414

1515module Rel8.Schema.Name

1616 ( Name(..)

17− , Col( NameCol )

17+ , Col( N, unN )

1818 , Selects

1919 )

2020where

@@ -33,6 +33,7 @@ import Rel8.Schema.HTable.Identity ( HIdentity( HType ), HType )

3333import Rel8.Schema.Null ( Sql )

3434import Rel8.Schema.Reify ( notReify )

3535import Rel8.Schema.Result ( Result )

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

3637import Rel8.Table

3738 ( Table, Columns, Context, fromColumns, toColumns, reify, unreify

3839 )

@@ -60,8 +61,8 @@ instance Sql DBType a => Table Name (Name a) where

6061 type Columns (Name a) = HType a

6162 type Context (Name a) = Name

6263

63− toColumns (Name a) = HType (NameCol a)

64− fromColumns (HType (NameCol a)) = Name a

64+ toColumns a = HType (N a)

65+ fromColumns (HType (N a)) = a

6566 reify = notReify

6667 unreify = notReify

6768

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

8283

8384

8485instance Interpretation Name where

85− newtype Col Name _spec = NameCol String

86+ data Col Name _spec where

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

8688

8789

8890instance Labelable Name where

89− labeler (NameCol a) = NameCol a

90− unlabeler (NameCol a) = NameCol a

91+ labeler (N a) = N a

92+ unlabeler (N a) = N a

9193

9294

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

src/Rel8/Schema/Result.hs+10−10

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

55{-# language TypeFamilies #-}

77module Rel8.Schema.Result

8− ( Col( Result ), Result

8+ ( Col( R, unR ), Result

99 , relabel

1010 , null, nullifier, unnullifier

1111 , vectorizer, unvectorizer

@@ -30,24 +30,24 @@ data Result a

3030

3131instance Interpretation Result where

3232 data Col Result _spec where

33− Result :: a -> Col Result ('Spec labels necessity a)

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

3434

3535

3636relabel :: ()

3737 => HIdentity ('Spec labels necessity a) (Col Result)

3838 -> HIdentity ('Spec relabels necessity a) (Col Result)

39−relabel (HIdentity (Result a)) = HIdentity (Result a)

39+relabel (HIdentity (R a)) = HIdentity (R a)

4040

4141

4242null :: Col Result ('Spec labels necessity (Maybe a))

43−null = Result Nothing

43+null = R Nothing

4444

4545

4646nullifier :: ()

4747 => SSpec ('Spec labels necessity a)

4848 -> Col Result ('Spec labels necessity a)

4949 -> Col Result ('Spec labels necessity (Nullify a))

50−nullifier SSpec {nullity} (Result a) = Result $ case nullity of

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

5151 Null -> a

5252 NotNull -> Just a

5353

@@ -56,21 +56,21 @@ unnullifier :: ()

5656 => SSpec ('Spec labels necessity a)

5757 -> Col Result ('Spec labels necessity (Nullify a))

5858 -> Maybe (Col Result ('Spec labels necessity a))

59−unnullifier SSpec {nullity} (Result a) =

59+unnullifier SSpec {nullity} (R a) =

6060 case nullity of

61− Null -> pure $ Result a

62− NotNull -> Result <$> a

61+ Null -> pure $ R a

62+ NotNull -> R <$> a

6363

6464

6565vectorizer :: Functor f

6666 => SSpec ('Spec labels necessity a)

6767 -> f (Col Result ('Spec labels necessity a))

6868 -> Col Result ('Spec labels 'Required (f a))

69−vectorizer _ = Result . fmap (\(Result a) -> a)

69+vectorizer _ = R . fmap unR

7070

7171

7272unvectorizer :: Functor f

7373 => SSpec ('Spec labels necessity a)

7474 -> Col Result ('Spec labels 'Required (f a))

7575 -> f (Col Result ('Spec labels necessity a))

76−unvectorizer _ (Result results) = Result <$> results

76+unvectorizer _ (R results) = R <$> results

src/Rel8/Table.hs+9−9

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

6060 , notReify

6161 )

6262import Rel8.Schema.Result

63− ( Col( Result ), Result

63+ ( Col( R ), Result

6464 , relabel

6565 , null, nullifier, unnullifier

6666 , vectorizer, unvectorizer

@@ -234,8 +234,8 @@ instance Sql DBType a => Table Result (Identity a) where

234234 type Columns (Identity a) = HType a

235235 type Context (Identity a) = Result

236236

237− toColumns (Identity a) = HType (Result a)

238− fromColumns (HType (Result a)) = Identity a

237+ toColumns (Identity a) = HType (R a)

238+ fromColumns (HType (R a)) = Identity a

239239

240240 reify = notReify

241241 unreify = notReify

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

247247

248248 toColumns = \case

249249 Left table -> HEitherTable

250− { htag = HIdentity (Result IsLeft)

250+ { htag = HIdentity (R IsLeft)

251251 , hleft = hlabel labeler (hnullify nullifier (toColumns table))

252252 , hright = hlabel labeler (hnulls (const null))

253253 }

254254 Right table -> HEitherTable

255− { htag = HIdentity (Result IsRight)

255+ { htag = HIdentity (R IsRight)

256256 , hleft = hlabel labeler (hnulls (const null))

257257 , hright = hlabel labeler (hnullify nullifier (toColumns table))

258258 }

259259

260260 fromColumns HEitherTable {htag, hleft, hright} = case htag of

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

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

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

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

264264 where

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

279279

280280 toColumns = \case

281281 Nothing -> HMaybeTable

282− { htag = HIdentity (Result Nothing)

282+ { htag = HIdentity (R Nothing)

283283 , hjust = hlabel labeler (hnulls (const null))

284284 }

285285 Just table -> HMaybeTable

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

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

287287 , hjust = hlabel labeler (hnullify nullifier (toColumns table))

288288 }

289289

290290 fromColumns HMaybeTable {htag, hjust} = case htag of

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

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

292292 case hunnullify unnullifier (hunlabel unlabeler hjust) of

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

294294 Just just -> fromColumns just

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

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

1616import Prelude

1717

1818-- rel8

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

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

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

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

2121import Rel8.Expr.Aggregate

2222 ( groupByExpr

2323 , listAggExpr

@@ -41,7 +41,7 @@ groupBy :: forall exprs. EqTable exprs => exprs -> Aggregate exprs

4141groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

4242 case hfield (eqTable @exprs) field of

4343 Dict -> case hfield exprs field of

44− DB expr -> Aggregation $ groupByExpr expr

44+ E expr -> A $ groupByExpr expr

4545

4646

4747-- | Aggregate rows into a single row containing an array of all aggregated

@@ -63,7 +63,7 @@ groupBy (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

6363listAgg :: Table Expr a => a -> Aggregate (ListTable a)

6464listAgg (toColumns -> exprs) = fromColumns $

6565 hvectorize

66− (\_ (Identity (DB a)) -> Aggregation $ listAggExpr a)

66+ (\_ (Identity (E a)) -> A $ listAggExpr a)

6767 (pure exprs)

6868

6969

@@ -71,7 +71,7 @@ listAgg (toColumns -> exprs) = fromColumns $

7171nonEmptyAgg :: Table Expr a => a -> Aggregate (NonEmptyTable a)

7272nonEmptyAgg (toColumns -> exprs) = fromColumns $

7373 hvectorize

74− (\_ (Identity (DB a)) -> Aggregation $ nonEmptyAggExpr a)

74+ (\_ (Identity (E a)) -> A $ nonEmptyAggExpr a)

7575 (pure exprs)

7676

7777

@@ -79,7 +79,7 @@ listAggWithOrder :: Table Expr a

7979 => Order o -> o -> a -> Aggregate (ListTable a)

8080listAggWithOrder order o (toColumns -> exprs) = fromColumns $

8181 hvectorize

82− (\_ (Identity (DB x)) -> Aggregation $ listAggExprWithOrder order o x)

82+ (\_ (Identity (E x)) -> A $ listAggExprWithOrder order o x)

8383 (pure exprs)

8484

8585

@@ -87,5 +87,5 @@ nonEmptyAggWithOrder :: Table Expr a

8787 => Order o -> o -> a -> Aggregate (NonEmptyTable a)

8888nonEmptyAggWithOrder order o (toColumns -> exprs) = fromColumns $

8989 hvectorize

90− (\_ (Identity (DB x)) -> Aggregation $ nonEmptyAggExprWithOrder order o x)

90+ (\_ (Identity (E x)) -> A $ nonEmptyAggExprWithOrder order o x)

9191 (pure exprs)

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

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

1313import Prelude

1414

1515-- rel8

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

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

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

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

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

@@ -28,8 +28,8 @@ bool :: Table Expr a => a -> a -> Expr Bool -> a

2828bool (toColumns -> false) (toColumns -> true) condition =

2929 fromColumns $ htabulate $ \field ->

3030 case (hfield false field, hfield true field) of

31− (DB falseExpr, DB trueExpr) ->

32− DB (boolExpr falseExpr trueExpr condition)

31+ (E falseExpr, E trueExpr) ->

32+ E (boolExpr falseExpr trueExpr condition)

3333{-# INLINABLE bool #-}

3434

3535

@@ -39,9 +39,9 @@ bool (toColumns -> false) (toColumns -> true) condition =

3939case_ :: Table Expr a => [(Expr Bool, a)] -> a -> a

4040case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =

4141 fromColumns $ htabulate $ \field -> case hfield fallback field of

42− DB fallbackExpr ->

43− case map (fmap (unDB . (`hfield` field))) branches of

44− branchExprs -> DB (caseExpr branchExprs fallbackExpr)

42+ E fallbackExpr ->

43+ case map (fmap (unE . (`hfield` field))) branches of

44+ branchExprs -> E (caseExpr branchExprs fallbackExpr)

4545

4646

4747-- | Like 'maybe', but to eliminate @null@.

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

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

2828import Prelude

2929

3030-- rel8

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

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

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

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

3434import Rel8.FCF ( Eval, Exp )

@@ -124,7 +124,7 @@ instance

124124(toColumns -> as) ==: (toColumns -> bs) =

125125 foldl1' (&&.) $ getConst $ htabulateA $ \field ->

126126 case (hfield as field, hfield bs field) of

127− (DB a, DB b) -> case hfield (eqTable @a) field of

127+ (E a, E b) -> case hfield (eqTable @a) field of

128128 Dict -> Const (pure (a ==. b))

129129infix 4 ==:

130130

@@ -136,7 +136,7 @@ infix 4 ==:

136136(toColumns -> as) /=: (toColumns -> bs) =

137137 foldl1' (||.) $ getConst $ htabulateA $ \field ->

138138 case (hfield as field, hfield bs field) of

139− (DB a, DB b) -> case hfield (eqTable @a) field of

139+ (E a, E b) -> case hfield (eqTable @a) field of

140140 Dict -> Const (pure (a /=. b))

141141infix 4 /=:

142142

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

@@ -13,10 +13,10 @@ where

1313import Prelude

1414

1515-- rel8

16−import Rel8.Expr ( Col(..) )

16+import Rel8.Expr ( Col( E ) )

1717import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )

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

19−import Rel8.Schema.Insert ( Inserts, Col( InsertCol ), Insertion(..) )

19+import Rel8.Schema.Insert ( Inserts, Col( I ), Insertion(..) )

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

2121import Rel8.Table ( fromColumns, toColumns )

2222

@@ -28,8 +28,8 @@ import Rel8.Table ( fromColumns, toColumns )

2828toInsert :: Inserts exprs inserts => exprs -> inserts

2929toInsert (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

3030 case hfield hspecs field of

31− SSpec {} -> InsertCol $ case hfield exprs field of

32− DB expr -> Insertion expr

31+ SSpec {} -> I $ case hfield exprs field of

32+ E expr -> Insertion expr

3333

3434

3535-- | @toInsertDefaults@ converts a 'Table' of 'Expr's into a 'Table' that can

@@ -44,6 +44,6 @@ toInsertDefaults :: Inserts exprs inserts => exprs -> inserts

4444toInsertDefaults (toColumns -> exprs) = fromColumns $ htabulate $ \field ->

4545 case hfield hspecs field of

4646 SSpec {necessity} -> case hfield exprs field of

47− DB expr -> InsertCol $ case necessity of

47+ E expr -> I $ case necessity of

4848 SRequired -> Insertion expr

4949 SOptional -> Default

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

@@ -21,13 +21,13 @@ import Data.Type.Equality ( (:~:)( Refl ) )

2121import Prelude

2222

2323-- rel8

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

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

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

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

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

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

2929import Rel8.Schema.Insert ( Inserts )

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

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

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

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

3333import Rel8.Schema.Spec.ConstrainDBType ( dbTypeDict, dbTypeNullity )

@@ -112,18 +112,18 @@ instance AlternativeTable ListTable where

112112

113113instance Table Expr a => Semigroup (ListTable a) where

114114 ListTable as <> ListTable bs = ListTable $

115− happend (\_ _ (DB a) (DB b) -> DB (sappend a b)) as bs

115+ happend (\_ _ (E a) (E b) -> E (sappend a b)) as bs

116116

117117

118118instance Table Expr a => Monoid (ListTable a) where

119119 mempty = ListTable $ hempty $ \nullability info ->

120− DB (sempty nullability info)

120+ E (sempty nullability info)

121121

122122

123123listTable :: Table Expr a => [a] -> ListTable a

124124listTable =

125125 ListTable .

126− hvectorize (\SSpec {info} -> DB . slistOf info . fmap unDB) .

126+ hvectorize (\SSpec {info} -> E . slistOf info . fmap unE) .

127127 fmap toColumns

128128

129129

@@ -134,6 +134,6 @@ insertListTable = toInsert . listTable

134134nameListTable :: Table Name a => a -> ListTable a

135135nameListTable =

136136 ListTable .

137− hvectorize (\_ (Identity (NameCol a)) -> NameCol a) .

137+ hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .

138138 pure .

139139 toColumns

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

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

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

2525

2626-- rel8

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

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

2828import Rel8.Expr.Opaleye ( toPrimExpr )

2929import Rel8.Kind.Labels ( renderLabels )

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

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

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

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

3333import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

3434

@@ -43,14 +43,14 @@ namesFromLabelsWith :: Table Name a

4343 => (NonEmpty String -> String) -> a

4444namesFromLabelsWith f = fromColumns $ htabulate $ \field ->

4545 case hfield hspecs field of

46− SSpec {labels} -> NameCol (f (renderLabels labels))

46+ SSpec {labels} -> N (Name (f (renderLabels labels)))

4747

4848

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

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

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

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

53− (NameCol name, DB expr) -> Const [(name, toPrimExpr expr)]

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

5454

5555

5656showLabels :: forall a. Table (Context a) a => a -> [NonEmpty String]

@@ -62,4 +62,4 @@ showLabels _ = getConst $

6262showNames :: forall a. Table Name a => a -> [String]

6363showNames (toColumns -> names) = getConst $

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

65− NameCol name -> Const [name]

65+ N (Name name) -> Const [name]

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

@@ -22,13 +22,13 @@ import Data.Type.Equality ( (:~:)( Refl ) )

2222import Prelude

2323

2424-- rel8

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

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

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

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

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

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

3030import Rel8.Schema.Insert ( Inserts )

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

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

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

3333import Rel8.Schema.Reify ( hreify, hunreify )

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

@@ -108,13 +108,13 @@ instance AltTable NonEmptyTable where

108108

109109instance Table Expr a => Semigroup (NonEmptyTable a) where

110110 NonEmptyTable as <> NonEmptyTable bs = NonEmptyTable $

111− happend (\_ _ (DB a) (DB b) -> DB (sappend1 a b)) as bs

111+ happend (\_ _ (E a) (E b) -> E (sappend1 a b)) as bs

112112

113113

114114nonEmptyTable :: Table Expr a => NonEmpty a -> NonEmptyTable a

115115nonEmptyTable =

116116 NonEmptyTable .

117− hvectorize (\SSpec {info} -> DB . snonEmptyOf info . fmap unDB) .

117+ hvectorize (\SSpec {info} -> E . snonEmptyOf info . fmap unE) .

118118 fmap toColumns

119119

120120

@@ -126,6 +126,6 @@ insertNonEmptyTable = toInsert . nonEmptyTable

126126nameNonEmptyTable :: Table Name a => a -> NonEmptyTable a

127127nameNonEmptyTable =

128128 NonEmptyTable .

129− hvectorize (\_ (Identity (NameCol a)) -> NameCol a) .

129+ hvectorize (\_ (Identity (N (Name a))) -> N (Name a)) .

130130 pure .

131131 toColumns

src/Rel8/Table/Opaleye.hs+14−14

@@ -45,8 +45,8 @@ import Rel8.Expr.Opaleye

4545 )

4646import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )

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

48−import Rel8.Schema.Insert ( Insert, Inserts, Col( InsertCol ), Insertion(..) )

49−import Rel8.Schema.Name ( Name, Selects, Col(..) )

48+import Rel8.Schema.Insert ( Insert, Inserts, Col( I ), Insertion(..) )

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

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

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

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

@@ -66,7 +66,7 @@ binaryspec = Opaleye.Binaryspec $ Opaleye.PackMap $ \f (as, bs) ->

6666 fmap fromColumns $ unwrapApplicative $ htabulateA $ \field ->

6767 WrapApplicative $

6868 case (hfield (toColumns as) field, hfield (toColumns bs) field) of

69− (DB a, DB b) -> DB . fromPrimExpr <$> f (toPrimExpr a, toPrimExpr b)

69+ (E a, E b) -> E . fromPrimExpr <$> f (toPrimExpr a, toPrimExpr b)

7070

7171

7272distinctspec :: Table Expr a => Opaleye.Distinctspec a a

@@ -75,8 +75,8 @@ distinctspec =

7575 fmap fromColumns .

7676 unwrapApplicative .

7777 htraverse

78− (\(DB a) ->

79− WrapApplicative $ DB . fromPrimExpr <$> f (Nothing, toPrimExpr a)) .

78+ (\(E a) ->

79+ WrapApplicative $ E . fromPrimExpr <$> f (Nothing, toPrimExpr a)) .

8080 toColumns

8181

8282

@@ -97,14 +97,14 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $

9797 name -> lmap (`hfield` field) (go specs name)

9898 where

9999 go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insert spec) (Col Expr spec)

100− go SSpec {necessity} (NameCol name) = case necessity of

100+ go SSpec {necessity} (N (Name name)) = case necessity of

101101 SRequired ->

102− lmap (\(InsertCol (Insertion a)) -> toColumn $ toPrimExpr a) $

103− DB . fromPrimExpr . fromColumn <$>

102+ lmap (\(I (Insertion a)) -> toColumn $ toPrimExpr a) $

103+ E . fromPrimExpr . fromColumn <$>

104104 Opaleye.requiredTableField name

105105 SOptional ->

106− lmap (\(InsertCol ma) -> toColumn . toPrimExpr <$> fromInsert ma) $

107− DB . fromPrimExpr . fromColumn <$>

106+ lmap (\(I ma) -> toColumn . toPrimExpr <$> fromInsert ma) $

107+ E . fromPrimExpr . fromColumn <$>

108108 Opaleye.optionalTableField name

109109 where

110110 fromInsert = \case

@@ -116,7 +116,7 @@ unpackspec :: Table Expr a => Opaleye.Unpackspec a a

116116unpackspec = Opaleye.Unpackspec $ Opaleye.PackMap $ \f ->

117117 fmap fromColumns .

118118 unwrapApplicative .

119− htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) .

119+ htraverse (\(E a) -> WrapApplicative $ E <$> traversePrimExpr f a) .

120120 toColumns

121121{-# INLINABLE unpackspec #-}

122122

@@ -130,7 +130,7 @@ toPackMap :: Table Expr a

130130toPackMap as = Opaleye.PackMap $ \f () ->

131131 fmap fromColumns $

132132 unwrapApplicative .

133− htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) $

133+ htraverse (\(E a) -> WrapApplicative $ E <$> traversePrimExpr f a) $

134134 toColumns as

135135

136136

@@ -142,5 +142,5 @@ castTable (toColumns -> as) = fromColumns $ htabulate \i ->

142142 case hfield hspecs i of

143143 SSpec{info} ->

144144 case hfield as i of

145− DB expr ->

146− DB (scastExpr info expr)

145+ E expr ->

146+ E (scastExpr info expr)

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

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

2525import Prelude hiding ( seq )

2626

2727-- rel8

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

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

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

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

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

@@ -127,7 +127,7 @@ instance

127127(toColumns -> as) <: (toColumns -> bs) =

128128 foldr @[] go false $ getConst $ htabulateA $ \field ->

129129 case (hfield as field, hfield bs field) of

130− (DB a, DB b) -> case hfield (ordTable @a) field of

130+ (E a, E b) -> case hfield (ordTable @a) field of

131131 Dict -> Const [(a <. b, a ==. b)]

132132 where

133133 go (lt, eq) a = lt ||. (eq &&. a)

@@ -140,7 +140,7 @@ infix 4 <:

140140(toColumns -> as) <=: (toColumns -> bs) =

141141 foldr @[] go true $ getConst $ htabulateA $ \field ->

142142 case (hfield as field, hfield bs field) of

143− (DB a, DB b) -> case hfield (ordTable @a) field of

143+ (E a, E b) -> case hfield (ordTable @a) field of

144144 Dict -> Const [(a <. b, a ==. b)]

145145 where

146146 go (lt, eq) a = lt ||. (eq &&. a)

@@ -153,7 +153,7 @@ infix 4 <=:

153153(toColumns -> as) >: (toColumns -> bs) =

154154 foldr @[] go false $ getConst $ htabulateA $ \field ->

155155 case (hfield as field, hfield bs field) of

156− (DB a, DB b) -> case hfield (ordTable @a) field of

156+ (E a, E b) -> case hfield (ordTable @a) field of

157157 Dict -> Const [(a >. b, a ==. b)]

158158 where

159159 go (gt, eq) a = gt ||. (eq &&. a)

@@ -166,7 +166,7 @@ infix 4 >:

166166(toColumns -> as) >=: (toColumns -> bs) =

167167 foldr @[] go true $ getConst $ htabulateA $ \field ->

168168 case (hfield as field, hfield bs field) of

169− (DB a, DB b) -> case hfield (ordTable @a) field of

169+ (E a, E b) -> case hfield (ordTable @a) field of

170170 Dict -> Const [(a >. b, a ==. b)]

171171 where

172172 go (gt, eq) a = gt ||. (eq &&. a)

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

@@ -15,7 +15,7 @@ import Data.Functor.Contravariant ( (>$<), contramap )

1515import Prelude

1616

1717-- rel8

18−import Rel8.Expr ( unDB )

18+import Rel8.Expr ( unE )

1919import Rel8.Expr.Order ( asc, desc, nullsFirst, nullsLast )

2020import Rel8.Order ( Order )

2121import Rel8.Schema.Dict ( Dict( Dict ) )

@@ -34,7 +34,7 @@ ascTable = contramap toColumns $ getConst $

3434 htabulateA @(Columns a) $ \field -> case hfield hspecs field of

3535 SSpec {} -> case hfield (ordTable @a) field of

3636 dict@Dict -> case dbTypeDict dict of

37− Dict -> Const $ unDB . (`hfield` field) >$<

37+ Dict -> Const $ unE . (`hfield` field) >$<

3838 case dbTypeNullity dict of

3939 Null -> nullsFirst asc

4040 NotNull -> asc

@@ -47,7 +47,7 @@ descTable = contramap toColumns $ getConst $

4747 htabulateA @(Columns a) $ \field -> case hfield hspecs field of

4848 SSpec {} -> case hfield (ordTable @a) field of

4949 dict@Dict -> case dbTypeDict dict of

50− Dict -> Const $ unDB . (`hfield` field) >$<

50+ Dict -> Const $ unE . (`hfield` field) >$<

5151 case dbTypeNullity dict of

5252 Null -> nullsLast desc

5353 NotNull -> desc

src/Rel8/Table/Serialize.hs+12−12

@@ -30,7 +30,7 @@ import Prelude

3030import qualified Hasql.Decoders as Hasql

3131

3232-- rel8

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

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

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

3535import Rel8.FCF ( Eval, Exp )

3636import Rel8.Generic.Record ( Record(..) )

@@ -42,7 +42,7 @@ import Rel8.Kind.Algebra ( KnownAlgebra )

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

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

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

45−import Rel8.Schema.Result ( Col( Result ), Result )

45+import Rel8.Schema.Result ( Col( R ), Result )

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

4747import Rel8.Table ( Table, Columns, fromColumns, toColumns, TColumns )

4848import Rel8.Type ( DBType )

@@ -96,25 +96,25 @@ type instance Eval (TToExprs exprs a) = ToExprs exprs a

9696

9797

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

99− fromResult (HType (Result a)) = a

100− toResult = HType . Result

99+ fromResult (HType (R a)) = a

100+ toResult = HType . R

101101

102102

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

104− fromResult (HType (Result a)) = a

105− toResult = HType . Result

104+ fromResult (HType (R a)) = a

105+ toResult = HType . R

106106

107107

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

109109 where

110− fromResult (HType (Result a)) = a

111− toResult = HType . Result

110+ fromResult (HType (R a)) = a

111+ toResult = HType . R

112112

113113

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

115115 where

116− fromResult (HType (Result a)) = a

117− toResult = HType . Result

116+ fromResult (HType (R a)) = a

117+ toResult = HType . R

118118

119119

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

@@ -234,10 +234,10 @@ litHTable :: HTable t => t (Col Result) -> t (Col Expr)

234234litHTable as = htabulate $ \field ->

235235 case hfield hspecs field of

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

237− Result value -> DB (slitExpr nullity info value)

237+ R value -> E (slitExpr nullity info value)

238238

239239

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

241241parseHTable = unwrapApplicative $ htabulateA $ \field ->

242242 WrapApplicative $ case hfield hspecs field of

243− SSpec {nullity, info} -> Result <$> sparseValue nullity info

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

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

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

1111import Prelude hiding ( undefined )

1212

1313-- rel8

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

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

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

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

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

@@ -22,5 +22,5 @@ import Rel8.Table ( Table, fromColumns )

2222undefined :: Table Expr a => a

2323undefined = fromColumns $ htabulate $ \field -> case hfield hspecs field of

2424 SSpec {nullity, info} -> case nullity of

25− Null -> DB (snull info)

26− NotNull -> DB (unsafeUnnullify (snull info))

25+ Null -> E (snull info)

26+ NotNull -> E (unsafeUnnullify (snull info))

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

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

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

3131

3232-- rel8

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

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

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

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

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

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

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

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

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

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

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

4141import Rel8.Table.Eq ( EqTable )

@@ -98,8 +98,8 @@ compose = castExpr . fromPrimExpr . encoder

9898decompose :: forall a. DBComposite a => Expr a -> HKD a Expr

9999decompose (toPrimExpr -> a) = fromColumns $ htabulate \field ->

100100 case hfield names field of

101− NameCol name -> case hfield hspecs field of

102− SSpec {} -> DB $ fromPrimExpr $ Opaleye.CompositeExpr a name

101+ N (Name name) -> case hfield hspecs field of

102+ SSpec {} -> E $ fromPrimExpr $ Opaleye.CompositeExpr a name

103103 where

104104 names = toColumns (compositeFields @a)

105105

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

107107decoder :: Table Result a => Hasql.Composite a

108108decoder = fmap fromColumns $ unwrapApplicative $ htabulateA \field ->

109109 case hfield hspecs field of

110− SSpec {nullity, info} -> WrapApplicative $ Result <$>

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

111111 case nullity of

112112 Null -> Hasql.field $ Hasql.nullable $ decode info

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

@@ -117,4 +117,4 @@ encoder :: Table Expr a => a -> Opaleye.PrimExpr

117117encoder (toColumns -> a) = Opaleye.FunExpr "ROW" exprs

118118 where

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

120− DB (toPrimExpr -> expr) -> Const [expr]

120+ E (toPrimExpr -> expr) -> Const [expr]