1eaa683 · rel8 · git.iko.soy

git.iko.soy/rel8

Get rid of defaulting and insert context altogether

commit1eaa683513729fb0517b8ba12899a7c1ad811a25 authorShane O'Brien <shane.obrien@circuithub.com> dateThu 17 Jun 2021, 13:30 (5 years ago) parent62f323a

50 files changed+284−790

compare with master

unifiedsplit

rel8.cabal+1−5 src/Rel8.hs+7−15 src/Rel8/Aggregate.hs+1−1 src/Rel8/Column.hs+77−12 src/Rel8/Column/ADT.hs−2 src/Rel8/Column/Either.hs−13 src/Rel8/Column/Field.hs−115 src/Rel8/Column/Lift.hs−2 src/Rel8/Column/List.hs−5 src/Rel8/Column/Maybe.hs−6 src/Rel8/Column/NonEmpty.hs−5 src/Rel8/Column/These.hs−13 src/Rel8/Expr.hs+1−1 src/Rel8/Expr/Opaleye.hs+2−2 src/Rel8/Expr/Sequence.hs+21 src/Rel8/Expr/Time.hs+2−2 src/Rel8/Generic/Construction.hs−58 src/Rel8/Generic/Construction/ADT.hs+11−11 src/Rel8/Generic/Rel8able/Test.hs+1−1 src/Rel8/Generic/Table.hs+4−4 src/Rel8/Generic/Table/ADT.hs+8−8 src/Rel8/Kind/Context.hs−8 src/Rel8/Kind/Necessity.hs−38 src/Rel8/Schema/Context/Label.hs+8−8 src/Rel8/Schema/Context/Nullify.hs+16−17 src/Rel8/Schema/HTable/Either.hs+1−2 src/Rel8/Schema/HTable/Identity.hs+2−3 src/Rel8/Schema/HTable/Label.hs+7−7 src/Rel8/Schema/HTable/Maybe.hs+1−2 src/Rel8/Schema/HTable/Nullify.hs+14−15 src/Rel8/Schema/HTable/These.hs+2−3 src/Rel8/Schema/HTable/Vectorize.hs+16−18 src/Rel8/Schema/Insert.hs−164 src/Rel8/Schema/Name.hs+1−1 src/Rel8/Schema/Result.hs+16−17 src/Rel8/Schema/Spec.hs+4−12 src/Rel8/Schema/Spec/ConstrainDBType.hs+14−14 src/Rel8/Schema/Spec/ConstrainType.hs−31 src/Rel8/Statement/Insert.hs+30−1 src/Rel8/Statement/Update.hs+2−6 src/Rel8/Table/ADT.hs−12 src/Rel8/Table/Either.hs+1−10 src/Rel8/Table/HKD.hs−12 src/Rel8/Table/Insert.hs−49 src/Rel8/Table/List.hs+1−7 src/Rel8/Table/Maybe.hs+1−9 src/Rel8/Table/NonEmpty.hs+1−8 src/Rel8/Table/Opaleye.hs+8−21 src/Rel8/Table/These.hs+2−10 src/Rel8/Table/Unreify.hs−4

rel8.cabal+1−5

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

4747 Rel8.Column

4848 Rel8.Column.ADT

4949 Rel8.Column.Either

50− Rel8.Column.Field

5150 Rel8.Column.Lift

5251 Rel8.Column.List

5352 Rel8.Column.Maybe

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

6463 Rel8.Expr.Opaleye

6564 Rel8.Expr.Ord

6665 Rel8.Expr.Order

66+ Rel8.Expr.Sequence

6767 Rel8.Expr.Serialize

6868

6969 Rel8.FCF

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

7171 Rel8.Kind.Algebra

7272 Rel8.Kind.Context

7373 Rel8.Kind.Labels

74− Rel8.Kind.Necessity

7574

7675 Rel8.Generic.Construction

7776 Rel8.Generic.Construction.ADT

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

121120 Rel8.Schema.HTable.Product

122121 Rel8.Schema.HTable.These

123122 Rel8.Schema.HTable.Vectorize

124− Rel8.Schema.Insert

125123 Rel8.Schema.Kind

126124 Rel8.Schema.Name

127125 Rel8.Schema.Null

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

129127 Rel8.Schema.Result

130128 Rel8.Schema.Spec

131129 Rel8.Schema.Spec.ConstrainDBType

132− Rel8.Schema.Spec.ConstrainType

133130 Rel8.Schema.Table

134131

135132 Rel8.Statement.Delete

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

147144 Rel8.Table.Either

148145 Rel8.Table.Eq

149146 Rel8.Table.HKD

150− Rel8.Table.Insert

151147 Rel8.Table.List

152148 Rel8.Table.Maybe

153149 Rel8.Table.Name

src/Rel8.hs+7−15

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

3232

3333 -- * Tables and higher-kinded tables

3434 , Rel8able, KRel8able

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

36− , Default

35+ , Column

3736 , HADT

3837 , HEither

3938 , HMaybe

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

5958 , catMaybeTable

6059 , bindMaybeTable

6160 , traverseMaybeTable

62− , insertMaybeTable

6361 , nameMaybeTable

6462

6563 -- ** @EitherTable@

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

7068 , keepRightTable

7169 , bindEitherTable

7270 , bitraverseEitherTable

73− , insertEitherTable

7471 , nameEitherTable

7572

7673 -- ** @TheseTable@

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

8784 , keepThoseTable, loseThoseTable

8885 , bindTheseTable

8986 , bitraverseTheseTable

90− , insertTheseTable

9187 , nameTheseTable

9288

9389 -- ** @ListTable@

9490 , ListTable

9591 , listTable

96− , insertListTable

9792 , nameListTable

9893 , many

9994 , manyExpr

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

10398 -- ** @NonEmptyTable@

