1eaa683 · rel8 · git.iko.soy

rel8.cabal+1−5

compare with master

unifiedsplit

@@ -47,7 +47,6 @@ library

47 Rel8.Column

48 Rel8.Column.ADT

49 Rel8.Column.Either

50− Rel8.Column.Field

51 Rel8.Column.Lift

50 Rel8.Column.Lift

52 Rel8.Column.List

51 Rel8.Column.List

53 Rel8.Column.Maybe

52 Rel8.Column.Maybe

@@ -64,6 +63,7 @@ library

64 Rel8.Expr.Opaleye

63 Rel8.Expr.Opaleye

65 Rel8.Expr.Ord

64 Rel8.Expr.Ord

66 Rel8.Expr.Order

65 Rel8.Expr.Order

66+ Rel8.Expr.Sequence

67 Rel8.Expr.Serialize

68

69 Rel8.FCF

@@ -71,7 +71,6 @@ library

71 Rel8.Kind.Algebra

72 Rel8.Kind.Context

73 Rel8.Kind.Labels

74− Rel8.Kind.Necessity

75

74

76 Rel8.Generic.Construction

75 Rel8.Generic.Construction

77 Rel8.Generic.Construction.ADT

76 Rel8.Generic.Construction.ADT

@@ -121,7 +120,6 @@ library

121 Rel8.Schema.HTable.Product

120 Rel8.Schema.HTable.Product

122 Rel8.Schema.HTable.These

121 Rel8.Schema.HTable.These

123 Rel8.Schema.HTable.Vectorize

122 Rel8.Schema.HTable.Vectorize

124− Rel8.Schema.Insert

125 Rel8.Schema.Kind

123 Rel8.Schema.Kind

126 Rel8.Schema.Name

124 Rel8.Schema.Name

127 Rel8.Schema.Null

125 Rel8.Schema.Null

@@ -129,7 +127,6 @@ library

129 Rel8.Schema.Result

127 Rel8.Schema.Result

130 Rel8.Schema.Spec

128 Rel8.Schema.Spec

131 Rel8.Schema.Spec.ConstrainDBType

129 Rel8.Schema.Spec.ConstrainDBType

132− Rel8.Schema.Spec.ConstrainType

133 Rel8.Schema.Table

130 Rel8.Schema.Table

134

131

135 Rel8.Statement.Delete

132 Rel8.Statement.Delete

@@ -147,7 +144,6 @@ library

147 Rel8.Table.Either

144 Rel8.Table.Either

148 Rel8.Table.Eq

145 Rel8.Table.Eq

149 Rel8.Table.HKD

146 Rel8.Table.HKD

150− Rel8.Table.Insert

151 Rel8.Table.List

147 Rel8.Table.List

152 Rel8.Table.Maybe

148 Rel8.Table.Maybe

153 Rel8.Table.Name

149 Rel8.Table.Name

src/Rel8.hs+7−15

@@ -32,8 +32,7 @@ module Rel8

32

33 -- * Tables and higher-kinded tables

34 , Rel8able, KRel8able

35− , Column, Field, Necessity( Required, Optional )

35+ , Column

36− , Default

37 , HADT

36 , HADT

38 , HEither

37 , HEither

39 , HMaybe

38 , HMaybe

@@ -59,7 +58,6 @@ module Rel8

59 , catMaybeTable

58 , catMaybeTable

60 , bindMaybeTable

59 , bindMaybeTable

61 , traverseMaybeTable

60 , traverseMaybeTable

62− , insertMaybeTable

63 , nameMaybeTable

61 , nameMaybeTable

64

62

65 -- ** @EitherTable@

63 -- ** @EitherTable@

@@ -70,7 +68,6 @@ module Rel8

70 , keepRightTable

68 , keepRightTable

71 , bindEitherTable

69 , bindEitherTable

72 , bitraverseEitherTable

70 , bitraverseEitherTable

73− , insertEitherTable

74 , nameEitherTable

71 , nameEitherTable

75

72

76 -- ** @TheseTable@

73 -- ** @TheseTable@

@@ -87,13 +84,11 @@ module Rel8

87 , keepThoseTable, loseThoseTable

84 , keepThoseTable, loseThoseTable

88 , bindTheseTable

85 , bindTheseTable

89 , bitraverseTheseTable

86 , bitraverseTheseTable

90− , insertTheseTable

91 , nameTheseTable

87 , nameTheseTable

92

88

93 -- ** @ListTable@

89 -- ** @ListTable@

94 , ListTable

90 , ListTable

95 , listTable

91 , listTable

96− , insertListTable

97 , nameListTable

92 , nameListTable

98 , many

93 , many

99 , manyExpr

94 , manyExpr

@@ -103,7 +98,6 @@ module Rel8

103 -- ** @NonEmptyTable@

98 -- ** @NonEmptyTable@

104 , NonEmptyTable

99 , NonEmptyTable

105 , nonEmptyTable

100 , nonEmptyTable

106− , insertNonEmptyTable

107 , nameNonEmptyTable

101 , nameNonEmptyTable

108 , some

102 , some

109 , someExpr

103 , someExpr

@@ -115,7 +109,6 @@ module Rel8

115 , BuildADT, buildADT

109 , BuildADT, buildADT

116 , ConstructADT, constructADT

110 , ConstructADT, constructADT

117 , DeconstructADT, deconstructADT

111 , DeconstructADT, deconstructADT

118− , InsertADT, insertADT

119 , NameADT, nameADT

112 , NameADT, nameADT

120 , AggregateADT, aggregateADT

113 , AggregateADT, aggregateADT

121

114

@@ -124,7 +117,6 @@ module Rel8

124 , BuildHKD, buildHKD

117 , BuildHKD, buildHKD

125 , ConstructHKD, constructHKD

118 , ConstructHKD, constructHKD

126 , DeconstructHKD, deconstructHKD

119 , DeconstructHKD, deconstructHKD

127− , InsertHKD, insertHKD

128 , NameHKD, nameHKD

120 , NameHKD, nameHKD

129 , AggregateHKD, aggregateHKD

121 , AggregateHKD, aggregateHKD

130

122

@@ -139,6 +131,7 @@ module Rel8

139 , Sql

131 , Sql

140 , litExpr

132 , litExpr

141 , unsafeCastExpr

133 , unsafeCastExpr

134+ , unsafeLiteral

142

135

143 -- ** @null@

136 -- ** @null@

144 , null

137 , null

@@ -251,8 +244,6 @@ module Rel8

251 , Insert(..)

244 , Insert(..)

252 , OnConflict(..)

245 , OnConflict(..)

253 , insert

246 , insert

254− , toInsert

255− , toInsertDefaults

256

247

257 -- ** @DELETE@

248 -- ** @DELETE@

258 , Delete(..)

249 , Delete(..)

@@ -268,6 +259,9 @@ module Rel8

268 -- ** @CREATE VIEW@

259 -- ** @CREATE VIEW@

269 , createView

260 , createView

270

261

262+ -- ** Sequences

263+ , nextval

264+

271 -- * TODO

265 -- * TODO

272 -- TODO

266 -- TODO

273 -- These need organizing, but are reachable from Rel8's documentation so we

267 -- These need organizing, but are reachable from Rel8's documentation so we

@@ -291,7 +285,6 @@ import Rel8.Aggregate

291import Rel8.Column

285import Rel8.Column

292import Rel8.Column.ADT

286import Rel8.Column.ADT

293import Rel8.Column.Either

287import Rel8.Column.Either

294−import Rel8.Column.Field

295import Rel8.Column.Lift

288import Rel8.Column.Lift

296import Rel8.Column.List

289import Rel8.Column.List

297import Rel8.Column.Maybe

290import Rel8.Column.Maybe

@@ -303,12 +296,12 @@ import Rel8.Expr.Bool

303import Rel8.Expr.Eq

296import Rel8.Expr.Eq

304import Rel8.Expr.Function

297import Rel8.Expr.Function

305import Rel8.Expr.Null

298import Rel8.Expr.Null

306−import Rel8.Expr.Opaleye (unsafeCastExpr)

299+import Rel8.Expr.Opaleye (unsafeCastExpr, unsafeLiteral)

307import Rel8.Expr.Ord

300import Rel8.Expr.Ord

308import Rel8.Expr.Order

301import Rel8.Expr.Order

309import Rel8.Expr.Serialize

302import Rel8.Expr.Serialize

303+import Rel8.Expr.Sequence

310import Rel8.Generic.Rel8able ( KRel8able, Rel8able )

304import Rel8.Generic.Rel8able ( KRel8able, Rel8able )

311−import Rel8.Kind.Necessity

312import Rel8.Order

305import Rel8.Order

313import Rel8.Query

306import Rel8.Query

314import Rel8.Query.Aggregate

307import Rel8.Query.Aggregate

@@ -346,7 +339,6 @@ import Rel8.Table.Bool

346import Rel8.Table.Either

339import Rel8.Table.Either

347import Rel8.Table.Eq

340import Rel8.Table.Eq

348import Rel8.Table.HKD

341import Rel8.Table.HKD

349−import Rel8.Table.Insert

350import Rel8.Table.List

342import Rel8.Table.List

351import Rel8.Table.Maybe

343import Rel8.Table.Maybe

352import Rel8.Table.Name

344import Rel8.Table.Name

src/Rel8/Aggregate.hs+1−1

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

62 data Col Aggregate _spec where

63 A :: ()

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

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

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

66

67

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

src/Rel8/Column.hs+77−12

@@ -1,34 +1,99 @@

1{-# language DataKinds #-}

2−{-# language TypeFamilies #-}

2+{-# language FlexibleContexts #-}

3+{-# language LambdaCase #-}

4+{-# language MultiParamTypeClasses #-}

3{-# language StandaloneKindSignatures #-}

5{-# language StandaloneKindSignatures #-}

6+{-# language TypeFamilies #-}

4

7

5module Rel8.Column

8module Rel8.Column

6− ( Column, Default

9+ ( Column, AColumn(..)

7 , TColumn

10 , TColumn

8 )

11 )

9where

12where

10

13

11-- base

14-- base

12import Data.Kind ( Type )

15import Data.Kind ( Type )

13−import Prelude ()

16+import Prelude

14

17

15-- rel8

18-- rel8

16−import Rel8.Column.Field ( Field )

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

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

17import Rel8.FCF ( Eval, Exp )

21import Rel8.FCF ( Eval, Exp )

18−import Rel8.Kind.Necessity ( Necessity( Required, Optional ) )

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

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

19import qualified Rel8.Schema.Kind as K

24import qualified Rel8.Schema.Kind as K

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

26+import Rel8.Schema.Null ( Sql )

27+import Rel8.Schema.Reify ( Reify, Col(..) )

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

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

30+import Rel8.Table

31+ ( Table, Columns, Context, fromColumns, toColumns

32+ , Unreify, reify, unreify

33+ )

34+import Rel8.Table.Recontextualize ( Recontextualize )

35+import Rel8.Type ( DBType )

20

36

21

37

22−-- | The @Column@ type family should be used to indicate which fields of your

23−-- data types are single columns in queries. This type family has special

24−-- support when a query is executed, allowing you to use a single data type for

25−-- both query data and rows decoded to Haskell.

26type Column :: K.Context -> Type -> Type

38type Column :: K.Context -> Type -> Type

27−type Column context a = Field context 'Required a

39+type family Column context a where

40+ Column (Reify context) a = AColumn context a

41+ Column Aggregate a = Aggregate a

42+ Column Expr a = Expr a

43+ Column Name a = Name a

44+ Column Result a = a

45+

46+

47+type AColumn :: K.Context -> Type -> Type

48+newtype AColumn context a = AColumn (Column context a)

49+

50+

51+instance (Reifiable context, Sql DBType a) =>

52+ Table (Reify context) (AColumn context a)

53+ where

54+ type Context (AColumn context a) = Reify context

55+ type Columns (AColumn context a) = HIdentity ('Spec '[] a)

56+ type Unreify (AColumn context a) = Column context a

57+

58+ fromColumns (HIdentity (Reify a)) = sfromColumn contextSing a

59+ toColumns = HIdentity . Reify . stoColumn contextSing

60+ reify _ = AColumn

61+ unreify _ (AColumn a) = a

62+

63+

64+instance

65+ ( Reifiable context, Reifiable context'

66+ , Sql DBType a

67+ ) =>

68+ Recontextualize

69+ (Reify context)

70+ (Reify context')

71+ (AColumn context a)

72+ (AColumn context' a)

73+

74+

75+sfromColumn :: ()

76+ => SContext context

77+ -> Col context ('Spec labels a)

78+ -> AColumn context a

79+sfromColumn = \case

80+ SAggregate -> \(A a) -> AColumn a

81+ SExpr -> \(E a) -> AColumn a

82+ SName -> \(N a) -> AColumn a

83+ SResult -> \(R a) -> AColumn a

84+ SReify context -> \(Reify a) -> AColumn (sfromColumn context a)

28

85

29

86

30−type Default :: K.Context -> Type -> Type

87+stoColumn :: ()

31−type Default context a = Field context 'Optional a

88+ => SContext context

89+ -> AColumn context a

90+ -> Col context ('Spec labels a)

91+stoColumn = \case

92+ SAggregate -> \(AColumn a) -> A a

93+ SExpr -> \(AColumn a) -> E a

94+ SName -> \(AColumn a) -> N a

95+ SResult -> \(AColumn a) -> R a

96+ SReify context -> \(AColumn a) -> Reify (stoColumn context a)

32

97

33

98

34data TColumn :: K.Context -> Type -> Exp Type

99data TColumn :: K.Context -> Type -> Exp Type

src/Rel8/Column/ADT.hs−2

@@ -71,7 +71,6 @@ sfromColumnsADT :: ADTable t

71sfromColumnsADT = \case

72 SAggregate -> AHADT . ADT . hunreify

73 SExpr -> AHADT . ADT . hunreify

74− SInsert -> AHADT . ADT . hunreify

75 SName -> AHADT . ADT . hunreify

74 SName -> AHADT . ADT . hunreify

76 SResult -> AHADT . fromADT . ADT . hunreify

75 SResult -> AHADT . fromADT . ADT . hunreify

77 SReify context -> AHADT . sfromColumnsADT context . hunreify

76 SReify context -> AHADT . sfromColumnsADT context . hunreify

@@ -84,7 +83,6 @@ stoColumnsADT :: ADTable t

84stoColumnsADT = \case

83stoColumnsADT = \case

85 SAggregate -> hreify . (\(AHADT (ADT a)) -> a)

84 SAggregate -> hreify . (\(AHADT (ADT a)) -> a)

86 SExpr -> hreify . (\(AHADT (ADT a)) -> a)

85 SExpr -> hreify . (\(AHADT (ADT a)) -> a)

87− SInsert -> hreify . (\(AHADT (ADT a)) -> a)

88 SName -> hreify . (\(AHADT (ADT a)) -> a)

86 SName -> hreify . (\(AHADT (ADT a)) -> a)

89 SResult -> hreify . (\(ADT a) -> a) . toADT . (\(AHADT a) -> a)

87 SResult -> hreify . (\(ADT a) -> a) . toADT . (\(AHADT a) -> a)

90 SReify context -> hreify . stoColumnsADT context . (\(AHADT a) -> a)

88 SReify context -> hreify . stoColumnsADT context . (\(AHADT a) -> a)

src/Rel8/Column/Either.hs−13

@@ -23,7 +23,6 @@ import Rel8.Expr ( Expr )

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

24import Rel8.Schema.Context ( Col )

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

26−import Rel8.Schema.Insert ( Insert )

27import qualified Rel8.Schema.Kind as K

26import qualified Rel8.Schema.Kind as K

28import Rel8.Schema.Name ( Name(..) )

27import Rel8.Schema.Name ( Name(..) )

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

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

@@ -41,7 +40,6 @@ type family HEither context where

41 HEither (Reify context) = AHEither context

40 HEither (Reify context) = AHEither context

42 HEither Aggregate = EitherTable

41 HEither Aggregate = EitherTable

43 HEither Expr = EitherTable

42 HEither Expr = EitherTable

44− HEither Insert = EitherTable

45 HEither Name = EitherTable

43 HEither Name = EitherTable

46 HEither Result = Either

44 HEither Result = Either

47

45

@@ -93,7 +91,6 @@ sbimapEither = \case

93 SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)

91 SAggregate -> \f g (AHEither a) -> AHEither (bimap f g a)

94 SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)

92 SExpr -> \f g (AHEither a) -> AHEither (bimap f g a)

95 SResult -> \f g (AHEither a) -> AHEither (bimap f g a)

93 SResult -> \f g (AHEither a) -> AHEither (bimap f g a)

96− SInsert -> \f g (AHEither a) -> AHEither (bimap f g a)

97 SName -> \f g (AHEither a) -> AHEither (bimap f g a)

94 SName -> \f g (AHEither a) -> AHEither (bimap f g a)

98 SReify context -> \f g (AHEither a) -> AHEither (sbimapEither context f g a)

95 SReify context -> \f g (AHEither a) -> AHEither (sbimapEither context f g a)

99

96

@@ -118,11 +115,6 @@ sfromColumnsEither = \case

118 bimap (fromColumns . hreify) (fromColumns . hreify) .

115 bimap (fromColumns . hreify) (fromColumns . hreify) .

119 fromColumns .

116 fromColumns .

120 hunreify

117 hunreify

121− SInsert ->

122− AHEither .

123− bimap (fromColumns . hreify) (fromColumns . hreify) .

124− fromColumns .

125− hunreify

126 SName ->

118 SName ->

127 AHEither .

119 AHEither .

128 bimap (fromColumns . hreify) (fromColumns . hreify) .

120 bimap (fromColumns . hreify) (fromColumns . hreify) .

@@ -155,11 +147,6 @@ stoColumnsEither = \case

155 toColumns .

147 toColumns .

156 bimap (hunreify . toColumns) (hunreify . toColumns) .

148 bimap (hunreify . toColumns) (hunreify . toColumns) .

157 (\(AHEither a) -> a)

149 (\(AHEither a) -> a)

158− SInsert ->

159− hreify .

160− toColumns .

161− bimap (hunreify . toColumns) (hunreify . toColumns) .

162− (\(AHEither a) -> a)

163 SName ->

150 SName ->

164 hreify .

151 hreify .

165 toColumns .

152 toColumns .

src/Rel8/Column/Field.hsdeleted−115

@@ -1,115 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language FlexibleContexts #-}

3−{-# language LambdaCase #-}

4−{-# language MultiParamTypeClasses #-}

5−{-# language StandaloneKindSignatures #-}

6−{-# language TypeFamilies #-}

7−

8−module Rel8.Column.Field

9− ( Field, AField(..)

10− )

11−where

12−

13−-- base

14−import Data.Kind ( Type )

15−import Prelude

16−

17−-- rel8

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

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

20−import Rel8.Kind.Context ( SContext(..), Reifiable( contextSing ) )

21−import Rel8.Kind.Necessity

22− ( Necessity( Required, Optional )

23− , SNecessity( SRequired, SOptional )

24− , KnownNecessity, necessitySing

25− )

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

27−import Rel8.Schema.Insert ( Col( I ), Create(..), Insert )

28−import qualified Rel8.Schema.Kind as K

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

30−import Rel8.Schema.Null ( Sql )

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

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

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

34−import Rel8.Table

35− ( Table, Columns, Context, fromColumns, toColumns

36− , Unreify, reify, unreify

37− )

38−import Rel8.Table.Recontextualize ( Recontextualize )

39−import Rel8.Type ( DBType )

40−

41−

42−type Field :: K.Context -> Necessity -> Type -> Type

43−type family Field context necessity a where

44− Field (Reify context) necessity a = AField context necessity a

45− Field Aggregate _necessity a = Aggregate a

46− Field Expr _necessity a = Expr a

47− Field Insert 'Required a = Expr a

48− Field Insert 'Optional a = Maybe (Expr a)

49− Field Name _necessity a = Name a

50− Field Result _necessity a = a

51−

52−

53−type AField :: K.Context -> Necessity -> Type -> Type

54−newtype AField context necessity a = AField (Field context necessity a)

55−

56−

57−instance (Reifiable context, KnownNecessity necessity, Sql DBType a) =>

58− Table (Reify context) (AField context necessity a)

59− where

60− type Context (AField context necessity a) = Reify context

61− type Columns (AField context necessity a) = HIdentity ('Spec '[] necessity a)

62− type Unreify (AField context necessity a) = Field context necessity a

63−

64− fromColumns (HIdentity (Reify a)) = sfromColumn contextSing necessitySing a

65− toColumns = HIdentity . Reify . stoColumn contextSing necessitySing

66− reify _ = AField

67− unreify _ (AField a) = a

68−

69−

70−instance

71− ( Reifiable context, Reifiable context'

72− , KnownNecessity necessity, Sql DBType a

73− ) =>

74− Recontextualize

75− (Reify context)

76− (Reify context')

77− (AField context necessity a)

78− (AField context' necessity a)

79−

80−

81−sfromColumn :: ()

82− => SContext context

83− -> SNecessity necessity

84− -> Col context ('Spec labels necessity a)

85− -> AField context necessity a

86−sfromColumn = \case

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

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

89− SInsert -> \case

90− SRequired -> \case

91− I (Value a) -> AField a

92− SOptional -> \case

93− I Default -> AField Nothing

94− I (Value a) -> AField (Just a)

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

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

97− SReify context ->

98− \necessity (Reify a) -> AField (sfromColumn context necessity a)

99−

100−

101−stoColumn :: ()

102− => SContext context

103− -> SNecessity necessity

104− -> AField context necessity a

105− -> Col context ('Spec labels necessity a)

106−stoColumn = \case

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

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

109− SInsert -> \case

110− SRequired -> \(AField a) -> I (Value a)

111− SOptional -> \(AField ma) -> I $ maybe Default Value ma

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

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

114− SReify context ->

115− \necessity (AField a) -> Reify (stoColumn context necessity a)

src/Rel8/Column/Lift.hs−2

@@ -70,7 +70,6 @@ sfromColumnsLift :: HKDable a

70sfromColumnsLift = \case

71 SAggregate -> ALift . fromColumns . hunreify

72 SExpr -> ALift . fromColumns . hunreify

73− SInsert -> ALift . fromColumns . hunreify

74 SName -> ALift . fromColumns . hunreify

73 SName -> ALift . fromColumns . hunreify

75 SResult -> ALift . fromHKD . HKD . hunreify

74 SResult -> ALift . fromHKD . HKD . hunreify

76 SReify context -> ALift . sfromColumnsLift context . hunreify

75 SReify context -> ALift . sfromColumnsLift context . hunreify

@@ -83,7 +82,6 @@ stoColumnsLift :: HKDable a

83stoColumnsLift = \case

82stoColumnsLift = \case

84 SAggregate -> hreify . toColumns . unALift

83 SAggregate -> hreify . toColumns . unALift

85 SExpr -> hreify . toColumns . unALift

84 SExpr -> hreify . toColumns . unALift

86− SInsert -> hreify . toColumns . unALift

87 SName -> hreify . toColumns . unALift

85 SName -> hreify . toColumns . unALift

88 SResult -> hreify . (\(HKD a) -> a) . toHKD . unALift

86 SResult -> hreify . (\(HKD a) -> a) . toHKD . unALift

89 SReify context -> hreify . stoColumnsLift context . unALift

87 SReify context -> hreify . stoColumnsLift context . unALift

src/Rel8/Column/List.hs−5

@@ -22,7 +22,6 @@ import Rel8.Expr ( Expr )

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

23import Rel8.Schema.Context ( Col )

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

25−import Rel8.Schema.Insert ( Insert )

26import qualified Rel8.Schema.Kind as K

25import qualified Rel8.Schema.Kind as K

27import Rel8.Schema.Name ( Name )

26import Rel8.Schema.Name ( Name )

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

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

@@ -41,7 +40,6 @@ type family HList context where

41 HList (Reify context) = AHList context

40 HList (Reify context) = AHList context

42 HList Aggregate = ListTable

41 HList Aggregate = ListTable

43 HList Expr = ListTable

42 HList Expr = ListTable

44− HList Insert = ListTable

45 HList Name = ListTable

43 HList Name = ListTable

46 HList Result = []

44 HList Result = []

47

45

@@ -86,7 +84,6 @@ smapList = \case

86 SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))

84 SAggregate -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))

87 SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))

85 SExpr -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))

88 SResult -> \f _ (AHList as) -> AHList (fmap f as)

86 SResult -> \f _ (AHList as) -> AHList (fmap f as)

89− SInsert -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))

90 SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))

87 SName -> \_ f (AHList (ListTable a)) -> AHList (ListTable (f a))

91 SReify context -> \f g (AHList as) -> AHList (smapList context f g as)

88 SReify context -> \f g (AHList as) -> AHList (smapList context f g as)

92

89

@@ -99,7 +96,6 @@ sfromColumnsList = \case

99 SAggregate -> AHList . ListTable

96 SAggregate -> AHList . ListTable

100 SExpr -> AHList . ListTable

97 SExpr -> AHList . ListTable

101 SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify

98 SResult -> AHList . fmap (fromColumns . hreify) . fromColumns . hunreify

102− SInsert -> AHList . ListTable

103 SName -> AHList . ListTable

99 SName -> AHList . ListTable

104 SReify context ->

100 SReify context ->

105 AHList .

101 AHList .

@@ -117,7 +113,6 @@ stoColumnsList = \case

117 SExpr -> \(AHList (ListTable a)) -> a

113 SExpr -> \(AHList (ListTable a)) -> a

118 SResult ->

114 SResult ->

119 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)

115 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHList a) -> a)

120− SInsert -> \(AHList (ListTable a)) -> a

121 SName -> \(AHList (ListTable a)) -> a

116 SName -> \(AHList (ListTable a)) -> a

122 SReify context ->

117 SReify context ->

123 hreify .

118 hreify .

src/Rel8/Column/Maybe.hs−6

@@ -22,7 +22,6 @@ import Rel8.Expr ( Expr )

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

23import Rel8.Schema.Context ( Col )

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

25−import Rel8.Schema.Insert ( Insert )

26import qualified Rel8.Schema.Kind as K

25import qualified Rel8.Schema.Kind as K

27import Rel8.Schema.Name ( Name )

26import Rel8.Schema.Name ( Name )

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

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

@@ -40,7 +39,6 @@ type family HMaybe context where

40 HMaybe (Reify context) = AHMaybe context

39 HMaybe (Reify context) = AHMaybe context

41 HMaybe Aggregate = MaybeTable

40 HMaybe Aggregate = MaybeTable

42 HMaybe Expr = MaybeTable

41 HMaybe Expr = MaybeTable

43− HMaybe Insert = MaybeTable

44 HMaybe Name = MaybeTable

42 HMaybe Name = MaybeTable

45 HMaybe Result = Maybe

43 HMaybe Result = Maybe

46

44

@@ -86,7 +84,6 @@ smapMaybe = \case

86 SAggregate -> \f (AHMaybe a) -> AHMaybe (fmap f a)

84 SAggregate -> \f (AHMaybe a) -> AHMaybe (fmap f a)

87 SExpr -> \f (AHMaybe a) -> AHMaybe (fmap f a)

85 SExpr -> \f (AHMaybe a) -> AHMaybe (fmap f a)

88 SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)

86 SResult -> \f (AHMaybe a) -> AHMaybe (fmap f a)

89− SInsert -> \f (AHMaybe a) -> AHMaybe (fmap f a)

90 SName -> \f (AHMaybe a) -> AHMaybe (fmap f a)

87 SName -> \f (AHMaybe a) -> AHMaybe (fmap f a)

91 SReify context -> \f (AHMaybe a) -> AHMaybe (smapMaybe context f a)

88 SReify context -> \f (AHMaybe a) -> AHMaybe (smapMaybe context f a)

92

89

@@ -99,7 +96,6 @@ sfromColumnsMaybe = \case

99 SAggregate -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

96 SAggregate -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

100 SExpr -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

97 SExpr -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

101 SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

98 SResult -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

102− SInsert -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

103 SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

99 SName -> AHMaybe . fmap (fromColumns . hreify) . fromColumns . hunreify

104 SReify context ->

100 SReify context ->

105 AHMaybe .

101 AHMaybe .

@@ -119,8 +115,6 @@ stoColumnsMaybe = \case

119 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)

115 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)