10499 , NonEmptyTable

105100 , nonEmptyTable

106− , insertNonEmptyTable

107101 , nameNonEmptyTable

108102 , some

109103 , someExpr

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

115109 , BuildADT, buildADT

116110 , ConstructADT, constructADT

117111 , DeconstructADT, deconstructADT

118− , InsertADT, insertADT

119112 , NameADT, nameADT

120113 , AggregateADT, aggregateADT

121114

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

124117 , BuildHKD, buildHKD

125118 , ConstructHKD, constructHKD

126119 , DeconstructHKD, deconstructHKD

127− , InsertHKD, insertHKD

128120 , NameHKD, nameHKD

129121 , AggregateHKD, aggregateHKD

130122

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

139131 , Sql

140132 , litExpr

141133 , unsafeCastExpr

134+ , unsafeLiteral

142135

143136 -- ** @null@

144137 , null

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

251244 , Insert(..)

252245 , OnConflict(..)

253246 , insert

254− , toInsert

255− , toInsertDefaults

256247

257248 -- ** @DELETE@

258249 , Delete(..)

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

268259 -- ** @CREATE VIEW@

269260 , createView

270261

262+ -- ** Sequences

263+ , nextval

264+

271265 -- * TODO

272266 -- TODO

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

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

291285import Rel8.Column

292286import Rel8.Column.ADT

293287import Rel8.Column.Either

294−import Rel8.Column.Field

295288import Rel8.Column.Lift

296289import Rel8.Column.List

297290import Rel8.Column.Maybe

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

303296import Rel8.Expr.Eq

304297import Rel8.Expr.Function

305298import Rel8.Expr.Null

306−import Rel8.Expr.Opaleye (unsafeCastExpr)

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

307300import Rel8.Expr.Ord

308301import Rel8.Expr.Order

309302import Rel8.Expr.Serialize

303+import Rel8.Expr.Sequence

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

311−import Rel8.Kind.Necessity

312305import Rel8.Order

313306import Rel8.Query

314307import Rel8.Query.Aggregate

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

346339import Rel8.Table.Either

347340import Rel8.Table.Eq

348341import Rel8.Table.HKD

349−import Rel8.Table.Insert

350342import Rel8.Table.List

351343import Rel8.Table.Maybe

352344import Rel8.Table.Name

src/Rel8/Aggregate.hs+1−1

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

6262 data Col Aggregate _spec where

6363 A :: ()

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

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

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

6666

6767

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

src/Rel8/Column.hs+77−12

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