120 SResult ->

116 SResult ->

121 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)

117 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)

122− SInsert ->

123− hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)

124 SName ->

118 SName ->

125 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)

119 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHMaybe a) -> a)

126 SReify context ->

120 SReify context ->

src/Rel8/Column/NonEmpty.hs−5

@@ -23,7 +23,6 @@ import Rel8.Expr ( Expr )

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

24import Rel8.Schema.Context ( Col )

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

26−import Rel8.Schema.Insert ( Insert )

27import qualified Rel8.Schema.Kind as K

26import qualified Rel8.Schema.Kind as K

28import Rel8.Schema.Name ( Name )

27import Rel8.Schema.Name ( Name )

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

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

@@ -42,7 +41,6 @@ type family HNonEmpty context where

42 HNonEmpty (Reify context) = AHNonEmpty context

41 HNonEmpty (Reify context) = AHNonEmpty context

43 HNonEmpty Aggregate = NonEmptyTable

42 HNonEmpty Aggregate = NonEmptyTable

44 HNonEmpty Expr = NonEmptyTable

43 HNonEmpty Expr = NonEmptyTable

45− HNonEmpty Insert = NonEmptyTable

46 HNonEmpty Name = NonEmptyTable

44 HNonEmpty Name = NonEmptyTable

47 HNonEmpty Result = NonEmpty

45 HNonEmpty Result = NonEmpty

48

46

@@ -87,7 +85,6 @@ smapNonEmpty = \case

87 SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))

85 SAggregate -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))

88 SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))

86 SExpr -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))

89 SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)

87 SResult -> \f _ (AHNonEmpty as) -> AHNonEmpty (fmap f as)

90− SInsert -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))

91 SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))

88 SName -> \_ f (AHNonEmpty (NonEmptyTable a)) -> AHNonEmpty (NonEmptyTable (f a))

92 SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)

89 SReify context -> \f g (AHNonEmpty as) -> AHNonEmpty (smapNonEmpty context f g as)

93

90

@@ -101,7 +98,6 @@ sfromColumnsNonEmpty = \case

101 SExpr -> AHNonEmpty . NonEmptyTable

98 SExpr -> AHNonEmpty . NonEmptyTable

102 SResult ->

99 SResult ->

103 AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify

100 AHNonEmpty . fmap (fromColumns . hreify) . fromColumns . hunreify

104− SInsert -> AHNonEmpty . NonEmptyTable

105 SName -> AHNonEmpty . NonEmptyTable

101 SName -> AHNonEmpty . NonEmptyTable

106 SReify context ->

102 SReify context ->

107 AHNonEmpty .

103 AHNonEmpty .

@@ -119,7 +115,6 @@ stoColumnsNonEmpty = \case

119 SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a

115 SExpr -> \(AHNonEmpty (NonEmptyTable a)) -> a

120 SResult ->

116 SResult ->

121 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)

117 hreify . toColumns . fmap (hunreify . toColumns) . (\(AHNonEmpty a) -> a)

122− SInsert -> \(AHNonEmpty (NonEmptyTable a)) -> a

123 SName -> \(AHNonEmpty (NonEmptyTable a)) -> a

118 SName -> \(AHNonEmpty (NonEmptyTable a)) -> a

124 SReify context ->

119 SReify context ->

125 hreify .

120 hreify .

src/Rel8/Column/These.hs−13

@@ -24,7 +24,6 @@ import Rel8.Expr ( Expr )

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

25import Rel8.Schema.Context ( Col )

26import Rel8.Schema.HTable.These ( HTheseTable )

27−import Rel8.Schema.Insert ( Insert )

28import qualified Rel8.Schema.Kind as K

27import qualified Rel8.Schema.Kind as K

29import Rel8.Schema.Name ( Name )

28import Rel8.Schema.Name ( Name )

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

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

@@ -45,7 +44,6 @@ type family HThese context where

45 HThese (Reify context) = AHThese context

44 HThese (Reify context) = AHThese context

46 HThese Aggregate = TheseTable

45 HThese Aggregate = TheseTable

47 HThese Expr = TheseTable

46 HThese Expr = TheseTable

48− HThese Insert = TheseTable

49 HThese Name = TheseTable

47 HThese Name = TheseTable

50 HThese Result = These

48 HThese Result = These

51

49

@@ -97,7 +95,6 @@ sbimapThese = \case

97 SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)

95 SAggregate -> \f g (AHThese a) -> AHThese (bimap f g a)

98 SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)

96 SExpr -> \f g (AHThese a) -> AHThese (bimap f g a)

99 SResult -> \f g (AHThese a) -> AHThese (bimap f g a)

97 SResult -> \f g (AHThese a) -> AHThese (bimap f g a)

100− SInsert -> \f g (AHThese a) -> AHThese (bimap f g a)

101 SName -> \f g (AHThese a) -> AHThese (bimap f g a)

98 SName -> \f g (AHThese a) -> AHThese (bimap f g a)

102 SReify context -> \f g (AHThese a) -> AHThese (sbimapThese context f g a)

99 SReify context -> \f g (AHThese a) -> AHThese (sbimapThese context f g a)

103

100

@@ -122,11 +119,6 @@ sfromColumnsThese = \case

122 bimap (fromColumns . hreify) (fromColumns . hreify) .

119 bimap (fromColumns . hreify) (fromColumns . hreify) .

123 fromColumns .

120 fromColumns .

124 hunreify

121 hunreify

125− SInsert ->

126− AHThese .

127− bimap (fromColumns . hreify) (fromColumns . hreify) .

128− fromColumns .

129− hunreify

130 SName ->

122 SName ->

131 AHThese .

123 AHThese .

132 bimap (fromColumns . hreify) (fromColumns . hreify) .

124 bimap (fromColumns . hreify) (fromColumns . hreify) .

@@ -159,11 +151,6 @@ stoColumnsThese = \case

159 toColumns .

151 toColumns .

160 bimap (hunreify . toColumns) (hunreify . toColumns) .

152 bimap (hunreify . toColumns) (hunreify . toColumns) .

161 (\(AHThese a) -> a)

153 (\(AHThese a) -> a)

162− SInsert ->

163− hreify .

164− toColumns .

165− bimap (hunreify . toColumns) (hunreify . toColumns) .

166− (\(AHThese a) -> a)

167 SName ->

154 SName ->

168 hreify .

155 hreify .

169 toColumns .

156 toColumns .

src/Rel8/Expr.hs+1−1

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

128

129instance Interpretation Expr where

130 data Col Expr _spec where

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

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

132

133

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

src/Rel8/Expr/Opaleye.hs+2−2

@@ -48,8 +48,8 @@ sunsafeCastExpr TypeInformation {typeName} =

48 fromPrimExpr . Opaleye.CastExpr typeName . toPrimExpr

49

50

51−unsafeLiteral :: Sql DBType a => String -> Expr a

51+unsafeLiteral :: String -> Expr a

52−unsafeLiteral = castExpr . Expr . Opaleye.ConstExpr . Opaleye.OtherLit

52+unsafeLiteral = Expr . Opaleye.ConstExpr . Opaleye.OtherLit

53

54

55fromPrimExpr :: Opaleye.PrimExpr -> Expr a

src/Rel8/Expr/Sequence.hsnew file+21

@@ -0,0 +1,21 @@

1+module Rel8.Expr.Sequence

2+ ( nextval

3+ )

4+where

5+

6+-- base

7+import Data.Int ( Int64 )

8+import Prelude

9+

10+-- rel8

11+import Rel8.Expr ( Expr )

12+import Rel8.Expr.Function ( function )

13+import Rel8.Expr.Serialize ( litExpr )

14+

15+-- text

16+import Data.Text ( pack )

17+

18+

19+-- | See https://www.postgresql.org/docs/current/functions-sequence.html

20+nextval :: String -> Expr Int64

21+nextval = function "nextval" . litExpr . pack

src/Rel8/Expr/Time.hs+2−2

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

31-- rel8

32import Rel8.Expr ( Expr )

33import Rel8.Expr.Function ( binaryOperator, nullaryFunction )

34−import Rel8.Expr.Opaleye ( unsafeCastExpr, unsafeLiteral )

34+import Rel8.Expr.Opaleye ( castExpr, unsafeCastExpr, unsafeLiteral )

35

36-- time

37import Data.Time.Calendar ( Day )

@@ -164,4 +164,4 @@ years = (`scaleInterval` year)

164

165

166singleton :: String -> Expr CalendarDiffTime

167−singleton unit = unsafeLiteral $ "'1 " ++ unit ++ "'"

167+singleton unit = castExpr $ unsafeLiteral $ "'1 " ++ unit ++ "'"

src/Rel8/Generic/Construction.hs−58

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

16module Rel8.Generic.Construction

17 ( GGBuildable

18 , GGBuild, ggbuild

19− , GGInsert, gginsert

20 , GGConstructable

19 , GGConstructable

21 , GGConstruct, ggconstruct

20 , GGConstruct, ggconstruct

22 , GGDeconstruct, ggdeconstruct

21 , GGDeconstruct, ggdeconstruct

@@ -63,7 +62,6 @@ import qualified Rel8.Kind.Algebra as K

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

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

64import Rel8.Schema.HTable ( HTable )

63import Rel8.Schema.HTable ( HTable )

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

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

66−import Rel8.Schema.Insert ( Col( I ), Create(..), Insert )

67import qualified Rel8.Schema.Kind as K

65import qualified Rel8.Schema.Kind as K

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

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

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

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

@@ -83,7 +81,6 @@ type GGBuildable algebra name rep =

83 ( KnownAlgebra algebra

81 ( KnownAlgebra algebra

84 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

82 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

85 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

83 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

86− , Eval (GGColumns algebra TColumns (Eval (rep (Reify Insert)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

87 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

84 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

88 , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))

85 , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))

89 , GGBuildable' algebra name rep

86 , GGBuildable' algebra name rep

@@ -94,17 +91,12 @@ type GGBuildable' :: K.Algebra -> Symbol -> (K.Context -> Exp (Type -> Type)) ->

94type family GGBuildable' algebra name rep where

91type family GGBuildable' algebra name rep where

95 GGBuildable' 'K.Product name rep =

92 GGBuildable' 'K.Product name rep =

96 ( name ~ GConstructor (Eval (rep (Reify Expr)))

93 ( name ~ GConstructor (Eval (rep (Reify Expr)))

97− , name ~ GConstructor (Eval (rep (Reify Insert)))

98 , Representable TUnreify (Eval (rep (Reify Expr)))

94 , Representable TUnreify (Eval (rep (Reify Expr)))

99− , Representable TUnreify (Eval (rep (Reify Insert)))

100 , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))

95 , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))

101− , GConstructable (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))

102 )

96 )

103 GGBuildable' 'K.Sum name rep =

97 GGBuildable' 'K.Sum name rep =

104 ( Representable TUnreify (GConstructorADT name (Eval (rep (Reify Expr))))

98 ( Representable TUnreify (GConstructorADT name (Eval (rep (Reify Expr))))

105− , Representable TUnreify (GConstructorADT name (Eval (rep (Reify Insert))))

106 , GMakeableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) name (Eval (rep (Reify Expr)))

99 , GMakeableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) name (Eval (rep (Reify Expr)))

107− , GMakeableADT (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) name (Eval (rep (Reify Insert)))

108 )

100 )

109

101

110

102

@@ -150,56 +142,11 @@ ggbuild gfromColumns = case algebraSing @algebra of

150 (HType . Reify . E . litExpr)

142 (HType . Reify . E . litExpr)

151

143

152

144

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

154−type family GGInsert algebra name rep r where

155− GGInsert 'K.Product _name rep r =

156− GConstruct TUnreify (Eval (rep (Reify Insert))) r

157− GGInsert 'K.Sum name rep r =

158− GConstruct TUnreify (GConstructorADT name (Eval (rep (Reify Insert)))) r

159−

160−

161−gginsert :: forall algebra name rep a. GGBuildable algebra name rep

162− => (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))) (Col Insert) -> a)

163− -> GGInsert algebra name rep a

164−gginsert gfromColumns = case algebraSing @algebra of

165− SProduct ->

166− gtabulate @TUnreify @(Eval (rep (Reify Insert))) @a $

167− gfromColumns .

168− hunreify .

169− gconstruct

170− @(TTable (Reify Insert))

171− @TColumns

172− @TUnreify

173− @(Col (Reify Insert))

174− @(Eval (rep (Reify Insert)))

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

176− SSum ->

177− gtabulate @TUnreify @(GConstructorADT name (Eval (rep (Reify Insert)))) @a $

178− gfromColumns .

179− hunreify .

180− gmakeADT

181− @(TTable (Reify Insert))

182− @TColumns

183− @TUnreify

184− @(Col (Reify Insert))

185− @name

186− @(Eval (rep (Reify Insert)))

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

188− (\SSpec {info} -> Reify $ I (Value (snull info)))

189− (\SSpec {nullity} -> case nullity of

190− Null -> id

191− NotNull -> \case

192− Reify (I Default) -> Reify (I Default)

193− Reify (I (Value a)) -> Reify (I (Value (nullify a))))

194− (HType . Reify . I . Value . litExpr)

195−

196−

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

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

198type GGConstructable algebra rep =

146type GGConstructable algebra rep =

199 ( KnownAlgebra algebra

147 ( KnownAlgebra algebra

200 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

148 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Aggregate)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

201 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

149 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Expr)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

202− , Eval (GGColumns algebra TColumns (Eval (rep (Reify Insert)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

203 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

150 , Eval (GGColumns algebra TColumns (Eval (rep (Reify Name)))) ~ Eval (GGColumns algebra TColumns (Eval (rep (Reify Result))))

204 , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))

151 , HTable (Eval (GGColumns algebra TColumns (Eval (rep (Reify Result)))))

205 , GGConstructable' algebra rep

152 , GGConstructable' algebra rep

@@ -211,24 +158,19 @@ type family GGConstructable' algebra rep where

211 GGConstructable' 'K.Product rep =

158 GGConstructable' 'K.Product rep =

212 ( Representable TUnreify (Eval (rep (Reify Aggregate)))

159 ( Representable TUnreify (Eval (rep (Reify Aggregate)))

213 , Representable TUnreify (Eval (rep (Reify Expr)))

160 , Representable TUnreify (Eval (rep (Reify Expr)))

214− , Representable TUnreify (Eval (rep (Reify Insert)))

215 , Representable TUnreify (Eval (rep (Reify Name)))

161 , Representable TUnreify (Eval (rep (Reify Name)))

216 , GConstructable (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))

162 , GConstructable (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))

217 , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))

163 , GConstructable (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))

218− , GConstructable (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))

219 , GConstructable (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))

164 , GConstructable (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))

220 )

165 )

221 GGConstructable' 'K.Sum rep =

166 GGConstructable' 'K.Sum rep =

222 ( RepresentableConstructors TUnreify (Eval (rep (Reify Expr)))

167 ( RepresentableConstructors TUnreify (Eval (rep (Reify Expr)))

223− , RepresentableConstructors TUnreify (Eval (rep (Reify Insert)))

224 , RepresentableFields TUnreify (Eval (rep (Reify Aggregate)))

168 , RepresentableFields TUnreify (Eval (rep (Reify Aggregate)))

225 , RepresentableFields TUnreify (Eval (rep (Reify Expr)))

169 , RepresentableFields TUnreify (Eval (rep (Reify Expr)))

226 , RepresentableFields TUnreify (Eval (rep (Reify Name)))

170 , RepresentableFields TUnreify (Eval (rep (Reify Name)))

227 , Functor (GConstructors TUnreify (Eval (rep (Reify Expr))))

171 , Functor (GConstructors TUnreify (Eval (rep (Reify Expr))))

228− , Functor (GConstructors TUnreify (Eval (rep (Reify Insert))))

229 , GConstructableADT (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))

172 , GConstructableADT (TTable (Reify Aggregate)) TColumns TUnreify (Col (Reify Aggregate)) (Eval (rep (Reify Aggregate)))

230 , GConstructableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))

173 , GConstructableADT (TTable (Reify Expr)) TColumns TUnreify (Col (Reify Expr)) (Eval (rep (Reify Expr)))

231− , GConstructableADT (TTable (Reify Insert)) TColumns TUnreify (Col (Reify Insert)) (Eval (rep (Reify Insert)))

232 , GConstructableADT (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))

174 , GConstructableADT (TTable (Reify Name)) TColumns TUnreify (Col (Reify Name)) (Eval (rep (Reify Name)))

233 )

175 )

234

176

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

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

64

65

66type Null :: K.HContext -> Type

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

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