11{-# language DataKinds #-}

2−{-# language TypeFamilies #-}

2+{-# language FlexibleContexts #-}

3+{-# language LambdaCase #-}

4+{-# language MultiParamTypeClasses #-}

35{-# language StandaloneKindSignatures #-}

6+{-# language TypeFamilies #-}

58module Rel8.Column

6− ( Column, Default

9+ ( Column, AColumn(..)

710 , TColumn

811 )

912where

1013

1114-- base

1215import Data.Kind ( Type )

13−import Prelude ()

16+import Prelude

1417

1518-- rel8

16−import Rel8.Column.Field ( Field )

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

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

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

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

2036

2137

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.

2638type 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)

2885

2986

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

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

87+stoColumn :: ()

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)

3297

3398

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

src/Rel8/Column/ADT.hs−2

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

7171sfromColumnsADT = \case

7272 SAggregate -> AHADT . ADT . hunreify

7373 SExpr -> AHADT . ADT . hunreify

74− SInsert -> AHADT . ADT . hunreify

7574 SName -> AHADT . ADT . hunreify

7675 SResult -> AHADT . fromADT . ADT . hunreify

7776 SReify context -> AHADT . sfromColumnsADT context . hunreify

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

8483stoColumnsADT = \case

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

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

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

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

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

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

src/Rel8/Column/Either.hs−13

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

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

2424import Rel8.Schema.Context ( Col )

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

26−import Rel8.Schema.Insert ( Insert )

2726import qualified Rel8.Schema.Kind as K

2827import Rel8.Schema.Name ( Name(..) )

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

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

4140 HEither (Reify context) = AHEither context

4241 HEither Aggregate = EitherTable

4342 HEither Expr = EitherTable

44− HEither Insert = EitherTable

4543 HEither Name = EitherTable

4644 HEither Result = Either

4745

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

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

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

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

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

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

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

9996

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

118115 bimap (fromColumns . hreify) (fromColumns . hreify) .

119116 fromColumns .

120117 hunreify

121− SInsert ->

122− AHEither .

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

124− fromColumns .

125− hunreify

126118 SName ->

127119 AHEither .

128120 bimap (fromColumns . hreify) (fromColumns . hreify) .

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

155147 toColumns .

156148 bimap (hunreify . toColumns) (hunreify . toColumns) .

157149 (\(AHEither a) -> a)

158− SInsert ->

159− hreify .

160− toColumns .

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

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

163150 SName ->

164151 hreify .

165152 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

7070sfromColumnsLift = \case

7171 SAggregate -> ALift . fromColumns . hunreify

7272 SExpr -> ALift . fromColumns . hunreify

73− SInsert -> ALift . fromColumns . hunreify

7473 SName -> ALift . fromColumns . hunreify

7574 SResult -> ALift . fromHKD . HKD . hunreify

7675 SReify context -> ALift . sfromColumnsLift context . hunreify

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

8382stoColumnsLift = \case

8483 SAggregate -> hreify . toColumns . unALift

8584 SExpr -> hreify . toColumns . unALift

86− SInsert -> hreify . toColumns . unALift

8785 SName -> hreify . toColumns . unALift

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

8987 SReify context -> hreify . stoColumnsLift context . unALift

src/Rel8/Column/List.hs−5

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

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

2323import Rel8.Schema.Context ( Col )

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

25−import Rel8.Schema.Insert ( Insert )

2625import qualified Rel8.Schema.Kind as K

2726import Rel8.Schema.Name ( Name )

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

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

4140 HList (Reify context) = AHList context

4241 HList Aggregate = ListTable

4342 HList Expr = ListTable

44− HList Insert = ListTable

4543 HList Name = ListTable

4644 HList Result = []

4745

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

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

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

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

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

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

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

9289

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

9996 SAggregate -> AHList . ListTable

10097 SExpr -> AHList . ListTable

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

102− SInsert -> AHList . ListTable

10399 SName -> AHList . ListTable

104100 SReify context ->

105101 AHList .

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

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

118114 SResult ->

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

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

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

122117 SReify context ->

123118 hreify .

src/Rel8/Column/Maybe.hs−6

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

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

2323import Rel8.Schema.Context ( Col )

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

25−import Rel8.Schema.Insert ( Insert )

2625import qualified Rel8.Schema.Kind as K

2726import Rel8.Schema.Name ( Name )

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

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

4039 HMaybe (Reify context) = AHMaybe context

4140 HMaybe Aggregate = MaybeTable

4241 HMaybe Expr = MaybeTable

43− HMaybe Insert = MaybeTable

4442 HMaybe Name = MaybeTable

4543 HMaybe Result = Maybe

4644

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

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

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

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

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

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

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

9289

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

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

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

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

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

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

104100 SReify context ->

105101 AHMaybe .

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

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

120116 SResult ->

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

122− SInsert ->

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

124118 SName ->

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

126120 SReify context ->

src/Rel8/Column/NonEmpty.hs−5

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

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

2424import Rel8.Schema.Context ( Col )

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

26−import Rel8.Schema.Insert ( Insert )

2726import qualified Rel8.Schema.Kind as K

2827import Rel8.Schema.Name ( Name )

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

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

4241 HNonEmpty (Reify context) = AHNonEmpty context

4342 HNonEmpty Aggregate = NonEmptyTable

4443 HNonEmpty Expr = NonEmptyTable

45− HNonEmpty Insert = NonEmptyTable

4644 HNonEmpty Name = NonEmptyTable

4745 HNonEmpty Result = NonEmpty

4846

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

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

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

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

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

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

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

9390

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

10198 SExpr -> AHNonEmpty . NonEmptyTable

10299 SResult ->

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

104− SInsert -> AHNonEmpty . NonEmptyTable

105101 SName -> AHNonEmpty . NonEmptyTable

106102 SReify context ->

107103 AHNonEmpty .

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

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

120116 SResult ->

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

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

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

124119 SReify context ->

125120 hreify .

src/Rel8/Column/These.hs−13

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

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

2525import Rel8.Schema.Context ( Col )

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

27−import Rel8.Schema.Insert ( Insert )

2827import qualified Rel8.Schema.Kind as K

2928import Rel8.Schema.Name ( Name )

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

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

4544 HThese (Reify context) = AHThese context

4645 HThese Aggregate = TheseTable

4746 HThese Expr = TheseTable

48− HThese Insert = TheseTable

4947 HThese Name = TheseTable

5048 HThese Result = These

5149

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

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

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

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

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

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

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

103100

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

122119 bimap (fromColumns . hreify) (fromColumns . hreify) .

123120 fromColumns .

124121 hunreify

125− SInsert ->

126− AHThese .

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

128− fromColumns .

129− hunreify

130122 SName ->

131123 AHThese .

132124 bimap (fromColumns . hreify) (fromColumns . hreify) .

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

159151 toColumns .

160152 bimap (hunreify . toColumns) (hunreify . toColumns) .

161153 (\(AHThese a) -> a)

162− SInsert ->

163− hreify .

164− toColumns .

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

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

167154 SName ->

168155 hreify .

169156 toColumns .

src/Rel8/Expr.hs+1−1

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

128128

129129instance Interpretation Expr where

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

132132

133133

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

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

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

4848 fromPrimExpr . Opaleye.CastExpr typeName . toPrimExpr

4949

5050

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

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

51+unsafeLiteral :: String -> Expr a

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

5353

5454

5555fromPrimExpr :: 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

6+-- base

7+import Data.Int ( Int64 )

8+import Prelude

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

3131-- rel8

3232import Rel8.Expr ( Expr )

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

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

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

3535

3636-- time

3737import Data.Time.Calendar ( Day )

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

164164

165165

166166singleton :: 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 @@

1616module Rel8.Generic.Construction

1717 ( GGBuildable

1818 , GGBuild, ggbuild

19− , GGInsert, gginsert

2019 , GGConstructable

2120 , GGConstruct, ggconstruct

2221 , GGDeconstruct, ggdeconstruct

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

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

6463import Rel8.Schema.HTable ( HTable )

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

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

6765import qualified Rel8.Schema.Kind as K

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

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

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

8381 ( KnownAlgebra algebra

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

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

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

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

8986 , GGBuildable' algebra name rep

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

9491type family GGBuildable' algebra name rep where

9592 GGBuildable' 'K.Product name rep =

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

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

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

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

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

10296 )

10397 GGBuildable' 'K.Sum name rep =

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

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

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

108100 )

109101

110102

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

150142 (HType . Reify . E . litExpr)

151143

152144

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−

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

198146type GGConstructable algebra rep =

199147 ( KnownAlgebra algebra

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

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

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

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

205152 , GGConstructable' algebra rep

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

211158 GGConstructable' 'K.Product rep =

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

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

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

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

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

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

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

220165 )

221166 GGConstructable' 'K.Sum rep =

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

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

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

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

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

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

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

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

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

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

233175 )

234176

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

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

6464

6565

6666type Null :: K.HContext -> Type

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

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

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

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

68+ => SSpec ('Spec labels a)

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

7070

7171

7272type Nullifier :: K.HContext -> Type

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

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

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

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

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

74+ => SSpec ('Spec labels a)

75+ -> context ('Spec labels a)

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

7777

7878

7979type Unnullifier :: K.HContext -> Type

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

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

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

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

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

81+ => SSpec ('Spec labels a)

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

83+ -> context ('Spec labels a)

8484

8585

8686type NoConstructor :: Symbol -> Symbol -> ErrorMessage

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

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

3636

3737

3838data TablePair f = TablePair

39− { foo :: Default f Bool

39+ { foo :: Column f Bool

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

4141 }

4242 deriving stock Generic

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

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

148148 , Eval (GGTable algebra _Table _Columns context rep)

149149 )

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

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

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

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

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

151+ -> (forall a labels. ()

152+ => SSpec ('Spec labels a)

153+ -> context ('Spec labels a)

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

155155 -> Eval (GGColumns algebra _Columns rep) context

156156ggtable = case algebraSing @algebra of

157157 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

9696

9797 gtableADT :: ()

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

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

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

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

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

99+ -> (forall a labels. ()

100+ => SSpec ('Spec labels a)

101+ -> context ('Spec labels a)

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

103103 -> GColumnsADT _Columns rep context

104104

105105

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

136136class GTableADT' _Table _Columns htable context rep where

137137 gtableADT' :: ()

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

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

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

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

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

139+ -> (forall a labels. ()

140+ => SSpec ('Spec labels a)

141+ -> context ('Spec labels a)

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

143143 -> htable context

144144 -> GColumnsADT' _Columns htable rep context

145145

src/Rel8/Kind/Context.hs−8

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

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

2222import Rel8.Schema.Context ( Interpretation )

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

24−import Rel8.Schema.Insert ( Insert )

2524import Rel8.Schema.Kind ( Context )

2625import Rel8.Schema.Name ( Name )

2726import Rel8.Schema.Reify ( Reify )

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

3231data SContext context where

3332 SAggregate :: SContext Aggregate

3433 SExpr :: SContext Expr

35− SInsert :: SContext Insert

3634 SName :: SContext Name

3735 SResult :: SContext Result

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

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

5553 contextSing = SResult

5654

5755

58−instance Reifiable Insert where

59− contextSing = SInsert

60−

61−

6256instance Reifiable Name where

6357 contextSing = SName

6458

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

7165sReifiable = \case

7266 SAggregate -> Dict

7367 SExpr -> Dict

74− SInsert -> Dict

7568 SName -> Dict

7669 SResult -> Dict

7770 SReify context -> case sReifiable context of

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

8275sLabelable = \case

8376 SAggregate -> Dict

8477 SExpr -> Dict

85− SInsert -> Dict

8678 SName -> Dict

8779 SResult -> Dict

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

2626type Labelable :: Context -> Constraint

2727class Interpretation context => Labelable context where

2828 labeler :: ()

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

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

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

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

3131

3232 unlabeler :: ()

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

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

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

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

3535

3636

3737instance Labelable Result where

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

4242type HLabelable :: HContext -> Constraint

4343class HLabelable context where

4444 hlabeler :: ()

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

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

45+ => context ('Spec labels a)

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

4747

4848 hunlabeler :: ()

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

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

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

50+ -> context ('Spec labels a)

5151

5252

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

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

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

3333import Rel8.Expr.Bool ( boolExpr )

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

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

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

3736import Rel8.Schema.Context ( Interpretation )

3837import qualified Rel8.Schema.Kind as K

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

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

5655 , Taggable a

5756 )

5857 => Tag label a

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

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

6059

6160 decodeTag ::

6261 ( Sql (ConstrainTag context) a

6362 , KnownSymbol label

6463 , Taggable a

6564 )

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

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

6766 -> Tag label a

6867

6968 nullifier :: ()

7069 => Tag label a

7170 -> (Expr a -> Expr Bool)

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

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

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

71+ -> SSpec ('Spec labels x)

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

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

7574

7675 unnullifier :: ()

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

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

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

76+ => SSpec ('Spec labels x)

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

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

8079

8180

8281instance Nullifiable Aggregate where

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

148147

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

150149 => Tag label a

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

150+ -> context ('Spec labels a)

152151

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

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

153+ => context ('Spec labels a)

155154 -> Tag label a

156155

157156 hnullifier :: ()

158157 => Tag label a

159158 -> (Expr a -> Expr Bool)

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

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

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

159+ -> SSpec ('Spec labels x)

160+ -> context ('Spec labels x)

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

163162

164163 hunnullifier :: ()

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

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

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

164+ => SSpec ('Spec labels x)

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

166+ -> context ('Spec labels x)

168167

169168

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

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

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

1414import Prelude ()

1515

1616-- rel8

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

1817import Rel8.Schema.HTable ( HTable )

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

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

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

2625

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

2827data HEitherTable left right context = HEitherTable

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

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

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

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

3231 }

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

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

1515import Prelude

1616

1717-- rel8

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

1918import Rel8.Schema.Dict ( Dict( Dict ) )

2019import Rel8.Schema.HTable

2120 ( HTable, HConstrainTable, HField

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

2625

2726

2827type HType :: Type -> K.HTable

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

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

3029

3130

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

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

3332pattern HType a = HIdentity a

3433{-# COMPLETE HType #-}

3534

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

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

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

5050

5151

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

5353

5454

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

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

5858

5959

6060hlabel :: (HTable t, KnownSymbol label)

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

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

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

61+ => (forall labels a. ()

62+ => context ('Spec labels a)

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

6464 -> t context

6565 -> HLabel label t context

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

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

7070

7171

7272hunlabel :: (HTable t, KnownSymbol label)

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

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

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

73+ => (forall labels a. ()

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

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

7676 -> HLabel label t context

7777 -> t context

7878hunlabel unlabler (HLabel as) =

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

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

1414import Prelude

1515

1616-- rel8

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

1817import Rel8.Schema.HTable ( HTable )

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

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

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

2625

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

2827data HMaybeTable table context = HMaybeTable

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

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

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

3130 }

3231 deriving stock Generic

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

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

5050data Nullify :: Spec -> Exp Spec

5151

5252

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

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

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

54+ 'Spec labels (Type.Nullify a)

5555

5656

5757instance MapSpec Nullify where

5858 mapInfo = \case

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

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

6060 { labels

61− , necessity

6261 , info

6362 , nullity = case nullity of

6463 Null -> Null

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

6766

6867

6968hnulls :: HTable t

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

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

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

69+ => (forall labels a. ()

70+ => SSpec ('Spec labels a)

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

7372 -> HNullify t context

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

7574 spec@SSpec {} -> null spec

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

7776

7877

7978hnullify :: HTable t

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

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

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

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

79+ => (forall labels a. ()

80+ => SSpec ('Spec labels a)

81+ -> context ('Spec labels a)

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

8483 -> t context

8584 -> HNullify t context

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

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

9089

9190

9291hunnullify :: (HTable t, Apply m)

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

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

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

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

92+ => (forall labels a. ()

93+ => SSpec ('Spec labels a)

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

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

9796 -> HNullify t context

9897 -> m (t context)

9998hunnullify unnullifier (HNullify as) =

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

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

1414import Prelude

1515

1616-- rel8

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

1817import Rel8.Schema.HTable ( HTable )

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

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

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

2625

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

2827data HTheseTable here there context = HTheseTable

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

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

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

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

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

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

3332 }

3433 deriving stock Generic

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

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

3232import Prelude

3333

3434-- rel8

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

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

3736import Rel8.Schema.Dict ( Dict( Dict ) )

3837import qualified Rel8.Schema.Kind as K

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

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

8079

8180

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)

8382

8483

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

8685 mapInfo = \case

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

8887 Dict -> SSpec

89− { necessity = SRequired

90− , nullity = NotNull

88+ { nullity = NotNull

9189 , info = vectorTypeInformation nullity info

9290 , ..

9391 }

9492

9593

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

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

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

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

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

95+ => (forall labels a. ()

96+ => SSpec ('Spec labels a)

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

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

10199 -> f (t context)

102100 -> HVectorize list t context'

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

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

107105

108106

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

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

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

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

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

108+ => (forall labels a. ()

109+ => SSpec ('Spec labels a)

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

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

114112 -> HVectorize list t context

115113 -> f (t context')

116114hunvectorize unvectorizer (HVectorize table) =

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

121119

122120

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

124− ( forall labels necessity a. ()

122+ ( forall labels a. ()

125123 => Nullity a

126124 -> TypeInformation (Unnullify a)

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

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

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

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

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

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

130128 )

131129 -> HVectorize list t context

132130 -> HVectorize list t context

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

138136

139137

140138hempty :: HTable t =>

141− ( forall labels necessity a. ()

139+ ( forall labels a. ()

142140 => Nullity a

143141 -> TypeInformation (Unnullify a)

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

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

145143 )

146144 -> HVectorize [] t context

147145hempty 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)

8484

8585instance Interpretation Name where

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

8888

8989

9090instance Labelable Name where

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

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

1616import Prelude hiding ( null )

1717

1818-- rel8

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

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

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

2221import Rel8.Schema.Kind ( Context )

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

3029

3130instance Interpretation Result where

3231 data Col Result _spec where

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

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

3433

3534

3635relabel :: ()

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

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

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

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

3938relabel (HIdentity (R a)) = HIdentity (R a)

4039

4140

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

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

4342null = R Nothing

4443

4544

4645nullifier :: ()

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

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

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

46+ => SSpec ('Spec labels a)

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

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

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

5150 Null -> a

5251 NotNull -> Just a

5352

5453

5554unnullifier :: ()

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

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

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

55+ => SSpec ('Spec labels a)

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

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

5958unnullifier SSpec {nullity} (R a) =

6059 case nullity of

6160 Null -> pure $ R a

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

6362

6463

6564vectorizer :: Functor f

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

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

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

65+ => SSpec ('Spec labels a)

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

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

6968vectorizer _ = R . fmap unR

7069

7170

7271unvectorizer :: Functor f

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

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

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

72+ => SSpec ('Spec labels a)

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

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

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

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

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

77module Rel8.Schema.Spec

88 ( Spec( Spec )

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

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

1010 , KnownSpec( specSing )

1111 )

1212where

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

1717

1818-- rel8

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

20−import Rel8.Kind.Necessity

21− ( Necessity

22− , SNecessity

23− , KnownNecessity, necessitySing

24− )

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

2621import Rel8.Type ( DBType, typeInformation )

2722import Rel8.Type.Information ( TypeInformation )

2823

2924

3025type Spec :: Type

31−data Spec = Spec Labels Necessity Type

26+data Spec = Spec Labels Type

3227

3328

3429type SSpec :: Spec -> Type

3530data SSpec spec where

3631 SSpec ::

3732 { labels :: SLabels labels

38− , necessity :: SNecessity necessity

3933 , info :: TypeInformation (Unnullify a)

4034 , nullity :: Nullity a

4135 }

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

36+ -> SSpec ('Spec labels a)

4337

4438

4539type KnownSpec :: Spec -> Constraint

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

4943

5044instance

5145 ( KnownLabels labels

52− , KnownNecessity necessity

5346 , Sql DBType a

5447 )

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

48+ => KnownSpec ('Spec labels a)

5649 where

5750 specSing = SSpec

5851 { labels = labelsSing

59− , necessity = necessitySing

6052 , info = typeInformation

6153 , nullity = nullable

6254 }

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

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

3131

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

3333class

34− ( forall c labels necessity a. ()

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

34+ ( forall c labels a. ()

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

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

3737 )

3838 => ConstrainDBType constraint spec

3939instance

40− ( spec ~ 'Spec labels necessity a

40+ ( spec ~ 'Spec labels a

4141 , Sql constraint a

4242 )

4343 => ConstrainDBType constraint spec

4444

4545

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

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

4747dbTypeNullity = step2 . step1

4848 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

5050 step1 Dict = Dict

5151

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

5353 step2 Dict = nullable

5454

5555

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)

5757dbTypeDict = step2 . step1

5858 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

6060 step1 Dict = Dict

6161

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

6363 step2 Dict = Dict

6464

6565

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)

6767fromNullityDict Null Dict = Dict

6868fromNullityDict NotNull Dict = Dict

6969

7070

7171nullifier :: ()

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

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

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

72+ => SSpec ('Spec labels a)

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

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

7575nullifier SSpec {} dict = case dbTypeDict dict of

7676 Dict -> case dbTypeNullity dict of

7777 Null -> Dict

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

7979

8080

8181unnullifier :: ()

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

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

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

82+ => SSpec ('Spec labels a)

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

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

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

8686 Dict -> case nullity of

8787 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 #-}

12{-# language GADTs #-}

23{-# language NamedFieldPuns #-}

34{-# language ScopedTypeVariables #-}

5+{-# language StandaloneKindSignatures #-}

46{-# language TypeApplications #-}

68module Rel8.Statement.Insert

@@ -13,6 +15,7 @@ where

1315-- base

1416import Control.Exception ( throwIO )

1517import Data.List.NonEmpty ( NonEmpty( (:|) ) )

18+import Data.Kind ( Type )

1619import Prelude

1720

1821-- hasql

@@ -27,7 +30,8 @@ import qualified Opaleye.Internal.Manipulation as Opaleye

2730import qualified Opaleye.Manipulation as Opaleye

2831

2932-- rel8

30−import Rel8.Schema.Insert ( Insert(..), OnConflict(..) )

33+import Rel8.Schema.Name ( Selects )

34+import Rel8.Schema.Table ( TableSchema )

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

3236import Rel8.Table ( fromColumns, toColumns )

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

@@ -38,6 +42,31 @@ import qualified Data.Text as Text ( pack )

3842import Data.Text.Encoding ( encodeUtf8 )

3943

4044

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+

4170-- | Run an @INSERT@ statement

4271insert :: Connection -> Insert a -> IO a

4372insert c Insert {into, rows, onConflict, returning} =

src/Rel8/Statement/Update.hs+2−6

@@ -25,9 +25,6 @@ import qualified Hasql.Statement as Hasql

2525-- opaleye

2626import qualified Opaleye.Internal.Manipulation as Opaleye

2727

28−-- profunctors

29−import Data.Profunctor ( lmap )

30−

3128-- rel8

3229import Rel8.Expr ( Expr )

3330import Rel8.Expr.Opaleye ( toColumn, toPrimExpr )

@@ -35,7 +32,6 @@ import Rel8.Schema.Name ( Selects )

3532import Rel8.Schema.Table ( TableSchema )

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

3734import Rel8.Table ( fromColumns, toColumns )

38−import Rel8.Table.Insert ( toInsert )

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

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

4137

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

7470 prepare = False

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

7672 where

77− target' = lmap toInsert $ table $ toColumns <$> target

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

7874 set' = toColumns . set . fromColumns

7975 where' = toColumn . toPrimExpr . updateWhere . fromColumns

8076

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

9490 where'

9591 project'

9692 where

97− target' = lmap toInsert $ table $ toColumns <$> target

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

9894 set' = toColumns . set . fromColumns

9995 where' = toColumn . toPrimExpr . updateWhere . fromColumns

10096 project' = castTable . toColumns . project . fromColumns

src/Rel8/Table/ADT.hs−12

@@ -16,7 +16,6 @@ module Rel8.Table.ADT

1616 , ADTable, fromADT, toADT

1717 , BuildableADT

1818 , BuildADT, buildADT

19− , InsertADT, insertADT

2019 , ConstructableADT

2120 , ConstructADT, constructADT

2221 , DeconstructADT, deconstructADT

@@ -41,7 +40,6 @@ import Rel8.FCF ( Eval, Exp )

4140import Rel8.Generic.Construction

4241 ( GGBuildable

4342 , GGBuild, ggbuild

44− , GGInsert, gginsert

4543 , GGConstructable

4644 , GGConstruct, ggconstruct

4745 , GGDeconstruct, ggdeconstruct

@@ -59,7 +57,6 @@ import qualified Rel8.Generic.Table.ADT as G

5957import qualified Rel8.Kind.Algebra as K

6058import Rel8.Schema.Context ( Col )

6159import Rel8.Schema.HTable ( HTable )

62−import Rel8.Schema.Insert ( Insert )

6360import qualified Rel8.Schema.Kind as K

6461import Rel8.Schema.Name ( Name )

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

@@ -156,15 +153,6 @@ buildADT =

156153 ggbuild @'K.Sum @name @(ADTRep t) @(ADT t Expr) ADT

157154

158155

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−

168156type ConstructableADT :: K.Rel8able -> Constraint

169157class GGConstructable 'K.Sum (ADTRep t) => ConstructableADT t

170158instance GGConstructable 'K.Sum (ADTRep t) => ConstructableADT t

src/Rel8/Table/Either.hs+1−10

@@ -18,7 +18,7 @@ module Rel8.Table.Either

1818 ( EitherTable(..)

1919 , eitherTable, leftTable, rightTable

2020 , isLeftTable, isRightTable

21− , insertEitherTable, nameEitherTable

21+ , nameEitherTable

2222 )

2323where

2424

@@ -47,7 +47,6 @@ import Rel8.Schema.HTable.Either ( HEitherTable(..) )

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

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

4949import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

50−import Rel8.Schema.Insert ( Insert )

5150import Rel8.Schema.Name ( Name )

5251import Rel8.Table

5352 ( Table, Columns, Context, fromColumns, toColumns

@@ -55,7 +54,6 @@ import Rel8.Table

5554 )

5655import Rel8.Table.Bool ( bool )

5756import Rel8.Table.Eq ( EqTable, eqTable )

58−import Rel8.Table.Insert ( toInsert )

5957import Rel8.Table.Ord ( OrdTable, ordTable )

6058import Rel8.Table.Recontextualize ( Recontextualize )

6159import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -177,13 +175,6 @@ rightTableWith :: a -> b -> EitherTable a b

177175rightTableWith = EitherTable (fromExpr (litExpr IsRight))

178176

179177

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−

187178nameEitherTable :: Name EitherTag -> a -> b -> EitherTable a b

188179nameEitherTable = EitherTable . fromName

189180

src/Rel8/Table/HKD.hs−12

@@ -16,7 +16,6 @@ module Rel8.Table.HKD

1616 , HKDable, fromHKD, toHKD, HKDT(..)

1717 , BuildableHKD

1818 , BuildHKD, buildHKD

19− , InsertHKD, insertHKD

2019 , ConstructableHKD

2120 , ConstructHKD, constructHKD

2221 , DeconstructHKD, deconstructHKD

@@ -44,7 +43,6 @@ import Rel8.Kind.Algebra ( KnownAlgebra )

4443import Rel8.Generic.Construction

4544 ( GGBuildable

4645 , GGBuild, ggbuild

47− , GGInsert, gginsert

4846 , GGConstructable

4947 , GGConstruct, ggconstruct

5048 , GGDeconstruct, ggdeconstruct

@@ -66,7 +64,6 @@ import Rel8.Generic.Table

6664import Rel8.Schema.Context ( Col )

6765import qualified Rel8.Schema.Kind as K

6866import Rel8.Schema.HTable ( HTable )

69−import Rel8.Schema.Insert ( Insert )

7067import Rel8.Schema.Name ( Name )

7168import Rel8.Schema.Reify ( Col( Reify ), Reify, hreify, hunreify, notReify )

7269import Rel8.Schema.Result ( Result )

@@ -223,15 +220,6 @@ buildHKD =

223220 ggbuild @(GAlgebra (Rep a)) @name @(HKDRep a) @(HKD a Expr) HKD

224221

225222

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−

235223type ConstructableHKD :: Type -> Constraint

236224class GGConstructable (GAlgebra (Rep a)) (HKDRep a) => ConstructableHKD a

237225instance 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 @@

1010

1111module Rel8.Table.List

1212 ( ListTable(..)

13− , listTable, insertListTable, nameListTable

13+ , listTable, nameListTable

1414 )

1515where

1616

@@ -26,7 +26,6 @@ import Rel8.Expr.Array ( sappend, sempty, slistOf )

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

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

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

29−import Rel8.Schema.Insert ( Inserts )

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

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

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

@@ -41,7 +40,6 @@ import Rel8.Table.Alternative

4140 , AlternativeTable, emptyTable

4241 )

4342import Rel8.Table.Eq ( EqTable, eqTable )

44−import Rel8.Table.Insert ( toInsert )

4543import Rel8.Table.Ord ( OrdTable, ordTable )

4644import Rel8.Table.Recontextualize ( Recontextualize )

4745import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -126,10 +124,6 @@ listTable =

126124 fmap toColumns

127125

128126

129−insertListTable :: Inserts exprs inserts => [exprs] -> ListTable inserts

130−insertListTable = toInsert . listTable

131−

132−

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

134128nameListTable =

135129 ListTable .

src/Rel8/Table/Maybe.hs+1−9

@@ -17,7 +17,7 @@ module Rel8.Table.Maybe

1717 , maybeTable, nothingTable, justTable

1818 , isNothingTable, isJustTable

1919 , ($?)

20− , insertMaybeTable, nameMaybeTable

20+ , nameMaybeTable

2121 )

2222where

2323

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

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

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

4646import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

47−import Rel8.Schema.Insert ( Insert )

4847import Rel8.Schema.Name ( Name )

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

5049import Rel8.Table

@@ -57,7 +56,6 @@ import Rel8.Table.Alternative

5756 )

5857import Rel8.Table.Bool ( bool )

5958import Rel8.Table.Eq ( EqTable, eqTable )

60−import Rel8.Table.Insert ( toInsert )

6159import Rel8.Table.Ord ( OrdTable, ordTable )

6260import Rel8.Table.Recontextualize ( Recontextualize )

6361import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -209,12 +207,6 @@ f $? ma@(MaybeTable _ a) = case nullable @b of

209207infixl 4 $?

210208

211209

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−

218210nameMaybeTable :: Name (Maybe MaybeTag) -> a -> MaybeTable a

219211nameMaybeTable = MaybeTable . fromName

220212

src/Rel8/Table/NonEmpty.hs+1−8

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

1010

1111module Rel8.Table.NonEmpty

1212 ( NonEmptyTable(..)

13− , nonEmptyTable, insertNonEmptyTable, nameNonEmptyTable

13+ , nonEmptyTable, nameNonEmptyTable

1414 )

1515where

1616

@@ -27,7 +27,6 @@ import Rel8.Expr.Array ( sappend1, snonEmptyOf )

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

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

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

30−import Rel8.Schema.Insert ( Inserts )

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

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

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

@@ -39,7 +38,6 @@ import Rel8.Table

3938 )

4039import Rel8.Table.Alternative ( AltTable, (<|>:) )

4140import Rel8.Table.Eq ( EqTable, eqTable )

42−import Rel8.Table.Insert ( toInsert )

4341import Rel8.Table.Ord ( OrdTable, ordTable )

4442import Rel8.Table.Recontextualize ( Recontextualize )

4543import Rel8.Table.Serialize ( FromExprs, ToExprs, fromResult, toResult )

@@ -118,11 +116,6 @@ nonEmptyTable =

118116 fmap toColumns

119117

120118

121−insertNonEmptyTable :: Inserts exprs inserts

122− => NonEmpty exprs -> NonEmptyTable inserts

123−insertNonEmptyTable = toInsert . nonEmptyTable

124−

125−

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

127120nameNonEmptyTable =

128121 NonEmptyTable .

src/Rel8/Table/Opaleye.hs+8−21

@@ -43,9 +43,7 @@ import Rel8.Expr.Opaleye

4343 , fromColumn, toColumn

4444 , scastExpr

4545 )

46−import Rel8.Kind.Necessity ( SNecessity( SRequired, SOptional ) )

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

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

4947import Rel8.Schema.Name ( Col( N ), Name( Name ), Selects )

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

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

@@ -83,36 +81,25 @@ distinctspec =

8381 toColumns

8482

8583

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

8885table (TableSchema name schema columns) =

8986 case schema of

9087 Nothing -> Opaleye.Table name (tableFields columns)

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

9289

9390

94−tableFields :: (Selects names exprs, Inserts exprs inserts)

95− => names -> Opaleye.TableFields inserts exprs

91+tableFields ::Selects names exprs

92+ => names -> Opaleye.TableFields exprs exprs

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

9794 unwrapApplicative $ htabulateA $ \field -> WrapApplicative $

98− case hfield hspecs field of

99− specs -> case hfield names field of

100− name -> lmap (`hfield` field) (go specs name)

95+ case hfield names field of

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

10197 where

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

103− go SSpec {necessity} (N (Name name)) = case necessity of

104− SRequired ->

105− lmap (\(I (Value a)) -> toColumn $ toPrimExpr a) $

98+ go :: Col Name spec -> Opaleye.TableFields (Col Expr spec) (Col Expr spec)

99+ go (N (Name name)) =

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

106101 E . fromPrimExpr . fromColumn <$>

107102 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

116103

117104

118105unpackspec :: Table Expr a => Opaleye.Unpackspec a a

src/Rel8/Table/These.hs+2−10

@@ -21,7 +21,7 @@ module Rel8.Table.These

2121 , isThisTable, isThatTable, isThoseTable

2222 , hasHereTable, hasThereTable

2323 , justHereTable, justThereTable

24− , insertTheseTable, nameTheseTable

24+ , nameTheseTable

2525 )

2626where

2727

@@ -51,7 +51,6 @@ import Rel8.Schema.HTable.Label ( hlabel, hunlabel )

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

5252import Rel8.Schema.HTable.Nullify ( hnullify, hunnullify )

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

54−import Rel8.Schema.Insert ( Insert )

5554import Rel8.Schema.Name ( Name )

5655import Rel8.Table

5756 ( Table, Columns, Context, fromColumns, toColumns

@@ -62,7 +61,7 @@ import Rel8.Table.Maybe

6261 ( MaybeTable(..)

6362 , maybeTable, justTable, nothingTable

6463 , isJustTable

65− , insertMaybeTable, nameMaybeTable

64+ , nameMaybeTable

6665 )

6766import Rel8.Table.Ord ( OrdTable, ordTable )

6867import Rel8.Table.Recontextualize ( Recontextualize )

@@ -77,7 +76,6 @@ import Data.Functor.Bind ( Bind, (>>-) )

7776

7877-- these

7978import Data.These ( These )

80−import Data.These.Combinators ( justHere, justThere )

8179

8280

8381type TheseTable :: Type -> Type -> Type

@@ -231,12 +229,6 @@ theseTable f g h TheseTable {here, there} =

231229 there

232230

233231

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−

240232nameTheseTable :: ()

241233 => Name (Maybe MaybeTag)

242234 -> Name (Maybe MaybeTag)

src/Rel8/Table/Unreify.hs−4

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

4141import Rel8.Expr ( Expr )

4242import Rel8.Kind.Context ( SContext(..), Reifiable, sReifiable )

4343import Rel8.Schema.Dict ( Dict( Dict ) )

44−import Rel8.Schema.Insert ( Insert )

4544import qualified Rel8.Schema.Kind as K

4645import Rel8.Schema.Name ( Name )

4746import Rel8.Schema.Reify ( Reify )

@@ -59,7 +58,6 @@ type Unreifiable :: Type -> Constraint

5958class

6059 ( Context a ~ Reify Aggregate => Unreifier Aggregate a

6160 , Context a ~ Reify Expr => Unreifier Expr a

62− , Context a ~ Reify Insert => Unreifier Insert a

6361 , Context a ~ Reify Name => Unreifier Name a

6462 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

6563 )

@@ -67,7 +65,6 @@ class

6765instance

6866 ( Context a ~ Reify Aggregate => Unreifier Aggregate a

6967 , Context a ~ Reify Expr => Unreifier Expr a

70− , Context a ~ Reify Insert => Unreifier Insert a

7168 , Context a ~ Reify Name => Unreifier Name a

7269 , (forall ctx. (Context a ~ Reify (Reify ctx), Reifiable ctx) => Unreifier (Reify ctx) a)

7370 )

@@ -99,7 +96,6 @@ unreifiability :: (Context a ~ Reify context, Unreifiable a)

9996unreifiability = \case

10097 SAggregate -> Unreifiability SAggregate

10198 SExpr -> Unreifiability SExpr

102− SInsert -> Unreifiability SInsert

10399 SName -> Unreifiability SName

104100 SResult -> UResult

105101 SReify context -> case sReifiable context of