68− => SSpec ('Spec labels necessity a)

68+ => SSpec ('Spec labels a)

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

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

70

71

72type Nullifier :: K.HContext -> Type

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

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

74− => SSpec ('Spec labels necessity a)

74+ => SSpec ('Spec labels a)

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

75+ -> context ('Spec labels a)

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

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

77

78

79type Unnullifier :: K.HContext -> Type

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

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

81− => SSpec ('Spec labels necessity a)

81+ => SSpec ('Spec labels a)

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

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

83− -> context ('Spec labels necessity a)

83+ -> context ('Spec labels a)

84

85

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

src/Rel8/Generic/Rel8able/Test.hs+1−1

@@ -36,7 +36,7 @@ data TableTest f = TableTest

36

37

38data TablePair f = TablePair

39− { foo :: Default f Bool

39+ { foo :: Column f Bool

40 , bars :: (Column f Text, Column f Text)

41 }

42 deriving stock Generic

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

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

148 , Eval (GGTable algebra _Table _Columns context rep)

149 )

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

151− -> (forall a labels necessity. ()

151+ -> (forall a labels. ()

152− => SSpec ('Spec labels necessity a)

152+ => SSpec ('Spec labels a)

153− -> context ('Spec labels necessity a)

153+ -> context ('Spec labels a)

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

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

155 -> Eval (GGColumns algebra _Columns rep) context

156ggtable = case algebraSing @algebra of

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

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

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

96

97 gtableADT :: ()

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

99− -> (forall a labels necessity. ()

99+ -> (forall a labels. ()

100− => SSpec ('Spec labels necessity a)

100+ => SSpec ('Spec labels a)

101− -> context ('Spec labels necessity a)

101+ -> context ('Spec labels a)

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

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

103 -> GColumnsADT _Columns rep context

104

105

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

136class GTableADT' _Table _Columns htable context rep where

137 gtableADT' :: ()

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

139− -> (forall a labels necessity. ()

139+ -> (forall a labels. ()

140− => SSpec ('Spec labels necessity a)

140+ => SSpec ('Spec labels a)

141− -> context ('Spec labels necessity a)

141+ -> context ('Spec labels a)

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

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

143 -> htable context

144 -> GColumnsADT' _Columns htable rep context

145

src/Rel8/Kind/Context.hs−8

@@ -21,7 +21,6 @@ import Rel8.Expr ( Expr )

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

22import Rel8.Schema.Context ( Interpretation )

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

24−import Rel8.Schema.Insert ( Insert )

25import Rel8.Schema.Kind ( Context )

24import Rel8.Schema.Kind ( Context )

26import Rel8.Schema.Name ( Name )

25import Rel8.Schema.Name ( Name )

27import Rel8.Schema.Reify ( Reify )

26import Rel8.Schema.Reify ( Reify )

@@ -32,7 +31,6 @@ type SContext :: Context -> Type

32data SContext context where

31data SContext context where

33 SAggregate :: SContext Aggregate

32 SAggregate :: SContext Aggregate

34 SExpr :: SContext Expr

33 SExpr :: SContext Expr

35− SInsert :: SContext Insert

36 SName :: SContext Name

34 SName :: SContext Name

37 SResult :: SContext Result

35 SResult :: SContext Result

38 SReify :: SContext context -> SContext (Reify context)

36 SReify :: SContext context -> SContext (Reify context)

@@ -55,10 +53,6 @@ instance Reifiable Result where

55 contextSing = SResult

53 contextSing = SResult

56

54

57

55

58−instance Reifiable Insert where

59− contextSing = SInsert

60−

61−

62instance Reifiable Name where

56instance Reifiable Name where

63 contextSing = SName

57 contextSing = SName

64

58

@@ -71,7 +65,6 @@ sReifiable :: SContext context -> Dict Reifiable context

71sReifiable = \case

65sReifiable = \case

72 SAggregate -> Dict

66 SAggregate -> Dict

73 SExpr -> Dict

67 SExpr -> Dict

74− SInsert -> Dict

75 SName -> Dict

68 SName -> Dict

76 SResult -> Dict

69 SResult -> Dict

77 SReify context -> case sReifiable context of

70 SReify context -> case sReifiable context of

@@ -82,7 +75,6 @@ sLabelable :: SContext context -> Dict Labelable context

82sLabelable = \case

75sLabelable = \case

83 SAggregate -> Dict

76 SAggregate -> Dict

84 SExpr -> Dict

77 SExpr -> Dict

85− SInsert -> Dict

86 SName -> Dict

78 SName -> Dict

87 SResult -> Dict

79 SResult -> Dict

88 SReify context -> case sLabelable context of

80 SReify context -> case sLabelable context of

src/Rel8/Kind/Necessity.hsdeleted−38

@@ -1,38 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language FlexibleContexts #-}

3−{-# language GADTs #-}

4−{-# language StandaloneKindSignatures #-}

5−

6−module Rel8.Kind.Necessity

7− ( Necessity( Optional, Required )

8− , SNecessity( SOptional, SRequired )

9− , KnownNecessity( necessitySing )

10− )

11−where

12−

13−-- base

14−import Data.Kind ( Constraint, Type )

15−import Prelude ()

16−

17−

18−type Necessity :: Type

19−data Necessity = Optional | Required

20−

21−

22−type SNecessity :: Necessity -> Type

23−data SNecessity necessity where

24− SOptional :: SNecessity 'Optional

25− SRequired :: SNecessity 'Required

26−

27−

28−type KnownNecessity :: Necessity -> Constraint

29−class KnownNecessity necessity where

30− necessitySing :: SNecessity necessity

31−

32−

33−instance KnownNecessity 'Optional where

34− necessitySing = SOptional

35−

36−

37−instance KnownNecessity 'Required where

38− necessitySing = SRequired

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

@@ -26,12 +26,12 @@ import Rel8.Schema.Spec.ConstrainDBType ( ConstrainDBType )

26type Labelable :: Context -> Constraint

27class Interpretation context => Labelable context where

28 labeler :: ()

29− => Col context ('Spec labels necessity a)

29+ => Col context ('Spec labels a)

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

30+ -> Col context ('Spec (label ': labels) a)

31

32 unlabeler :: ()

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

33+ => Col context ('Spec (label ': labels) a)

34− -> Col context ('Spec labels necessity a)

34+ -> Col context ('Spec labels a)

35

36

37instance Labelable Result where

@@ -42,12 +42,12 @@ instance Labelable Result where

42type HLabelable :: HContext -> Constraint

43class HLabelable context where

44 hlabeler :: ()

45− => context ('Spec labels necessity a)

45+ => context ('Spec labels a)

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

46+ -> context ('Spec (label ': labels) a)

47

48 hunlabeler :: ()

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

49+ => context ('Spec (label ': labels) a)

50− -> context ('Spec labels necessity a)

50+ -> context ('Spec labels a)

51

52

53instance Labelable context => HLabelable (Col context) where

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

@@ -33,7 +33,6 @@ import Rel8.Expr ( Expr, Col( E ) )

33import Rel8.Expr.Bool ( boolExpr )

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

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

36−import Rel8.Kind.Necessity ( Necessity( Required ) )

37import Rel8.Schema.Context ( Interpretation )

36import Rel8.Schema.Context ( Interpretation )

38import qualified Rel8.Schema.Kind as K

37import qualified Rel8.Schema.Kind as K

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

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

@@ -56,27 +55,27 @@ class Interpretation context => Nullifiable context where

56 , Taggable a

55 , Taggable a

57 )

56 )

58 => Tag label a

57 => Tag label a

59− -> Col context ('Spec labels 'Required a)

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

60

59

61 decodeTag ::

60 decodeTag ::

62 ( Sql (ConstrainTag context) a

61 ( Sql (ConstrainTag context) a

63 , KnownSymbol label

62 , KnownSymbol label

64 , Taggable a

63 , Taggable a

65 )

64 )

66− => Col context ('Spec labels 'Required a)

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

67 -> Tag label a

66 -> Tag label a

68

67

69 nullifier :: ()

68 nullifier :: ()

70 => Tag label a

69 => Tag label a

71 -> (Expr a -> Expr Bool)

70 -> (Expr a -> Expr Bool)

72− -> SSpec ('Spec labels necessity x)

71+ -> SSpec ('Spec labels x)

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

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

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

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

75

74

76 unnullifier :: ()

75 unnullifier :: ()

77− => SSpec ('Spec labels necessity x)

76+ => SSpec ('Spec labels x)

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

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

79− -> Col context ('Spec labels necessity x)

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

80

79

81

80

82instance Nullifiable Aggregate where

81instance Nullifiable Aggregate where

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

148

147

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

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

150 => Tag label a

149 => Tag label a

151− -> context ('Spec labels 'Required a)

150+ -> context ('Spec labels a)

152

151

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

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

154− => context ('Spec labels 'Required a)

153+ => context ('Spec labels a)

155 -> Tag label a

154 -> Tag label a

156

155

157 hnullifier :: ()

156 hnullifier :: ()

158 => Tag label a

157 => Tag label a

159 -> (Expr a -> Expr Bool)

158 -> (Expr a -> Expr Bool)

160− -> SSpec ('Spec labels necessity x)

159+ -> SSpec ('Spec labels x)

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

160+ -> context ('Spec labels x)

162− -> context ('Spec labels necessity (Nullify x))

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

163

162

164 hunnullifier :: ()

163 hunnullifier :: ()

165− => SSpec ('Spec labels necessity x)

164+ => SSpec ('Spec labels x)

166− -> context ('Spec labels necessity (Nullify x))

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

167− -> context ('Spec labels necessity x)

166+ -> context ('Spec labels x)

168

167

169

168

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

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

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

@@ -14,7 +14,6 @@ import GHC.Generics ( Generic )

14import Prelude ()

15

16-- rel8

17−import Rel8.Kind.Necessity ( Necessity( Required ) )

18import Rel8.Schema.HTable ( HTable )

17import Rel8.Schema.HTable ( HTable )

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

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

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

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

@@ -26,7 +25,7 @@ import Rel8.Type.Tag ( EitherTag )

26

25

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

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

28data HEitherTable left right context = HEitherTable

27data HEitherTable left right context = HEitherTable

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

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

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

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

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

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

32 }

31 }

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

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

15import Prelude

16

17-- rel8

18−import Rel8.Kind.Necessity ( Necessity( Required ) )

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

18import Rel8.Schema.Dict ( Dict( Dict ) )

20import Rel8.Schema.HTable

19import Rel8.Schema.HTable

21 ( HTable, HConstrainTable, HField

20 ( HTable, HConstrainTable, HField

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

26

25

27

26

28type HType :: Type -> K.HTable

27type HType :: Type -> K.HTable

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

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

30

29

31

30

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

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

33pattern HType a = HIdentity a

32pattern HType a = HIdentity a

34{-# COMPLETE HType #-}

33{-# COMPLETE HType #-}

35

34

src/Rel8/Schema/HTable/Label.hs+7−7

@@ -49,7 +49,7 @@ newtype HLabel label table context = HLabel (HMapTable (Label label) table conte

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

50

51

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

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

53

54

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

@@ -58,9 +58,9 @@ instance KnownSymbol l => MapSpec (Label l) where

58

59

60hlabel :: (HTable t, KnownSymbol label)

61− => (forall labels necessity a. ()

61+ => (forall labels a. ()

62− => context ('Spec labels necessity a)

62+ => context ('Spec labels a)

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

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

64 -> t context

65 -> HLabel label t context

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

@@ -70,9 +70,9 @@ hlabel labeler a = HLabel $ htabulate $ \(HMapTableField field) ->

70

71

72hunlabel :: (HTable t, KnownSymbol label)

73− => (forall labels necessity a. ()

73+ => (forall labels a. ()

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

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

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

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

76 -> HLabel label t context

77 -> t context

78hunlabel unlabler (HLabel as) =

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

@@ -14,7 +14,6 @@ import GHC.Generics ( Generic )

14import Prelude

15

16-- rel8

17−import Rel8.Kind.Necessity ( Necessity( Required ) )

18import Rel8.Schema.HTable ( HTable )

17import Rel8.Schema.HTable ( HTable )

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

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

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

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

@@ -26,7 +25,7 @@ import Rel8.Type.Tag ( MaybeTag )

26

25

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

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

28data HMaybeTable table context = HMaybeTable

27data HMaybeTable table context = HMaybeTable

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

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

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

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

31 }

30 }

32 deriving stock Generic

31 deriving stock Generic

src/Rel8/Schema/HTable/Nullify.hs+14−15

@@ -50,15 +50,14 @@ newtype HNullify table context = HNullify (HMapTable Nullify table context)

50data Nullify :: Spec -> Exp Spec

51

52

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

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

54− 'Spec labels necessity (Type.Nullify a)

54+ 'Spec labels (Type.Nullify a)

55

56

57instance MapSpec Nullify where

58 mapInfo = \case

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

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

60 { labels

61− , necessity

62 , info

61 , info

63 , nullity = case nullity of

62 , nullity = case nullity of

64 Null -> Null

63 Null -> Null

@@ -67,9 +66,9 @@ instance MapSpec Nullify where

67

66

68

67

69hnulls :: HTable t

68hnulls :: HTable t

70− => (forall labels necessity a. ()

69+ => (forall labels a. ()

71− => SSpec ('Spec labels necessity a)

70+ => SSpec ('Spec labels a)

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

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

73 -> HNullify t context

72 -> HNullify t context

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

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

75 spec@SSpec {} -> null spec

74 spec@SSpec {} -> null spec

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

77

76

78

77

79hnullify :: HTable t

78hnullify :: HTable t

80− => (forall labels necessity a. ()

79+ => (forall labels a. ()

81− => SSpec ('Spec labels necessity a)

80+ => SSpec ('Spec labels a)

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

81+ -> context ('Spec labels a)

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

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

84 -> t context

83 -> t context

85 -> HNullify t context

84 -> HNullify t context

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

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

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

90

89

91

90

92hunnullify :: (HTable t, Apply m)

91hunnullify :: (HTable t, Apply m)

93− => (forall labels necessity a. ()

92+ => (forall labels a. ()

94− => SSpec ('Spec labels necessity a)

93+ => SSpec ('Spec labels a)

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

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

96− -> m (context ('Spec labels necessity a)))

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

97 -> HNullify t context

96 -> HNullify t context

98 -> m (t context)

97 -> m (t context)

99hunnullify unnullifier (HNullify as) =

98hunnullify unnullifier (HNullify as) =

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

@@ -14,7 +14,6 @@ import GHC.Generics ( Generic )

14import Prelude

15

16-- rel8

17−import Rel8.Kind.Necessity ( Necessity( Required ) )

18import Rel8.Schema.HTable ( HTable )

17import Rel8.Schema.HTable ( HTable )

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

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

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

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

@@ -26,9 +25,9 @@ import Rel8.Type.Tag ( MaybeTag )

26

25

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

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

28data HTheseTable here there context = HTheseTable

27data HTheseTable here there context = HTheseTable

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

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

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

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

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

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

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

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

33 }

32 }

34 deriving stock Generic

33 deriving stock Generic

src/Rel8/Schema/HTable/Vectorize.hs+16−18

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

32import Prelude

33

34-- rel8

35−import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )

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

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

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

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

38import qualified Rel8.Schema.Kind as K

37import qualified Rel8.Schema.Kind as K

@@ -79,25 +78,24 @@ newtype HVectorize list table context = HVectorize (HMapTable (Vectorize list) t

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

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

80

79

81

80

82−type instance Eval (Vectorize list ('Spec labels _necessity a)) = 'Spec labels 'Required (list a)

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

83

82

84

83

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

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

86 mapInfo = \case

85 mapInfo = \case

87 SSpec {..} -> case listNotNull @list nullity of

86 SSpec {..} -> case listNotNull @list nullity of

88 Dict -> SSpec

87 Dict -> SSpec

89− { necessity = SRequired

90− , nullity = NotNull

88+ { nullity = NotNull

91 , info = vectorTypeInformation nullity info

89 , info = vectorTypeInformation nullity info

92 , ..

90 , ..

93 }

91 }

94

92

95

93

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

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

97− => (forall labels necessity a. ()

95+ => (forall labels a. ()

98− => SSpec ('Spec labels necessity a)

96+ => SSpec ('Spec labels a)

99− -> f (context ('Spec labels necessity a))

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

100− -> context' ('Spec labels 'Required (list a)))

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

101 -> f (t context)

99 -> f (t context)

102 -> HVectorize list t context'

100 -> HVectorize list t context'

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

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

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

107

105

108

106

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

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

110− => (forall labels necessity a. ()

108+ => (forall labels a. ()

111− => SSpec ('Spec labels necessity a)

109+ => SSpec ('Spec labels a)

112− -> context ('Spec labels 'Required (list a))

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

113− -> f (context' ('Spec labels necessity a)))

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

114 -> HVectorize list t context

112 -> HVectorize list t context

115 -> f (t context')

113 -> f (t context')

116hunvectorize unvectorizer (HVectorize table) =

114hunvectorize unvectorizer (HVectorize table) =

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

121

119

122

120

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

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

124− ( forall labels necessity a. ()

122+ ( forall labels a. ()

125 => Nullity a

123 => Nullity a

126 -> TypeInformation (Unnullify a)

124 -> TypeInformation (Unnullify a)

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

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

128− -> context ('Spec labels necessity (list a))

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

129− -> context ('Spec labels necessity (list a))

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

130 )

128 )

131 -> HVectorize list t context

129 -> HVectorize list t context

132 -> HVectorize list t context

130 -> HVectorize list t context

@@ -138,10 +136,10 @@ happend append (HVectorize as) (HVectorize bs) = HVectorize $

138

136

139

137

140hempty :: HTable t =>

138hempty :: HTable t =>

141− ( forall labels necessity a. ()

139+ ( forall labels a. ()

142 => Nullity a

140 => Nullity a

143 -> TypeInformation (Unnullify a)

141 -> TypeInformation (Unnullify a)

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

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

145 )

143 )

146 -> HVectorize [] t context

144 -> HVectorize [] t context

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

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

src/Rel8/Schema/Insert.hsdeleted−164

@@ -1,164 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language DuplicateRecordFields #-}

3−{-# language FlexibleContexts #-}

4−{-# language FlexibleInstances #-}

5−{-# language GADTs #-}

6−{-# language LambdaCase #-}

7−{-# language MultiParamTypeClasses #-}

8−{-# language NamedFieldPuns #-}

9−{-# language PolyKinds #-}

10−{-# language StandaloneKindSignatures #-}

11−{-# language TypeFamilies #-}

12−{-# language UndecidableInstances #-}

13−{-# language UndecidableSuperClasses #-}

14−

15−module Rel8.Schema.Insert

16− ( Insert(..)

17− , OnConflict(..)

18− , Col( I, unI )

19− , Inserts

20− , Create(..)

21− )

22−where

23−

24−-- base

25−import Data.Functor.Identity ( Identity )

26−import Data.Kind ( Constraint, Type )

27−import Prelude

28−

29−-- rel8

30−import Rel8.Aggregate ( Aggregate )

31−import Rel8.Expr ( Expr )

32−import Rel8.Kind.Necessity ( Necessity(Optional, Required), KnownNecessity )

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

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

35−import Rel8.Schema.Context.Nullify

36− ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier

37− , runTag, unnull

38− )

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

40−import Rel8.Schema.Name ( Name, Selects )

41−import Rel8.Schema.Null ( Sql )

42−import Rel8.Schema.Reify ( notReify )

43−import Rel8.Schema.Result ( Result )

44−import Rel8.Schema.Spec ( SSpec(SSpec, nullity), Spec(Spec) )

45−import Rel8.Schema.Table ( TableSchema )

46−import Rel8.Statement.Returning ( Returning )

47−import Rel8.Table

48− ( Table, Context, Columns, fromColumns, toColumns

49− , reify, unreify

50− )

51−import Rel8.Table.Recontextualize ( Recontextualize )

52−import Rel8.Table.Tag ( Tag(..), fromExpr )

53−import Rel8.Type ( DBType )

54−

55−

56−-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@

57−-- statement.

58−data OnConflict

59− = Abort -- ^ @ON CONFLICT ABORT@

60− | DoNothing -- ^ @ON CONFLICT DO NOTHING@

61−

62−

63−-- | The constituent parts of a SQL @INSERT@ statement.

64−type Insert :: k -> Type

65−data Insert a where

66− Insert :: (Selects names exprs, Inserts exprs inserts) =>

67− { into :: TableSchema names

68− -- ^ Which table to insert into.

69− , rows :: [inserts]

70− -- ^ The rows to insert.

71− , onConflict :: OnConflict

72− -- ^ What to do if the inserted rows conflict with data already in the

73− -- table.

74− , returning :: Returning names a

75− -- ^ What information to return on completion.

76− }

77− -> Insert a

78−

79−

80−instance Interpretation Insert where

81− data Col Insert _spec where

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

83−

84−

85−type Create :: Necessity -> Type -> Type

86−data Create necessity a where

87− Default :: Create 'Optional a

88− Value :: Expr a -> Create necessity a

89−

90−

91−instance (KnownNecessity necessity, Sql DBType a) =>

92− Table Insert (Create necessity a)

93− where

94− type Columns (Create necessity a) = HIdentity ('Spec '[] necessity a)

95− type Context (Create necessity a) = Insert

96−

97− toColumns = HIdentity . I

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

99− reify = notReify

100− unreify = notReify

101−

102−

103−instance Sql DBType a =>

104− Recontextualize Aggregate Insert (Aggregate a) (Create 'Required a)

105−

106−

107−instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Create 'Required a)

108−

109−

110−instance Sql DBType a =>

111− Recontextualize Result Insert (Identity a) (Create 'Required a)

112−

113−

114−instance Sql DBType a =>

115− Recontextualize Insert Aggregate (Create 'Required a) (Aggregate a)

116−

117−

118−instance Sql DBType a => Recontextualize Insert Expr (Create 'Required a) (Expr a)

119−

120−

121−instance Sql DBType a =>

122− Recontextualize Insert Result (Create 'Required a) (Identity a)

123−

124−

125−instance Sql DBType a => Recontextualize Insert Insert (Create 'Required a) (Create 'Required a)

126−

127−

128−instance Sql DBType a => Recontextualize Insert Name (Create 'Required a) (Name a)

129−

130−

131−instance Sql DBType a => Recontextualize Name Insert (Name a) (Create 'Required a)

132−

133−

134−instance Labelable Insert where

135− labeler (I a) = I a

136− unlabeler (I a) = I a

137−

138−

139−instance Nullifiable Insert where

140− encodeTag = I . Value . expr

141−

142− decodeTag (I (Value a)) = fromExpr a

143−

144− nullifier Tag {expr} test SSpec {nullity} = \case

145− I Default -> I Default

146− I (Value a) -> I $ Value $ runTag nullity condition a

147− where

148− condition = test expr

149−

150− unnullifier SSpec {nullity} = \case

151− I Default -> I Default

152− I (Value a) -> I $ Value $ unnull nullity a

153−

154− {-# INLINABLE encodeTag #-}

155− {-# INLINABLE decodeTag #-}

156− {-# INLINABLE nullifier #-}

157− {-# INLINABLE unnullifier #-}

158−

159−

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

161−-- with the table @b@.

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

163−class Recontextualize Expr Insert exprs inserts => Inserts exprs inserts

164−instance Recontextualize Expr Insert exprs inserts => Inserts exprs inserts

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

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

84

85instance Interpretation Name where

86 data Col Name _spec where

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

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

88

89

90instance Labelable Name where

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

@@ -16,7 +16,6 @@ where

16import Prelude hiding ( null )

17

18-- rel8

19−import Rel8.Kind.Necessity ( Necessity( Required ) )

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

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

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

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

22import Rel8.Schema.Kind ( Context )

21import Rel8.Schema.Kind ( Context )

@@ -30,32 +29,32 @@ data Result a

30

29

31instance Interpretation Result where

30instance Interpretation Result where

32 data Col Result _spec where

31 data Col Result _spec where

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

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

34

33

35

34

36relabel :: ()

35relabel :: ()

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

36+ => HIdentity ('Spec labels a) (Col Result)

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

37+ -> HIdentity ('Spec relabels a) (Col Result)

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

38relabel (HIdentity (R a)) = HIdentity (R a)

40

39

41

40

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

41+null :: Col Result ('Spec labels (Maybe a))

43null = R Nothing

42null = R Nothing

44

43

45

44

46nullifier :: ()

45nullifier :: ()

47− => SSpec ('Spec labels necessity a)

46+ => SSpec ('Spec labels a)

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

47+ -> Col Result ('Spec labels a)

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

48+ -> Col Result ('Spec labels (Nullify a))

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

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

51 Null -> a

50 Null -> a

52 NotNull -> Just a

51 NotNull -> Just a

53

52

54

53

55unnullifier :: ()

54unnullifier :: ()

56− => SSpec ('Spec labels necessity a)

55+ => SSpec ('Spec labels a)

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

56+ -> Col Result ('Spec labels (Nullify a))

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

57+ -> Maybe (Col Result ('Spec labels a))

59unnullifier SSpec {nullity} (R a) =

58unnullifier SSpec {nullity} (R a) =

60 case nullity of

59 case nullity of

61 Null -> pure $ R a

60 Null -> pure $ R a

@@ -63,14 +62,14 @@ unnullifier SSpec {nullity} (R a) =

63

62

64

63

65vectorizer :: Functor f

64vectorizer :: Functor f

66− => SSpec ('Spec labels necessity a)

65+ => SSpec ('Spec labels a)

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

66+ -> f (Col Result ('Spec labels a))

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

67+ -> Col Result ('Spec labels (f a))

69vectorizer _ = R . fmap unR

68vectorizer _ = R . fmap unR

70

69

71

70

72unvectorizer :: Functor f

71unvectorizer :: Functor f

73− => SSpec ('Spec labels necessity a)

72+ => SSpec ('Spec labels a)

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

73+ -> Col Result ('Spec labels (f a))

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

74+ -> f (Col Result ('Spec labels a))

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

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

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

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

6

7module Rel8.Schema.Spec

8 ( Spec( Spec )

9− , SSpec( SSpec, labels, necessity, info, nullity )

9+ , SSpec( SSpec, labels, info, nullity )

10 , KnownSpec( specSing )

11 )

12where

@@ -17,29 +17,23 @@ import Prelude ()

17

18-- rel8

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

20−import Rel8.Kind.Necessity

21− ( Necessity

22− , SNecessity

23− , KnownNecessity, necessitySing

24− )

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

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

26import Rel8.Type ( DBType, typeInformation )

21import Rel8.Type ( DBType, typeInformation )

27import Rel8.Type.Information ( TypeInformation )

22import Rel8.Type.Information ( TypeInformation )

28

23

29

24

30type Spec :: Type

25type Spec :: Type

31−data Spec = Spec Labels Necessity Type

26+data Spec = Spec Labels Type

32

27

33

28

34type SSpec :: Spec -> Type

29type SSpec :: Spec -> Type

35data SSpec spec where

30data SSpec spec where

36 SSpec ::

31 SSpec ::

37 { labels :: SLabels labels

32 { labels :: SLabels labels

38− , necessity :: SNecessity necessity

39 , info :: TypeInformation (Unnullify a)

33 , info :: TypeInformation (Unnullify a)

40 , nullity :: Nullity a

34 , nullity :: Nullity a

41 }

35 }

42− -> SSpec ('Spec labels necessity a)

36+ -> SSpec ('Spec labels a)

43

37

44

38

45type KnownSpec :: Spec -> Constraint

39type KnownSpec :: Spec -> Constraint

@@ -49,14 +43,12 @@ class KnownSpec spec where

49

43

50instance

44instance

51 ( KnownLabels labels

45 ( KnownLabels labels

52− , KnownNecessity necessity

53 , Sql DBType a

46 , Sql DBType a

54 )

47 )

55− => KnownSpec ('Spec labels necessity a)

48+ => KnownSpec ('Spec labels a)

56 where

49 where

57 specSing = SSpec

50 specSing = SSpec

58 { labels = labelsSing

51 { labels = labelsSing

59− , necessity = necessitySing

60 , info = typeInformation

52 , info = typeInformation

61 , nullity = nullable

53 , nullity = nullable

62 }

54 }

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

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

31

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

33class

34− ( forall c labels necessity a. ()

34+ ( forall c labels a. ()

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

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

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

37 )

38 => ConstrainDBType constraint spec

39instance

40− ( spec ~ 'Spec labels necessity a

40+ ( spec ~ 'Spec labels a

41 , Sql constraint a

42 )

43 => ConstrainDBType constraint spec

44

45

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

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

47dbTypeNullity = step2 . step1

48 where

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

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

50 step1 Dict = Dict

51

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

53 step2 Dict = nullable

54

55

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

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

57dbTypeDict = step2 . step1

58 where

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

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

60 step1 Dict = Dict

61

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

63 step2 Dict = Dict

64

65

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

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

67fromNullityDict Null Dict = Dict

68fromNullityDict NotNull Dict = Dict

69

70

71nullifier :: ()

72− => SSpec ('Spec labels necessity a)

72+ => SSpec ('Spec labels a)

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

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

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

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

75nullifier SSpec {} dict = case dbTypeDict dict of

76 Dict -> case dbTypeNullity dict of

77 Null -> Dict

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

79

80

81unnullifier :: ()

82− => SSpec ('Spec labels necessity a)

82+ => SSpec ('Spec labels a)

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

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

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

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

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

86 Dict -> case nullity of

87 Null -> Dict

src/Rel8/Schema/Spec/ConstrainType.hsdeleted−31

@@ -1,31 +0,0 @@

1−{-# language ConstraintKinds #-}

2−{-# language DataKinds #-}

3−{-# language FlexibleInstances #-}

4−{-# language MultiParamTypeClasses #-}

5−{-# language QuantifiedConstraints #-}

6−{-# language StandaloneKindSignatures #-}

7−{-# language TypeFamilies #-}

8−{-# language UndecidableInstances #-}

9−

10−module Rel8.Schema.Spec.ConstrainType

11− ( ConstrainType

12− )

13−where

14−

15−-- base

16−import Data.Kind ( Constraint, Type )

17−import Prelude ()

18−

19−-- rel8

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

21−

22−

23−type ConstrainType :: (Type -> Constraint) -> Spec -> Constraint

24−class

25− ( forall labels necessity a. ()

26− => (spec ~ 'Spec labels necessity a)

27− => constraint a

28− ) =>

29− ConstrainType constraint spec

30−instance (spec ~ 'Spec labels necessity a, constraint a) =>

31− ConstrainType constraint spec

src/Rel8/Statement/Insert.hs+30−1

@@ -1,6 +1,8 @@

1+{-# language DuplicateRecordFields #-}

1{-# language GADTs #-}

2{-# language GADTs #-}

2{-# language NamedFieldPuns #-}

3{-# language NamedFieldPuns #-}

3{-# language ScopedTypeVariables #-}

4{-# language ScopedTypeVariables #-}

5+{-# language StandaloneKindSignatures #-}

4{-# language TypeApplications #-}

6{-# language TypeApplications #-}

5

7

6module Rel8.Statement.Insert

8module Rel8.Statement.Insert

@@ -13,6 +15,7 @@ where

13-- base

15-- base

14import Control.Exception ( throwIO )

16import Control.Exception ( throwIO )

15import Data.List.NonEmpty ( NonEmpty( (:|) ) )

17import Data.List.NonEmpty ( NonEmpty( (:|) ) )

18+import Data.Kind ( Type )

16import Prelude

19import Prelude

17

20

18-- hasql

21-- hasql

@@ -27,7 +30,8 @@ import qualified Opaleye.Internal.Manipulation as Opaleye

27import qualified Opaleye.Manipulation as Opaleye

30import qualified Opaleye.Manipulation as Opaleye

28

31

29-- rel8

32-- rel8

30−import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )

33+import Rel8.Schema.Name ( Selects )

34+import Rel8.Schema.Table ( TableSchema )

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

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

32import Rel8.Table ( fromColumns, toColumns )

36import Rel8.Table ( fromColumns, toColumns )

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

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

@@ -38,6 +42,31 @@ import qualified Data.Text as Text ( pack )

38import Data.Text.Encoding ( encodeUtf8 )

42import Data.Text.Encoding ( encodeUtf8 )

39

43

40

44

45+-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@

46+-- statement.

47+type OnConflict :: Type

48+data OnConflict

49+ = Abort -- ^ @ON CONFLICT ABORT@

50+ | DoNothing -- ^ @ON CONFLICT DO NOTHING@

51+

52+

53+-- | The constituent parts of a SQL @INSERT@ statement.

54+type Insert :: Type -> Type

55+data Insert a where

56+ Insert :: Selects names exprs =>

57+ { into :: TableSchema names

58+ -- ^ Which table to insert into.

59+ , rows :: [exprs]

60+ -- ^ The rows to insert.

61+ , onConflict :: OnConflict

62+ -- ^ What to do if the inserted rows conflict with data already in the

63+ -- table.

64+ , returning :: Returning names a

65+ -- ^ What information to return on completion.

66+ }

67+ -> Insert a

68+

69+

41-- | Run an @INSERT@ statement

70-- | Run an @INSERT@ statement

42insert :: Connection -> Insert a -> IO a

71insert :: Connection -> Insert a -> IO a

43insert c Insert {into, rows, onConflict, returning} =

72insert c Insert {into, rows, onConflict, returning} =

src/Rel8/Statement/Update.hs+2−6

@@ -25,9 +25,6 @@ import qualified Hasql.Statement as Hasql

25-- opaleye

26import qualified Opaleye.Internal.Manipulation as Opaleye

27

28−-- profunctors

29−import Data.Profunctor ( lmap )

30−

31-- rel8

28-- rel8

32import Rel8.Expr ( Expr )

29import Rel8.Expr ( Expr )

33import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )

30import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )

@@ -35,7 +32,6 @@ import Rel8.Schema.Name ( Selects )

35import Rel8.Schema.Table ( TableSchema )

32import Rel8.Schema.Table ( TableSchema )

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

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

37import Rel8.Table ( fromColumns, toColumns )

34import Rel8.Table ( fromColumns, toColumns )

38−import Rel8.Table.Insert ( toInsert )

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

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

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

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

41

37

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

74 prepare = False

70 prepare = False

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

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

76 where

72 where

77− target' = lmap toInsert $ table $ toColumns <$> target

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

78 set' = toColumns . set . fromColumns

74 set' = toColumns . set . fromColumns

79 where' = toColumn . toPrimExpr . updateWhere . fromColumns

75 where' = toColumn . toPrimExpr . updateWhere . fromColumns

80

76

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

94 where'

90 where'

95 project'

91 project'

96 where

92 where

97− target' = lmap toInsert $ table $ toColumns <$> target

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

98 set' = toColumns . set . fromColumns

94 set' = toColumns . set . fromColumns

99 where' = toColumn . toPrimExpr . updateWhere . fromColumns

95 where' = toColumn . toPrimExpr . updateWhere . fromColumns

100 project' = castTable . toColumns . project . fromColumns

96 project' = castTable . toColumns . project . fromColumns

src/Rel8/Table/ADT.hs−12

@@ -16,7 +16,6 @@ module Rel8.Table.ADT

16 , ADTable, fromADT, toADT

17 , BuildableADT

18 , BuildADT, buildADT

19− , InsertADT, insertADT

20 , ConstructableADT

19 , ConstructableADT

21 , ConstructADT, constructADT

20 , ConstructADT, constructADT

22 , DeconstructADT, deconstructADT

21 , DeconstructADT, deconstructADT

@@ -41,7 +40,6 @@ import Rel8.FCF ( Eval, Exp )

41import Rel8.Generic.Construction

40import Rel8.Generic.Construction

42 ( GGBuildable

41 ( GGBuildable

43 , GGBuild, ggbuild

42 , GGBuild, ggbuild

44− , GGInsert, gginsert

45 , GGConstructable

43 , GGConstructable

46 , GGConstruct, ggconstruct

44 , GGConstruct, ggconstruct

47 , GGDeconstruct, ggdeconstruct

45 , GGDeconstruct, ggdeconstruct

@@ -59,7 +57,6 @@ import qualified Rel8.Generic.Table.ADT as G

59import qualified Rel8.Kind.Algebra as K

57import qualified Rel8.Kind.Algebra as K

60import Rel8.Schema.Context ( Col )

58import Rel8.Schema.Context ( Col )

61import Rel8.Schema.HTable ( HTable )

59import Rel8.Schema.HTable ( HTable )

62−import Rel8.Schema.Insert ( Insert )

63import qualified Rel8.Schema.Kind as K

60import qualified Rel8.Schema.Kind as K

64import Rel8.Schema.Name ( Name )

61import Rel8.Schema.Name ( Name )

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

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

@@ -156,15 +153,6 @@ buildADT =

156 ggbuild @'K.Sum @name @(ADTRep t) @(ADT t Expr) ADT

153 ggbuild @'K.Sum @name @(ADTRep t) @(ADT t Expr) ADT

157

154

158

155

159−type InsertADT :: K.Rel8able -> Symbol -> Type

160−type InsertADT t name = GGInsert 'K.Sum name (ADTRep t) (ADT t Insert)

161−

162−

163−insertADT :: forall t name. BuildableADT t name => InsertADT t name

164−insertADT =

165− gginsert @'K.Sum @name @(ADTRep t) @(ADT t Insert) ADT

166−

167−

168type ConstructableADT :: K.Rel8able -> Constraint

156type ConstructableADT :: K.Rel8able -> Constraint

169class GGConstructable 'K.Sum (ADTRep t) => ConstructableADT t

157class GGConstructable 'K.Sum (ADTRep t) => ConstructableADT t

170instance GGConstructable 'K.Sum (ADTRep t) => ConstructableADT t

158instance GGConstructable 'K.Sum (ADTRep t) => ConstructableADT t

src/Rel8/Table/Either.hs+1−10

@@ -18,7 +18,7 @@ module Rel8.Table.Either

18 ( EitherTable(..)

19 , eitherTable, leftTable, rightTable

20 , isLeftTable, isRightTable

21− , insertEitherTable, nameEitherTable

21+ , nameEitherTable

22 )

23where

24

@@ -47,7 +47,6 @@ import Rel8.Schema.HTable.Either ( HEitherTable(..) )

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

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

49import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

50−import Rel8.Schema.Insert ( Insert )

51import Rel8.Schema.Name ( Name )

50import Rel8.Schema.Name ( Name )

52import Rel8.Table

51import Rel8.Table

53 ( Table, Columns, Context, fromColumns, toColumns

52 ( Table, Columns, Context, fromColumns, toColumns

@@ -55,7 +54,6 @@ import Rel8.Table

55 )

54 )

56import Rel8.Table.Bool ( bool )

55import Rel8.Table.Bool ( bool )

57import Rel8.Table.Eq ( EqTable, eqTable )

56import Rel8.Table.Eq ( EqTable, eqTable )

58−import Rel8.Table.Insert ( toInsert )

59import Rel8.Table.Ord ( OrdTable, ordTable )

57import Rel8.Table.Ord ( OrdTable, ordTable )

60import Rel8.Table.Recontextualize ( Recontextualize )

58import Rel8.Table.Recontextualize ( Recontextualize )

61import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

59import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -177,13 +175,6 @@ rightTableWith :: a -> b -> EitherTable a b

177rightTableWith = EitherTable (fromExpr (litExpr IsRight))

175rightTableWith = EitherTable (fromExpr (litExpr IsRight))

178

176

179

177

180−insertEitherTable :: (Table Insert a, Table Insert b)

181− => Either a b -> EitherTable a b

182−insertEitherTable = \case

183− Left a -> EitherTable (fromExpr (litExpr IsLeft)) a (fromColumns (toInsert undefined))

184− Right b -> EitherTable (fromExpr (litExpr IsRight)) (fromColumns (toInsert undefined)) b

185−

186−

187nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b

178nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b

188nameEitherTable = EitherTable . fromName

179nameEitherTable = EitherTable . fromName

189

180

src/Rel8/Table/HKD.hs−12

@@ -16,7 +16,6 @@ module Rel8.Table.HKD

16 , HKDable, fromHKD, toHKD, HKDT(..)

17 , BuildableHKD

18 , BuildHKD, buildHKD

19− , InsertHKD, insertHKD

20 , ConstructableHKD

19 , ConstructableHKD

21 , ConstructHKD, constructHKD

20 , ConstructHKD, constructHKD

22 , DeconstructHKD, deconstructHKD

21 , DeconstructHKD, deconstructHKD

@@ -44,7 +43,6 @@ import Rel8.Kind.Algebra ( KnownAlgebra )

44import Rel8.Generic.Construction

43import Rel8.Generic.Construction

45 ( GGBuildable

44 ( GGBuildable

46 , GGBuild, ggbuild

45 , GGBuild, ggbuild

47− , GGInsert, gginsert

48 , GGConstructable

46 , GGConstructable

49 , GGConstruct, ggconstruct

47 , GGConstruct, ggconstruct

50 , GGDeconstruct, ggdeconstruct

48 , GGDeconstruct, ggdeconstruct

@@ -66,7 +64,6 @@ import Rel8.Generic.Table

66import Rel8.Schema.Context ( Col )

64import Rel8.Schema.Context ( Col )

67import qualified Rel8.Schema.Kind as K

65import qualified Rel8.Schema.Kind as K

68import Rel8.Schema.HTable ( HTable )

66import Rel8.Schema.HTable ( HTable )

69−import Rel8.Schema.Insert ( Insert )

70import Rel8.Schema.Name ( Name )

67import Rel8.Schema.Name ( Name )

71import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify, notReify )

68import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify, notReify )

72import Rel8.Schema.Result ( Result )

69import Rel8.Schema.Result ( Result )

@@ -223,15 +220,6 @@ buildHKD =

223 ggbuild @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Expr) HKD

220 ggbuild @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Expr) HKD

224

221

225

222

226−type InsertHKD :: Type -> Symbol -> Type

227−type InsertHKD a name = GGInsert (GAlgebra (Rep a)) name (HKDRep a) (HKD a Insert)

228−

229−

230−insertHKD :: forall a name. BuildableHKD a name => InsertHKD a name

231−insertHKD =

232− gginsert @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Insert) HKD

233−

234−

235type ConstructableHKD :: Type -> Constraint

223type ConstructableHKD :: Type -> Constraint

236class GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a

224class GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a

237instance GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a

225instance GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a

src/Rel8/Table/Insert.hsdeleted−49

@@ -1,49 +0,0 @@

1−{-# language FlexibleContexts #-}

2−{-# language NamedFieldPuns #-}

3−{-# language TypeFamilies #-}

4−{-# language ViewPatterns #-}

5−

6−module Rel8.Table.Insert

7− ( toInsert

8− , toInsertDefaults

9− )

10−where

11−

12−-- base

13−import Prelude

14−

15−-- rel8

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

17−import Rel8.Kind.Necessity ( SNecessity( SOptional, SRequired ) )

18−import Rel8.Schema.HTable ( hfield, htabulate, hspecs )

19−import Rel8.Schema.Insert ( Inserts, Col( I ), Create(..) )

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

21−import Rel8.Table ( fromColumns, toColumns )

22−

23−

24−-- | @toInsert@ converts a 'Table' of 'Expr's into a 'Table' that can be used

25−-- with 'Rel8.insert'. This will override any columns that have default values

26−-- to use exactly what is given. If you want to use default values, you can

27−-- either override the result of @toInsert@, or use 'toInsertDefaults'.

28−toInsert :: Inserts exprs inserts => exprs -> inserts

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

30− case hfield hspecs field of

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

32− E expr -> Value expr

33−

34−

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

36−-- be used with 'Rel8.insert'. Any columns that have a default value will

37−-- override whatever is in the input expression.

38−--

39−-- One example where this is useful is for any table that has a special @id@

40−-- column, which has a default value to draw a new value from a sequence. If we

41−-- use 'toInsertDefaults', we can provide a dummy value that will be replaced

42−-- with a call to @DEFAULT@.

43−toInsertDefaults :: Inserts exprs inserts => exprs -> inserts

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

45− case hfield hspecs field of

46− SSpec {necessity} -> case hfield exprs field of

47− E expr -> I $ case necessity of

48− SRequired -> Value expr

49− SOptional -> Default

src/Rel8/Table/List.hs+1−7

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

10

11module Rel8.Table.List

12 ( ListTable(..)

13− , listTable, insertListTable, nameListTable

13+ , listTable, nameListTable

14 )

15where

16

@@ -26,7 +26,6 @@ import Rel8.Expr.Array ( sappend, sempty, slistOf )

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

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

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

29−import Rel8.Schema.Insert ( Inserts )

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

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

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

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

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

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

@@ -41,7 +40,6 @@ import Rel8.Table.Alternative

41 , AlternativeTable, emptyTable

40 , AlternativeTable, emptyTable

42 )

41 )

43import Rel8.Table.Eq ( EqTable, eqTable )

42import Rel8.Table.Eq ( EqTable, eqTable )

44−import Rel8.Table.Insert ( toInsert )

45import Rel8.Table.Ord ( OrdTable, ordTable )

43import Rel8.Table.Ord ( OrdTable, ordTable )

46import Rel8.Table.Recontextualize ( Recontextualize )

44import Rel8.Table.Recontextualize ( Recontextualize )

47import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

45import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -126,10 +124,6 @@ listTable =

126 fmap toColumns

124 fmap toColumns

127

125

128

126

129−insertListTable :: Inserts exprs inserts => [exprs] -> ListTable inserts

130−insertListTable = toInsert . listTable

131−

132−

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

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

134nameListTable =

128nameListTable =

135 ListTable .

129 ListTable .

src/Rel8/Table/Maybe.hs+1−9

@@ -17,7 +17,7 @@ module Rel8.Table.Maybe

17 , maybeTable, nothingTable, justTable

18 , isNothingTable, isJustTable

19 , ($?)

20− , insertMaybeTable, nameMaybeTable

20+ , nameMaybeTable

21 )

22where

23

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

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

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

46import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

47−import Rel8.Schema.Insert ( Insert )

48import Rel8.Schema.Name ( Name )

47import Rel8.Schema.Name ( Name )

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

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

50import Rel8.Table

49import Rel8.Table

@@ -57,7 +56,6 @@ import Rel8.Table.Alternative

57 )

56 )

58import Rel8.Table.Bool ( bool )

57import Rel8.Table.Bool ( bool )

59import Rel8.Table.Eq ( EqTable, eqTable )

58import Rel8.Table.Eq ( EqTable, eqTable )

60−import Rel8.Table.Insert ( toInsert )

61import Rel8.Table.Ord ( OrdTable, ordTable )

59import Rel8.Table.Ord ( OrdTable, ordTable )

62import Rel8.Table.Recontextualize ( Recontextualize )

60import Rel8.Table.Recontextualize ( Recontextualize )

63import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

61import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -209,12 +207,6 @@ f $? ma@(MaybeTable _ a) = case nullable @b of

209infixl 4 $?

207infixl 4 $?

210

208

211

209

212−insertMaybeTable :: Table Insert a => Maybe a -> MaybeTable a

213−insertMaybeTable = \case

214− Nothing -> MaybeTable (fromExpr null) (fromColumns (toInsert undefined))

215− Just a -> justTable a

216−

217−

218nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable a

210nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable a

219nameMaybeTable = MaybeTable . fromName

211nameMaybeTable = MaybeTable . fromName

220

212

src/Rel8/Table/NonEmpty.hs+1−8

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

10

11module Rel8.Table.NonEmpty

12 ( NonEmptyTable(..)

13− , nonEmptyTable, insertNonEmptyTable, nameNonEmptyTable

13+ , nonEmptyTable, nameNonEmptyTable

14 )

15where

16

@@ -27,7 +27,6 @@ import Rel8.Expr.Array ( sappend1, snonEmptyOf )

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

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

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

30−import Rel8.Schema.Insert ( Inserts )

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

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

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

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

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

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

@@ -39,7 +38,6 @@ import Rel8.Table

39 )

38 )

40import Rel8.Table.Alternative ( AltTable, (<|>:) )

39import Rel8.Table.Alternative ( AltTable, (<|>:) )

41import Rel8.Table.Eq ( EqTable, eqTable )

40import Rel8.Table.Eq ( EqTable, eqTable )

42−import Rel8.Table.Insert ( toInsert )

43import Rel8.Table.Ord ( OrdTable, ordTable )

41import Rel8.Table.Ord ( OrdTable, ordTable )

44import Rel8.Table.Recontextualize ( Recontextualize )

42import Rel8.Table.Recontextualize ( Recontextualize )

45import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

43import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -118,11 +116,6 @@ nonEmptyTable =

118 fmap toColumns

116 fmap toColumns

119

117

120

118

121−insertNonEmptyTable :: Inserts exprs inserts

122− => NonEmpty exprs -> NonEmptyTable inserts

123−insertNonEmptyTable = toInsert . nonEmptyTable

124−

125−

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

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

127nameNonEmptyTable =

120nameNonEmptyTable =

128 NonEmptyTable .

121 NonEmptyTable .

src/Rel8/Table/Opaleye.hs+8−21

@@ -43,9 +43,7 @@ import Rel8.Expr.Opaleye

43 , fromColumn, toColumn

44 , scastExpr

45 )

46−import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )

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

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

48−import Rel8.Schema.Insert ( Col( I ), Create(..), Insert, Inserts )

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

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

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

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

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

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

@@ -83,36 +81,25 @@ distinctspec =

83 toColumns

81 toColumns

84

82

85

83

86−table ::(Selects names exprs, Inserts exprs inserts)

87− => TableSchema names -> Opaleye.Table inserts exprs

84+table ::Selects names exprs => TableSchema names -> Opaleye.Table exprs exprs

88table (TableSchema name schema columns) =

85table (TableSchema name schema columns) =

89 case schema of

86 case schema of

90 Nothing -> Opaleye.Table name (tableFields columns)

87 Nothing -> Opaleye.Table name (tableFields columns)

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

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

92

89

93

90

94−tableFields :: (Selects names exprs, Inserts exprs inserts)

91+tableFields ::Selects names exprs

95− => names -> Opaleye.TableFields inserts exprs

92+ => names -> Opaleye.TableFields exprs exprs

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

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

97 unwrapApplicative $ htabulateA $ \field -> WrapApplicative $

94 unwrapApplicative $ htabulateA $ \field -> WrapApplicative $

98− case hfield hspecs field of

95+ case hfield names field of

99− specs -> case hfield names field of

100− name -> lmap (`hfield` field) (go specs name)

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

101 where

97 where

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

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

103− go SSpec {necessity} (N (Name name)) = case necessity of

99+ go (N (Name name)) =

104− SRequired ->

105− lmap (\(I (Value a)) -> toColumn $ toPrimExpr a) $

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

106 E . fromPrimExpr . fromColumn <$>

101 E . fromPrimExpr . fromColumn <$>

107 Opaleye.requiredTableField name

102 Opaleye.requiredTableField name

108− SOptional ->

109− lmap (\(I ma) -> toColumn . toPrimExpr <$> fromInsert ma) $

110− E . fromPrimExpr . fromColumn <$>

111− Opaleye.optionalTableField name

112− where

113− fromInsert = \case

114− Default -> Nothing

115− Value a -> Just a

116

103

117

104

118unpackspec :: Table Expr a => Opaleye.Unpackspec a a

105unpackspec :: Table Expr a => Opaleye.Unpackspec a a

src/Rel8/Table/These.hs+2−10

@@ -21,7 +21,7 @@ module Rel8.Table.These

21 , isThisTable, isThatTable, isThoseTable

22 , hasHereTable, hasThereTable

23 , justHereTable, justThereTable

24− , insertTheseTable, nameTheseTable

24+ , nameTheseTable

25 )

26where

27

@@ -51,7 +51,6 @@ import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

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

52import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

53import Rel8.Schema.HTable.These ( HTheseTable(..) )

54−import Rel8.Schema.Insert ( Insert )

55import Rel8.Schema.Name ( Name )

54import Rel8.Schema.Name ( Name )

56import Rel8.Table

55import Rel8.Table

57 ( Table, Columns, Context, fromColumns, toColumns

56 ( Table, Columns, Context, fromColumns, toColumns

@@ -62,7 +61,7 @@ import Rel8.Table.Maybe

62 ( MaybeTable(..)

61 ( MaybeTable(..)

63 , maybeTable, justTable, nothingTable

62 , maybeTable, justTable, nothingTable

64 , isJustTable

63 , isJustTable

65− , insertMaybeTable, nameMaybeTable

64+ , nameMaybeTable

66 )

65 )

67import Rel8.Table.Ord ( OrdTable, ordTable )

66import Rel8.Table.Ord ( OrdTable, ordTable )

68import Rel8.Table.Recontextualize ( Recontextualize )

67import Rel8.Table.Recontextualize ( Recontextualize )

@@ -77,7 +76,6 @@ import Data.Functor.Bind ( Bind, (>>-) )

77

76

78-- these

77-- these

79import Data.These ( These )

78import Data.These ( These )

80−import Data.These.Combinators ( justHere, justThere )

81

79

82

80

83type TheseTable :: Type -> Type -> Type

81type TheseTable :: Type -> Type -> Type

@@ -231,12 +229,6 @@ theseTable f g h TheseTable {here, there} =

231 there

229 there

232

230

233

231

234−insertTheseTable :: (Table Insert a, Table Insert b)

235− => These a b -> TheseTable a b

236−insertTheseTable =

237− TheseTable <$> insertMaybeTable . justHere <*> insertMaybeTable . justThere

238−

239−

240nameTheseTable :: ()

232nameTheseTable :: ()

241 => Name (Maybe MaybeTag)

233 => Name (Maybe MaybeTag)

242 -> Name (Maybe MaybeTag)

234 -> Name (Maybe MaybeTag)

src/Rel8/Table/Unreify.hs−4

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

41import Rel8.Expr ( Expr )

42import Rel8.Kind.Context ( SContext(..), Reifiable, sReifiable )

43import Rel8.Schema.Dict ( Dict( Dict ) )

44−import Rel8.Schema.Insert ( Insert )

45import qualified Rel8.Schema.Kind as K

44import qualified Rel8.Schema.Kind as K

46import Rel8.Schema.Name ( Name )

45import Rel8.Schema.Name ( Name )

47import Rel8.Schema.Reify ( Reify )

46import Rel8.Schema.Reify ( Reify )

@@ -59,7 +58,6 @@ type Unreifiable :: Type -> Constraint

59class

58class

60 ( Context a ~ Reify Aggregate => Unreifier Aggregate a

59 ( Context a ~ Reify Aggregate => Unreifier Aggregate a

61 , Context a ~ Reify Expr => Unreifier Expr a

60 , Context a ~ Reify Expr => Unreifier Expr a

62− , Context a ~ Reify Insert => Unreifier Insert a

63 , Context a ~ Reify Name => Unreifier Name a

61 , Context a ~ Reify Name => Unreifier Name a

64 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

62 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

65 )

63 )

@@ -67,7 +65,6 @@ class

67instance

65instance

68 ( Context a ~ Reify Aggregate => Unreifier Aggregate a

66 ( Context a ~ Reify Aggregate => Unreifier Aggregate a

69 , Context a ~ Reify Expr => Unreifier Expr a

67 , Context a ~ Reify Expr => Unreifier Expr a

70− , Context a ~ Reify Insert => Unreifier Insert a

71 , Context a ~ Reify Name => Unreifier Name a

68 , Context a ~ Reify Name => Unreifier Name a

72 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

69 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

73 )

70 )

@@ -99,7 +96,6 @@ unreifiability :: (Context a ~ Reify context, Unreifiable a)

99unreifiability = \case

96unreifiability = \case

100 SAggregate -> Unreifiability SAggregate

97 SAggregate -> Unreifiability SAggregate

101 SExpr -> Unreifiability SExpr

98 SExpr -> Unreifiability SExpr

102− SInsert -> Unreifiability SInsert

103 SName -> Unreifiability SName

99 SName -> Unreifiability SName

104 SResult -> UResult

100 SResult -> UResult

105 SReify context -> case sReifiable context of

101 SReify context -> case sReifiable context of