bbfa1a3 · rel8 · git.iko.soy

rel8.cabal+2

compare with master

unifiedsplit

@@ -112,7 +112,9 @@ library

112 Rel8.Schema.HTable.Trio

113 Rel8.Schema.HTable.Type

114 Rel8.Schema.HTable.Vectorize

115+ Rel8.Schema.Insert

115 Rel8.Schema.Kind

116 Rel8.Schema.Kind

117+ Rel8.Schema.Name

116 Rel8.Schema.Nullability

118 Rel8.Schema.Nullability

117 Rel8.Schema.Spec

119 Rel8.Schema.Spec

118 Rel8.Schema.Spec.ConstrainDBType

120 Rel8.Schema.Spec.ConstrainDBType

src/Rel8.hs+1−3

@@ -213,7 +213,6 @@ module Rel8

213 , Insert(..)

214 , OnConflict(..)

215 , insert

216− , Insertion

217 , toInsert

216 , toInsert

218 , toInsertDefaults

217 , toInsertDefaults

219

218

@@ -271,10 +270,10 @@ import Rel8.Query.Set

271import Rel8.Query.These

270import Rel8.Query.These

272import Rel8.Query.Values

271import Rel8.Query.Values

273import Rel8.Schema.Column

272import Rel8.Schema.Column

274−import Rel8.Schema.Context (Name, Insertion)

275import Rel8.Schema.Context.Label

273import Rel8.Schema.Context.Label

276import Rel8.Schema.Generic

274import Rel8.Schema.Generic

277import Rel8.Schema.HTable

275import Rel8.Schema.HTable

276+import Rel8.Schema.Name

278import Rel8.Schema.Nullability

277import Rel8.Schema.Nullability

279import Rel8.Schema.Table

278import Rel8.Schema.Table

280import Rel8.Statement.Delete

279import Rel8.Statement.Delete

@@ -295,7 +294,6 @@ import Rel8.Table.Name

295import Rel8.Table.NonEmpty

294import Rel8.Table.NonEmpty

296import Rel8.Table.Ord

295import Rel8.Table.Ord

297import Rel8.Table.Order

296import Rel8.Table.Order

298−import Rel8.Table.Recontextualize

299import Rel8.Table.Serialize

297import Rel8.Table.Serialize

300import Rel8.Table.These

298import Rel8.Table.These

301import Rel8.Type

299import Rel8.Type

src/Rel8/Aggregate.hs+117−2

@@ -1,17 +1,31 @@

1+{-# language DataKinds #-}

1{-# language DerivingVia #-}

2{-# language DerivingVia #-}

3+{-# language FlexibleContexts #-}

4+{-# language FlexibleInstances #-}

5+{-# language GADTs #-}

2{-# language GeneralizedNewtypeDeriving #-}

6{-# language GeneralizedNewtypeDeriving #-}

7+{-# language MultiParamTypeClasses #-}

3{-# language NamedFieldPuns #-}

8{-# language NamedFieldPuns #-}

4{-# language StandaloneKindSignatures #-}

9{-# language StandaloneKindSignatures #-}

10+{-# language TypeFamilies #-}

11+{-# language UndecidableInstances #-}

12+{-# language UndecidableSuperClasses #-}

5

13

6module Rel8.Aggregate

14module Rel8.Aggregate

7− ( Aggregate(..), foldInputs, mapInputs

15+ ( Aggregate(..)

8 , Aggregator(..), unsafeMakeAggregate

16 , Aggregator(..), unsafeMakeAggregate

17+ , Aggregates

18+ , Col( Aggregation )

9 )

19 )

10where

20where

11

21

12-- base

22-- base

23+import Control.Applicative ( empty )

24+import Data.Foldable ( fold )

13import Data.Functor.Const ( Const( Const ), getConst )

25import Data.Functor.Const ( Const( Const ), getConst )

14−import Data.Kind ( Type )

26+import Data.Functor.Identity ( Identity )

27+import Data.Kind ( Constraint, Type )

28+import Data.Monoid ( First( First ), getFirst )

15import Prelude

29import Prelude

16

30

17-- opaleye

31-- opaleye

@@ -19,6 +33,24 @@ import qualified Opaleye.Internal.Aggregate as Opaleye

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

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

20import qualified Opaleye.Internal.PackMap as Opaleye

34import qualified Opaleye.Internal.PackMap as Opaleye

21

35

36+-- rel8

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

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

39+import Rel8.Opaque ( Opaque, Opaque1 )

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

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

42+import Rel8.Schema.Context.Nullify

43+ ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier

44+ , runTag, unnull

45+ )

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

47+import Rel8.Schema.Name ( Name )

48+import Rel8.Schema.Nullability ( Sql )

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

50+import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

51+import Rel8.Table.Recontextualize ( Recontextualize )

52+import Rel8.Type ( DBType )

53+

22-- semigroupoids

54-- semigroupoids

23import Data.Functor.Apply ( Apply, WrappedApplicative(..) )

55import Data.Functor.Apply ( Apply, WrappedApplicative(..) )

24

56

@@ -34,6 +66,89 @@ newtype Aggregate a = Aggregate (Opaleye.Aggregator () a)

34 deriving Apply via (WrappedApplicative (Opaleye.Aggregator ()))

66 deriving Apply via (WrappedApplicative (Opaleye.Aggregator ()))

35

67

36

68

69+instance Interpretation Aggregate where

70+ data Col Aggregate _spec where

71+ Aggregation :: ()

72+ => Aggregate (Expr a)

73+ -> Col Aggregate ('Spec labels necessity db a)

74+

75+

76+instance Table Expr a => Table Aggregate (Aggregate a) where

77+ type Columns (Aggregate a) = Columns a

78+ type Context (Aggregate a) = Aggregate

79+

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

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

82+ fromColumns as = fmap fromColumns $ htabulateA $ \field ->

83+ case hfield as field of

84+ Aggregation a -> DB <$> a

85+

86+

87+instance Sql DBType a =>

88+ Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))

89+

90+

91+instance Sql DBType a =>

92+ Recontextualize Aggregate Expr (Aggregate (Expr a)) (Expr a)

93+

94+

95+instance Sql DBType a =>

96+ Recontextualize Aggregate Identity (Aggregate (Expr a)) (Identity a)

97+

98+

99+instance Sql DBType a =>

100+ Recontextualize Aggregate Name (Aggregate (Expr a)) (Name a)

101+

102+

103+instance Sql DBType a =>

104+ Recontextualize Expr Aggregate (Expr a) (Aggregate (Expr a))

105+

106+

107+instance Sql DBType a =>

108+ Recontextualize Identity Aggregate (Identity a) (Aggregate (Expr a))

109+

110+

111+instance Sql DBType a =>

112+ Recontextualize Name Aggregate (Name a) (Aggregate (Expr a))

113+

114+

115+instance Labelable Aggregate where

116+ labeler (Aggregation aggregate) = Aggregation aggregate

117+ unlabeler (Aggregation aggregate) = Aggregation aggregate

118+

119+

120+instance Nullifiable Aggregate where

121+ encodeTag = Aggregation . groupByExpr

122+ where

123+ groupByExpr = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

124+ decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate

125+ where

126+ undoGroupBy = getFirst . foldInputs go

127+ where

128+ go Nothing = pure . fromPrimExpr

129+ go _ = const $ First empty

130+

131+ nullifier tag SSpec {nullability} (Aggregation aggregate) = Aggregation $

132+ mapInputs (toPrimExpr . runTag nullability tag . fromPrimExpr) $

133+ runTag nullability tag <$> aggregate

134+

135+ unnullifier _ SSpec {nullability} (Aggregation aggregate) =

136+ Aggregation $ unnull nullability <$> aggregate

137+

138+ {-# INLINABLE encodeTag #-}

139+ {-# INLINABLE decodeTag #-}

140+ {-# INLINABLE nullifier #-}

141+ {-# INLINABLE unnullifier #-}

142+

143+

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

145+-- for the columns in @b@.

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

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

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

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

150+

151+

37foldInputs :: Monoid b

152foldInputs :: Monoid b

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

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

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

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

src/Rel8/Expr.hs+67−1

@@ -1,20 +1,28 @@

1{-# language DataKinds #-}

2{-# language DerivingStrategies #-}

3{-# language FlexibleContexts #-}

4+{-# language FlexibleInstances #-}

4{-# language GADTs #-}

5{-# language GADTs #-}

6+{-# language MultiParamTypeClasses #-}

7+{-# language NamedFieldPuns #-}

5{-# language RoleAnnotations #-}

8{-# language RoleAnnotations #-}

6{-# language ScopedTypeVariables #-}

9{-# language ScopedTypeVariables #-}

7{-# language StandaloneKindSignatures #-}

10{-# language StandaloneKindSignatures #-}

8{-# language TypeApplications #-}

11{-# language TypeApplications #-}

12+{-# language TypeFamilies #-}

9{-# language UndecidableInstances #-}

13{-# language UndecidableInstances #-}

14+{-# language UndecidableSuperClasses #-}

10

15

11module Rel8.Expr

16module Rel8.Expr

12 ( Expr(..)

17 ( Expr(..)

18+ , Col( DB, unDB )

19+ , Encodes

13 )

20 )

14where

21where

15

22

16-- base

23-- base

17−import Data.Kind ( Type )

24+import Data.Functor.Identity ( Identity )

25+import Data.Kind ( Constraint, Type )

18import Data.String ( IsString, fromString )

26import Data.String ( IsString, fromString )

19import Prelude hiding ( null )

27import Prelude hiding ( null )

20

28

@@ -30,10 +38,21 @@ import Rel8.Expr.Opaleye

30 , zipPrimExprsWith

38 , zipPrimExprsWith

31 )

39 )

32import Rel8.Expr.Serialize ( litExpr )

40import Rel8.Expr.Serialize ( litExpr )

41+import Rel8.Opaque ( Opaque, Opaque1 )

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

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

44+import Rel8.Schema.Context.Nullify

45+ ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier

46+ , runTag, unnull

47+ )

48+import Rel8.Schema.HTable.Type ( HType( HType ) )

33import Rel8.Schema.Nullability

49import Rel8.Schema.Nullability

34 ( Nullability( Nullable, NonNullable )

50 ( Nullability( Nullable, NonNullable )

35 , Sql, nullabilization

51 , Sql, nullabilization

36 )

52 )

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

54+import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

55+import Rel8.Table.Recontextualize ( Recontextualize )

37import Rel8.Type ( DBType )

56import Rel8.Type ( DBType )

38import Rel8.Type.Monoid ( DBMonoid, memptyExpr )

57import Rel8.Type.Monoid ( DBMonoid, memptyExpr )

39import Rel8.Type.Num ( DBFractional, DBNum )

58import Rel8.Type.Num ( DBFractional, DBNum )

@@ -85,3 +104,50 @@ instance Sql DBFractional a => Fractional (Expr a) where

85

104

86 fromRational =

105 fromRational =

87 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac

106 castExpr . Expr . Opaleye.ConstExpr . Opaleye.NumericLit . realToFrac

107+

108+

109+instance Interpretation Expr where

110+ data Col Expr _spec where

111+ DB :: ()

112+ => { unDB :: Expr a }

113+ -> Col Expr ('Spec labels necessity db a)

114+

115+

116+instance Sql DBType a => Table Expr (Expr a) where

117+ type Columns (Expr a) = HType a

118+ type Context (Expr a) = Expr

119+

120+ toColumns a = HType (DB a)

121+ fromColumns (HType (DB a)) = a

122+

123+

124+instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)

125+

126+

127+instance Sql DBType a => Recontextualize Expr Identity (Expr a) (Identity a)

128+

129+

130+instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)

131+

132+

133+instance Labelable Expr where

134+ labeler (DB a) = DB a

135+ unlabeler (DB a) = DB a

136+

137+

138+instance Nullifiable Expr where

139+ encodeTag = DB

140+ decodeTag (DB a) = a

141+ nullifier tag SSpec {nullability} (DB a) = DB $ runTag nullability tag a

142+ unnullifier _ SSpec {nullability} (DB a) = DB $ unnull nullability a

143+

144+ {-# INLINABLE encodeTag #-}

145+ {-# INLINABLE decodeTag #-}

146+ {-# INLINABLE nullifier #-}

147+ {-# INLINABLE unnullifier #-}

148+

149+

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

151+class Recontextualize Identity Expr a exprs => Encodes a exprs

152+instance Recontextualize Identity Expr a exprs => Encodes a exprs

153+instance {-# OVERLAPPING #-} Encodes (Opaque1 Identity Opaque) (Opaque1 Expr Opaque)

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

@@ -14,10 +14,10 @@ import qualified Opaleye.Table as Opaleye

14-- rel8

15import Rel8.Query ( Query )

16import Rel8.Query.Opaleye ( fromOpaleye )

17+import Rel8.Schema.Name ( Selects )

17import Rel8.Schema.Table ( TableSchema )

18import Rel8.Schema.Table ( TableSchema )

18import Rel8.Table ( fromColumns, toColumns )

19import Rel8.Table ( fromColumns, toColumns )

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

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

20−import Rel8.Table.Recontextualize ( Selects )

21

22

23-- | Select each row from a table definition. This is equivalent to @FROM

src/Rel8/Query/SQL.hs+2−3

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

23import qualified Opaleye.Internal.Sql as Opaleye

24

25-- rel8

26−import Rel8.Expr ( Expr )

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

27import Rel8.Expr.Opaleye ( toPrimExpr )

28import Rel8.Query ( Query )

29import Rel8.Query.Opaleye ( toOpaleye )

30import qualified Rel8.Query.Optimize as Rel8 ( optimize )

31−import Rel8.Schema.Context ( Col(..) )

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

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

33import Rel8.Table ( Table, toColumns )

34import Rel8.Table.Name ( namesFromLabels )

35−import Rel8.Table.Recontextualize ( Selects )

36

35

37

36

38-- | Convert a query to a 'String' containing the query as a @SELECT@

37-- | Convert a query to a 'String' containing the query as a @SELECT@

src/Rel8/Schema/Column.hs+7−6

@@ -24,9 +24,10 @@ import Rel8.Aggregate ( Aggregate )

24import Rel8.Expr ( Expr )

25import Rel8.Kind.Labels ( Labels )

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

27−import Rel8.Schema.Context ( Name, Insertion )

28import Rel8.Schema.Field ( Field )

27import Rel8.Schema.Field ( Field )

28+import Rel8.Schema.Insert ( Insert )

29import qualified Rel8.Schema.Kind as K

30+import Rel8.Schema.Name ( Name )

30import Rel8.Schema.Nullability ( Unnullify )

31import Rel8.Schema.Nullability ( Unnullify )

31import Rel8.Schema.Structure

32import Rel8.Schema.Structure

32 ( Structure

33 ( Structure

@@ -120,7 +121,7 @@ type family HEither context where

120 HEither Aggregate = EitherTable

121 HEither Aggregate = EitherTable

121 HEither Expr = EitherTable

122 HEither Expr = EitherTable

122 HEither Identity = Either

123 HEither Identity = Either

123− HEither Insertion = EitherTable

124+ HEither Insert = EitherTable

124 HEither Name = EitherTable

125 HEither Name = EitherTable

125 HEither _ = Either

126 HEither _ = Either

126

127

@@ -131,7 +132,7 @@ type family HList context where

131 HList Aggregate = ListTable

132 HList Aggregate = ListTable

132 HList Expr = ListTable

133 HList Expr = ListTable

133 HList Identity = []

134 HList Identity = []

134− HList Insertion = ListTable

135+ HList Insert = ListTable

135 HList Name = ListTable

136 HList Name = ListTable

136 HList _ = []

137 HList _ = []

137

138

@@ -142,7 +143,7 @@ type family HMaybe context where

142 HMaybe Aggregate = MaybeTable

143 HMaybe Aggregate = MaybeTable

143 HMaybe Expr = MaybeTable

144 HMaybe Expr = MaybeTable

144 HMaybe Identity = Maybe

145 HMaybe Identity = Maybe

145− HMaybe Insertion = MaybeTable

146+ HMaybe Insert = MaybeTable

146 HMaybe Name = MaybeTable

147 HMaybe Name = MaybeTable

147 HMaybe _ = Maybe

148 HMaybe _ = Maybe

148

149

@@ -153,7 +154,7 @@ type family HNonEmpty context where

153 HNonEmpty Aggregate = NonEmptyTable

154 HNonEmpty Aggregate = NonEmptyTable

154 HNonEmpty Expr = NonEmptyTable

155 HNonEmpty Expr = NonEmptyTable

155 HNonEmpty Identity = NonEmpty

156 HNonEmpty Identity = NonEmpty

156− HNonEmpty Insertion = NonEmptyTable

157+ HNonEmpty Insert = NonEmptyTable

157 HNonEmpty Name = NonEmptyTable

158 HNonEmpty Name = NonEmptyTable

158 HNonEmpty _ = NonEmpty

159 HNonEmpty _ = NonEmpty

159

160

@@ -164,6 +165,6 @@ type family HThese context where

164 HThese Aggregate = TheseTable

165 HThese Aggregate = TheseTable

165 HThese Expr = TheseTable

166 HThese Expr = TheseTable

166 HThese Identity = These

167 HThese Identity = These

167− HThese Insertion = TheseTable

168+ HThese Insert = TheseTable

168 HThese Name = TheseTable

169 HThese Name = TheseTable

169 HThese _ = These

170 HThese _ = These

src/Rel8/Schema/Context.hs+5−52

@@ -1,75 +1,28 @@

1{-# language DataKinds #-}

2−{-# language DerivingStrategies #-}

3{-# language GADTs #-}

2{-# language GADTs #-}

4−{-# language GeneralizedNewtypeDeriving #-}

5{-# language StandaloneKindSignatures #-}

3{-# language StandaloneKindSignatures #-}

6{-# language TypeFamilies #-}

4{-# language TypeFamilies #-}

7

5

8module Rel8.Schema.Context

6module Rel8.Schema.Context

9− ( Interpretation, Col(..)

7+ ( Interpretation(..), Col( Result )

10− , Insertion(..)

11− , Name(..)

12 )

8 )

13where

9where

14

10

15-- base

11-- base

16import Data.Functor.Identity ( Identity )

12import Data.Functor.Identity ( Identity )

17import Data.Kind ( Constraint )

13import Data.Kind ( Constraint )

18−import Data.String ( IsString )

14+import Prelude ()

19−import Prelude

20

15

21-- rel8

16-- rel8

22−import Rel8.Aggregate ( Aggregate )

17+import Rel8.Schema.Kind ( Context, HContext )

23−import Rel8.Expr ( Expr )

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

25−import qualified Rel8.Schema.Kind as K

26import Rel8.Schema.Spec ( Spec( Spec ) )

18import Rel8.Schema.Spec ( Spec( Spec ) )

27

19

28

20

29−type Interpretation :: K.Context -> Constraint

21+type Interpretation :: Context -> Constraint

30class Interpretation context where

22class Interpretation context where

31− data Col context :: K.HContext

23+ data Col context :: HContext

32−

33−

34−instance Interpretation Aggregate where

35− data Col Aggregate _spec where

36− Aggregation :: ()

37− => Aggregate (Expr a)

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

39−

40−

41−instance Interpretation Expr where

42− data Col Expr _spec where

43− DB :: ()

44− => { unDB :: Expr a }

45− -> Col Expr ('Spec labels necessity db a)

46

24

47

25

48instance Interpretation Identity where

26instance Interpretation Identity where

49 data Col Identity _spec where

27 data Col Identity _spec where

50 Result :: a -> Col Identity ('Spec labels necessity db a)

28 Result :: a -> Col Identity ('Spec labels necessity db a)

51−

52−

53−instance Interpretation Insertion where

54− data Col Insertion _spec where

55− RequiredInsert :: Expr a -> Col Insertion ('Spec labels 'Required db a)

56− OptionalInsert :: Maybe (Expr a) -> Col Insertion ('Spec labels 'Optional db a)

57−

58−

59−instance Interpretation Name where

60− data Col Name _spec where

61− NameCol :: String -> Col Name ('Spec labels necessity db a)

62−

63−

64−type Insertion :: K.Context

65−newtype Insertion a = Insertion (Expr a)

66−

67−

68−-- | A @Name@ is the name of a column, as it would be defined in a table's

69−-- schema definition. You can construct names by using the @OverloadedStrings@

70−-- extension and writing string literals. This is typically done when providing

71−-- a 'TableSchema' value.

72−type Name :: K.Context

73−newtype Name a = Name String

74− deriving stock Show

75− deriving newtype (IsString, Monoid, Semigroup)

src/Rel8/Schema/Context/Label.hs+4−34

@@ -1,7 +1,4 @@

1{-# language DataKinds #-}

2−{-# language LambdaCase #-}

3−{-# language FlexibleInstances #-}

4−{-# language MultiParamTypeClasses #-}

5{-# language StandaloneKindSignatures #-}

2{-# language StandaloneKindSignatures #-}

6{-# language TypeFamilies #-}

3{-# language TypeFamilies #-}

7{-# language TypeOperators #-}

4{-# language TypeOperators #-}

@@ -18,14 +15,12 @@ import Data.Kind ( Constraint )

18import Prelude hiding ( null )

15import Prelude hiding ( null )

19

16

20-- rel8

17-- rel8

21−import Rel8.Aggregate ( Aggregate )

22−import Rel8.Expr ( Expr )

23−import Rel8.Schema.Context ( Interpretation, Col(..), Insertion, Name )

18+import Rel8.Schema.Context ( Interpretation, Col(..) )

24−import qualified Rel8.Schema.Kind as K

19+import Rel8.Schema.Kind ( Context, HContext )

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

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

26

21

27

22

28−type Labelable :: K.Context -> Constraint

23+type Labelable :: Context -> Constraint

29class Interpretation context => Labelable context where

24class Interpretation context => Labelable context where

30 labeler :: ()

25 labeler :: ()

31 => Col context ('Spec labels necessity db a)

26 => Col context ('Spec labels necessity db a)

@@ -36,37 +31,12 @@ class Interpretation context => Labelable context where

36 -> Col context ('Spec labels necessity db a)

31 -> Col context ('Spec labels necessity db a)

37

32

38

33

39−instance Labelable Aggregate where

40− labeler (Aggregation aggregate) = Aggregation aggregate

41− unlabeler (Aggregation aggregate) = Aggregation aggregate

42−

43−

44−instance Labelable Expr where

45− labeler (DB a) = DB a

46− unlabeler (DB a) = DB a

47−

48−

49−instance Labelable Insertion where

50− labeler = \case

51− RequiredInsert a -> RequiredInsert a

52− OptionalInsert ma -> OptionalInsert ma

53−

54− unlabeler = \case

55− RequiredInsert a -> RequiredInsert a

56− OptionalInsert ma -> OptionalInsert ma

57−

58−

59instance Labelable Identity where

34instance Labelable Identity where

60 labeler (Result a) = Result a

35 labeler (Result a) = Result a

61 unlabeler (Result a) = Result a

36 unlabeler (Result a) = Result a

62

37

63

38

64−instance Labelable Name where

65− labeler (NameCol a) = NameCol a

66− unlabeler (NameCol a) = NameCol a

67−

68−

69−type HLabelable :: K.HContext -> Constraint

39+type HLabelable :: HContext -> Constraint

70class HLabelable context where

40class HLabelable context where

71 hlabeler :: ()

41 hlabeler :: ()

72 => context ('Spec labels necessity db a)

42 => context ('Spec labels necessity db a)

src/Rel8/Schema/Context/Nullify.hs+7−89

@@ -1,44 +1,35 @@

1{-# language DataKinds #-}

2−{-# language LambdaCase #-}

3{-# language FlexibleContexts #-}

2{-# language FlexibleContexts #-}

4{-# language FlexibleInstances #-}

3{-# language FlexibleInstances #-}

5{-# language MultiParamTypeClasses #-}

4{-# language MultiParamTypeClasses #-}

6−{-# language NamedFieldPuns #-}

7−{-# language ScopedTypeVariables #-}

8{-# language StandaloneKindSignatures #-}

5{-# language StandaloneKindSignatures #-}

9−{-# language TypeApplications #-}

10{-# language TypeFamilies #-}

6{-# language TypeFamilies #-}

11

7

12module Rel8.Schema.Context.Nullify

8module Rel8.Schema.Context.Nullify

13 ( Nullifiable( encodeTag, decodeTag, nullifier, unnullifier )

9 ( Nullifiable( encodeTag, decodeTag, nullifier, unnullifier )

14 , NullifiableEq

10 , NullifiableEq

11+ , unnull, runTag

15 )

12 )

16where

13where

17

14

18-- base

15-- base

19−import Control.Applicative ( empty )

20−import Data.Foldable ( fold )

21import Data.Kind ( Constraint )

16import Data.Kind ( Constraint )

22−import qualified Data.List.NonEmpty as NonEmpty

23−import Data.Monoid ( First( First ), getFirst )

24import Prelude hiding ( null )

17import Prelude hiding ( null )

25

18

26-- opaleye

19-- opaleye

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

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

28

21

29-- rel8

22-- rel8

30−import Rel8.Aggregate ( Aggregate, foldInputs, mapInputs )

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

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

32−import Rel8.Expr.Aggregate ( groupByExpr )

33import Rel8.Expr.Bool ( boolExpr )

24import Rel8.Expr.Bool ( boolExpr )

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

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

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

26+import Rel8.Expr.Opaleye ( fromPrimExpr )

36−import Rel8.Kind.Labels ( KnownLabels, labelsSing, renderLabels )

27+import Rel8.Kind.Labels ( KnownLabels )

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

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

38−import Rel8.Schema.Context ( Interpretation, Col(..), Insertion, Name )

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

39import qualified Rel8.Schema.Kind as K

30import qualified Rel8.Schema.Kind as K

40import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ), Sql )

31import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ), Sql )

41−import Rel8.Schema.Spec ( Spec( Spec ), SSpec(..) )

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

42import Rel8.Type.Eq ( DBEq )

33import Rel8.Type.Eq ( DBEq )

43import Rel8.Type.Monoid ( DBMonoid )

34import Rel8.Type.Monoid ( DBMonoid )

44

35

@@ -66,65 +57,6 @@ class Interpretation context => Nullifiable context where

66 -> Col context ('Spec labels necessity db a)

57 -> Col context ('Spec labels necessity db a)

67

58

68

59

69−instance Nullifiable Aggregate where

70− encodeTag = Aggregation . groupByExpr

71− decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate

72−

73− nullifier tag SSpec {nullability} (Aggregation aggregate) = Aggregation $

74− mapInputs (toPrimExpr . runTag nullability tag . fromPrimExpr) $

75− runTag nullability tag <$> aggregate

76−

77− unnullifier _ SSpec {nullability} (Aggregation aggregate) =

78− Aggregation $ unnull nullability <$> aggregate

79−

80− {-# INLINABLE encodeTag #-}

81− {-# INLINABLE decodeTag #-}

82− {-# INLINABLE nullifier #-}

83− {-# INLINABLE unnullifier #-}

84−

85−

86−instance Nullifiable Expr where

87− encodeTag = DB

88− decodeTag (DB a) = a

89− nullifier tag SSpec {nullability} (DB a) = DB $ runTag nullability tag a

90− unnullifier _ SSpec {nullability} (DB a) = DB $ unnull nullability a

91−

92− {-# INLINABLE encodeTag #-}

93− {-# INLINABLE decodeTag #-}

94− {-# INLINABLE nullifier #-}

95− {-# INLINABLE unnullifier #-}

96−

97−

98−instance Nullifiable Insertion where

99− encodeTag = RequiredInsert

100− decodeTag (RequiredInsert a) = a

101−

102− nullifier tag SSpec {nullability} = \case

103− RequiredInsert a -> RequiredInsert $ runTag nullability tag a

104− OptionalInsert ma -> OptionalInsert $ runTag nullability tag <$> ma

105−

106− unnullifier _ SSpec {nullability} = \case

107− RequiredInsert a -> RequiredInsert $ unnull nullability a

108− OptionalInsert ma -> OptionalInsert $ unnull nullability <$> ma

109−

110− {-# INLINABLE encodeTag #-}

111− {-# INLINABLE decodeTag #-}

112− {-# INLINABLE nullifier #-}

113− {-# INLINABLE unnullifier #-}

114−

115−

116−instance Nullifiable Name where

117− encodeTag _ = nameFromLabel

118− decodeTag _ = mempty

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

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

121−

122− {-# INLINABLE encodeTag #-}

123− {-# INLINABLE decodeTag #-}

124− {-# INLINABLE nullifier #-}

125− {-# INLINABLE unnullifier #-}

126−

127−

128type NullifiableEq :: K.Context -> K.Context -> Constraint

60type NullifiableEq :: K.Context -> K.Context -> Constraint

129class (a ~ b, Nullifiable b) => NullifiableEq a b

61class (a ~ b, Nullifiable b) => NullifiableEq a b

130instance (a ~ b, Nullifiable b) => NullifiableEq a b

62instance (a ~ b, Nullifiable b) => NullifiableEq a b

@@ -135,24 +67,10 @@ runTag nullability tag a = case nullability of

135 Nullable -> boolExpr null a tag

67 Nullable -> boolExpr null a tag

136 NonNullable -> boolExpr null (nullify a) tag

68 NonNullable -> boolExpr null (nullify a) tag

137 where

69 where

138− null = Expr (Opaleye.ConstExpr Opaleye.NullLit)

70+ null = fromPrimExpr $ Opaleye.ConstExpr Opaleye.NullLit

139

71

140

72

141unnull :: Nullability db a -> Expr (Maybe db) -> Expr a

73unnull :: Nullability db a -> Expr (Maybe db) -> Expr a

142unnull nullability a = case nullability of

74unnull nullability a = case nullability of

143 Nullable -> a

75 Nullable -> a

144 NonNullable -> unsafeUnnullify a

76 NonNullable -> unsafeUnnullify a

145−

146−

147−-- HACK

148−undoGroupBy :: Aggregate (Expr _a) -> Maybe (Expr a)

149−undoGroupBy = getFirst . foldInputs go

150− where

151− go Nothing a = pure (Expr a)

152− go _ _ = First empty

153−

154−

155−nameFromLabel :: forall labels necessity db a.

156− KnownLabels labels => Col Name ('Spec labels necessity db a)

157−nameFromLabel = case labelsSing @labels of

158− labels -> NameCol (NonEmpty.last (renderLabels labels))

src/Rel8/Schema/Field.hs+8−8

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

17import Rel8.Expr ( Expr )

18import Rel8.Kind.Labels ( Labels )

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

20−import Rel8.Schema.Context ( Insertion )

20+import Rel8.Schema.Insert ( Insert )

21import qualified Rel8.Schema.Kind as K

22import Rel8.Schema.Spec ( Spec( Spec ) )

23import Rel8.Schema.Structure ( Structure, Shape( Column ), Shape1 )

@@ -25,10 +25,10 @@ import Rel8.Schema.Structure ( Structure, Shape( Column ), Shape1 )

25

26type Field :: K.Context -> Labels -> Necessity -> Type -> Type -> Type

27type family Field labels context necessity db a where

28− Field Identity _labels _necessity _db a = a

28+ Field Identity _labels _necessity _db a = a

29− Field Expr _labels _necessity _db a = Expr a

29+ Field Expr _labels _necessity _db a = Expr a

30− Field Insertion _labels 'Required _db a = Expr a

30+ Field Insert _labels 'Required _db a = Expr a

31− Field Insertion _labels 'Optional _db a = Maybe (Expr a)

31+ Field Insert _labels 'Optional _db a = Maybe (Expr a)

32− Field Aggregate _labels _necessity _db a = Aggregate (Expr a)

32+ Field Aggregate _labels _necessity _db a = Aggregate (Expr a)

33− Field Structure labels necessity db a = Shape1 'Column ('Spec labels necessity db a)

33+ Field Structure labels necessity db a = Shape1 'Column ('Spec labels necessity db a)

34− Field context _labels _necessity _db a = context a

34+ Field context _labels _necessity _db a = context a

src/Rel8/Schema/Generic.hs+36−34

@@ -36,13 +36,13 @@ import GHC.TypeLits ( Symbol, KnownSymbol )

36import Prelude

37

38-- rel8

39−import Rel8.Aggregate ( Aggregate )

39+import Rel8.Aggregate ( Aggregate, Col(..) )

40−import Rel8.Expr ( Expr )

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

41import Rel8.Kind.Necessity

42 ( SNecessity( SRequired, SOptional )

43 , KnownNecessity, necessitySing

44 )

45−import Rel8.Schema.Context

45+import Rel8.Schema.Context ( Col(..) )

46import Rel8.Schema.Context.Identity

47 ( fromHEitherTable, toHEitherTable

48 , fromHListTable, toHListTable

@@ -68,7 +68,9 @@ import Rel8.Schema.HTable.Quintet ( HQuintet(..) )

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

69import Rel8.Schema.HTable.Trio ( HTrio(..) )

70import Rel8.Schema.HTable.Vectorize ( hrelabel )

71+import Rel8.Schema.Insert ( Insert, Col(..) )

71import qualified Rel8.Schema.Kind as K

72import qualified Rel8.Schema.Kind as K

73+import Rel8.Schema.Name ( Name( Name ), Col(..) )

72import Rel8.Schema.Spec ( Spec( Spec ), KTable )

74import Rel8.Schema.Spec ( Spec( Spec ), KTable )

73import Rel8.Schema.Structure

75import Rel8.Schema.Structure

74 ( IsStructure, Shape(..), Shape1, Shape2

76 ( IsStructure, Shape(..), Shape1, Shape2

@@ -114,9 +116,9 @@ instance TableHelper Expr where

114 gtoColumns = toExprColumns

116 gtoColumns = toExprColumns

115

117

116

118

117−instance TableHelper Insertion where

119+instance TableHelper Insert where

118− gfromColumns = fromInsertionColumns

120+ gfromColumns = fromInsertColumns

119− gtoColumns = toInsertionColumns

121+ gtoColumns = toInsertColumns

120

122

121

123

122instance TableHelper Identity where

124instance TableHelper Identity where

@@ -181,8 +183,8 @@ class HTable (GRep t) => Rel8able t where

181 fromExprColumns :: GRep t (Col Expr) -> t Expr

183 fromExprColumns :: GRep t (Col Expr) -> t Expr

182 toExprColumns :: t Expr -> GRep t (Col Expr)

184 toExprColumns :: t Expr -> GRep t (Col Expr)

183

185

184− fromInsertionColumns :: GRep t (Col Insertion) -> t Insertion

186+ fromInsertColumns :: GRep t (Col Insert) -> t Insert

185− toInsertionColumns :: t Insertion -> GRep t (Col Insertion)

187+ toInsertColumns :: t Insert -> GRep t (Col Insert)

186

188

187 fromIdentityColumns :: GRep t (Col Identity) -> t Identity

189 fromIdentityColumns :: GRep t (Col Identity) -> t Identity

188 toIdentityColumns :: t Identity -> GRep t (Col Identity)

190 toIdentityColumns :: t Identity -> GRep t (Col Identity)

@@ -220,19 +222,19 @@ class HTable (GRep t) => Rel8able t where

220 ) => t Expr -> GRep t (Col Expr)

222 ) => t Expr -> GRep t (Col Expr)

221 toExprColumns = toGColumns @_ @(Rep (t Structure)) . from

223 toExprColumns = toGColumns @_ @(Rep (t Structure)) . from

222

224

223− default fromInsertionColumns ::

225+ default fromInsertColumns ::

224− ( Generic (t Insertion)

226+ ( Generic (t Insert)

225 , GColumns (Rep (t Structure)) ~ GRep t

227 , GColumns (Rep (t Structure)) ~ GRep t

226− , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))

228+ , GRel8able Insert (Rep (t Structure)) (Rep (t Insert))

227− ) => GRep t (Col Insertion) -> t Insertion

229+ ) => GRep t (Col Insert) -> t Insert

228− fromInsertionColumns = to . fromGColumns @_ @(Rep (t Structure))

230+ fromInsertColumns = to . fromGColumns @_ @(Rep (t Structure))

229

231

230− default toInsertionColumns ::

232+ default toInsertColumns ::

231− ( Generic (t Insertion)

233+ ( Generic (t Insert)

232 , GColumns (Rep (t Structure)) ~ GRep t

234 , GColumns (Rep (t Structure)) ~ GRep t

233− , GRel8able Insertion (Rep (t Structure)) (Rep (t Insertion))

235+ , GRel8able Insert (Rep (t Structure)) (Rep (t Insert))

234− ) => t Insertion -> GRep t (Col Insertion)

236+ ) => t Insert -> GRep t (Col Insert)

235− toInsertionColumns = toGColumns @_ @(Rep (t Structure)) . from

237+ toInsertColumns = toGColumns @_ @(Rep (t Structure)) . from

236

238

237 default fromIdentityColumns ::

239 default fromIdentityColumns ::

238 ( Generic (t Identity)

240 ( Generic (t Identity)

@@ -402,9 +404,9 @@ instance

402

404

403

405

404instance

406instance

405− ( x ~ Field Insertion '[] necessity db a

407+ ( x ~ Field Insert '[] necessity db a

406 , KnownNecessity necessity

408 , KnownNecessity necessity

407− ) => K1Table label Insertion 'True (Shape1 'Column ('Spec '[] necessity db a)) x

409+ ) => K1Table label Insert 'True (Shape1 'Column ('Spec '[] necessity db a)) x

408 where

410 where

409 fromK1Columns (HIdentity insert) = case insert of

411 fromK1Columns (HIdentity insert) = case insert of

410 RequiredInsert a -> a

412 RequiredInsert a -> a

@@ -417,9 +419,9 @@ instance

417

419

418

420

419instance

421instance

420− ( x ~ Field Insertion (label ': labels) necessity db a

422+ ( x ~ Field Insert (label ': labels) necessity db a

421 , KnownNecessity necessity

423 , KnownNecessity necessity

422− ) => K1Table _label Insertion 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

424+ ) => K1Table _label Insert 'True (Shape1 'Column ('Spec (label ': labels) necessity db a)) x

423 where

425 where

424 fromK1Columns (HIdentity insert) = case insert of

426 fromK1Columns (HIdentity insert) = case insert of

425 RequiredInsert a -> a

427 RequiredInsert a -> a

@@ -520,11 +522,11 @@ instance

520instance

522instance

521 ( HTable (K1Columns "Left" structure1)

523 ( HTable (K1Columns "Left" structure1)

522 , HTable (K1Columns "Right" structure2)

524 , HTable (K1Columns "Right" structure2)

523− , K1Table "Left" Insertion (IsStructure structure1) structure1 a

525+ , K1Table "Left" Insert (IsStructure structure1) structure1 a

524− , K1Table "Right" Insertion (IsStructure structure2) structure2 b

526+ , K1Table "Right" Insert (IsStructure structure2) structure2 b

525 , e ~ EitherTable a b

527 , e ~ EitherTable a b

526 , KnownSymbol label

528 , KnownSymbol label

527− ) => K1Table label Insertion 'True (Shape2 'Either structure1 structure2) e

529+ ) => K1Table label Insert 'True (Shape2 'Either structure1 structure2) e

528 where

530 where

529 fromK1Columns =

531 fromK1Columns =

530 fromColumns2

532 fromColumns2

@@ -615,11 +617,11 @@ instance

615

617

616

618

617instance

619instance

618− ( Table Insertion a

620+ ( Table Insert a

619 , K1Columns label structure ~ HLabel label (Columns a)

621 , K1Columns label structure ~ HLabel label (Columns a)

620 , as ~ ListTable a

622 , as ~ ListTable a

621 , KnownSymbol label

623 , KnownSymbol label

622− ) => K1Table label Insertion 'True (Shape1 'List structure) as

624+ ) => K1Table label Insert 'True (Shape1 'List structure) as

623 where

625 where

624 fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

626 fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

625 toK1Columns = hrelabel (hlabel hlabeler) . toColumns

627 toK1Columns = hrelabel (hlabel hlabeler) . toColumns

@@ -688,10 +690,10 @@ instance

688

690

689instance

691instance

690 ( HTable (K1Columns "Just" structure)

692 ( HTable (K1Columns "Just" structure)

691− , K1Table "Just" Insertion (IsStructure structure) structure a

693+ , K1Table "Just" Insert (IsStructure structure) structure a

692 , ma ~ MaybeTable a

694 , ma ~ MaybeTable a

693 , KnownSymbol label

695 , KnownSymbol label

694− ) => K1Table label Insertion 'True (Shape1 'Maybe structure) ma

696+ ) => K1Table label Insert 'True (Shape1 'Maybe structure) ma

695 where

697 where

696 fromK1Columns =

698 fromK1Columns =

697 fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .

699 fromColumns1 (fromK1Columns @"Just" @_ @_ @structure) .

@@ -766,11 +768,11 @@ instance

766

768

767

769

768instance

770instance

769− ( Table Insertion a

771+ ( Table Insert a

770 , K1Columns label structure ~ HLabel label (Columns a)

772 , K1Columns label structure ~ HLabel label (Columns a)

771 , as ~ NonEmptyTable a

773 , as ~ NonEmptyTable a

772 , KnownSymbol label

774 , KnownSymbol label

773− ) => K1Table label Insertion 'True (Shape1 'NonEmpty structure) as

775+ ) => K1Table label Insert 'True (Shape1 'NonEmpty structure) as

774 where

776 where

775 fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

777 fromK1Columns = fromColumns . hrelabel (hunlabel hunlabeler)

776 toK1Columns = hrelabel (hlabel hlabeler) . toColumns

778 toK1Columns = hrelabel (hlabel hlabeler) . toColumns

@@ -852,11 +854,11 @@ instance

852instance

854instance

853 ( HTable (K1Columns "Here" structure1)

855 ( HTable (K1Columns "Here" structure1)

854 , HTable (K1Columns "There" structure2)

856 , HTable (K1Columns "There" structure2)

855− , K1Table "Here" Insertion (IsStructure structure1) structure1 a

857+ , K1Table "Here" Insert (IsStructure structure1) structure1 a

856− , K1Table "There" Insertion (IsStructure structure2) structure2 b

858+ , K1Table "There" Insert (IsStructure structure2) structure2 b

857 , e ~ TheseTable a b

859 , e ~ TheseTable a b

858 , KnownSymbol label

860 , KnownSymbol label

859− ) => K1Table label Insertion 'True (Shape2 'These structure1 structure2) e

861+ ) => K1Table label Insert 'True (Shape2 'These structure1 structure2) e

860 where

862 where

861 fromK1Columns =

863 fromK1Columns =

862 fromColumns2

864 fromColumns2

src/Rel8/Schema/Insert.hsnew file+160

@@ -0,0 +1,160 @@

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

10+{-# language StandaloneKindSignatures #-}

11+{-# language TypeApplications #-}

12+{-# language TypeFamilies #-}

13+{-# language UndecidableInstances #-}

14+{-# language UndecidableSuperClasses #-}

15+

16+module Rel8.Schema.Insert

17+ ( Insert(..)

18+ , OnConflict(..)

19+ , Col( RequiredInsert, OptionalInsert )

20+ , Insertion(..)

21+ , Inserts

22+ )

23+where

24+

25+-- base

26+import Data.Functor.Identity ( Identity )

27+import Data.Kind ( Constraint, Type )

28+import Prelude

29+

30+-- rel8

31+import Rel8.Aggregate ( Aggregate )

32+import Rel8.Expr ( Expr )

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

34+import Rel8.Opaque ( Opaque, Opaque1 )

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

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

37+import Rel8.Schema.Context.Nullify

38+ ( Nullifiable, encodeTag, decodeTag, nullifier, unnullifier

39+ , runTag, unnull

40+ )

41+import Rel8.Schema.HTable.Type ( HType(HType) )

42+import qualified Rel8.Schema.Kind as K

43+import Rel8.Schema.Name ( Name, Selects )

44+import Rel8.Schema.Nullability ( Sql )

45+import Rel8.Schema.Spec ( SSpec(SSpec, nullability), Spec(Spec) )

46+import Rel8.Schema.Table ( TableSchema )

47+import Rel8.Statement.Returning ( Returning )

48+import Rel8.Table ( Table(..) )

49+import Rel8.Table.Recontextualize ( Recontextualize )

50+import Rel8.Type ( DBType )

51+

52+

53+-- | @OnConflict@ allows you to add an @ON CONFLICT@ clause to an @INSERT@

54+-- statement.

55+data OnConflict

56+ = Abort -- ^ @ON CONFLICT ABORT@

57+ | DoNothing -- ^ @ON CONFLICT DO NOTHING@

58+

59+

60+-- | The constituent parts of a SQL @INSERT@ statement.

61+type Insert :: K.Context

62+data Insert a where

63+ Insert :: (Selects names exprs, Inserts exprs inserts) =>

64+ { into :: TableSchema names

65+ -- ^ Which table to insert into.

66+ , rows :: [inserts]

67+ -- ^ The rows to insert.

68+ , onConflict :: OnConflict

69+ -- ^ What to do if the inserted rows conflict with data already in the

70+ -- table.

71+ , returning :: Returning names a

72+ -- ^ What information to return on completion.

73+ }

74+ -> Insert a

75+

76+

77+instance Interpretation Insert where

78+ data Col Insert _spec where

79+ RequiredInsert :: Expr a -> Col Insert ('Spec labels 'Required db a)

80+ OptionalInsert :: Maybe (Expr a) -> Col Insert ('Spec labels 'Optional db a)

81+

82+

83+type Insertion :: K.Context

84+newtype Insertion a = Insertion (Expr a)

85+

86+

87+instance Sql DBType a => Table Insert (Insertion a) where

88+ type Columns (Insertion a) = HType a

89+ type Context (Insertion a) = Insert

90+

91+ toColumns (Insertion a) = HType (RequiredInsert a)

92+ fromColumns (HType (RequiredInsert a)) = Insertion a

93+

94+

95+instance Sql DBType a =>

96+ Recontextualize Aggregate Insert (Aggregate (Expr a)) (Insertion a)

97+

98+

99+instance Sql DBType a => Recontextualize Expr Insert (Expr a) (Insertion a)

100+

101+

102+instance Sql DBType a =>

103+ Recontextualize Identity Insert (Identity a) (Insertion a)

104+

105+

106+instance Sql DBType a =>

107+ Recontextualize Insert Aggregate (Insertion a) (Aggregate (Expr a))

108+

109+

110+instance Sql DBType a => Recontextualize Insert Expr (Insertion a) (Expr a)

111+

112+

113+instance Sql DBType a =>

114+ Recontextualize Insert Identity (Insertion a) (Identity a)

115+

116+

117+instance Sql DBType a => Recontextualize Insert Insert (Insertion a) (Insertion a)

118+

119+

120+instance Sql DBType a => Recontextualize Insert Name (Insertion a) (Name a)

121+

122+

123+instance Sql DBType a => Recontextualize Name Insert (Name a) (Insertion a)

124+

125+

126+instance Labelable Insert where

127+ labeler = \case

128+ RequiredInsert a -> RequiredInsert a

129+ OptionalInsert ma -> OptionalInsert ma

130+

131+ unlabeler = \case

132+ RequiredInsert a -> RequiredInsert a

133+ OptionalInsert ma -> OptionalInsert ma

134+

135+

136+instance Nullifiable Insert where

137+ encodeTag = RequiredInsert

138+ decodeTag (RequiredInsert a) = a

139+

140+ nullifier tag SSpec {nullability} = \case

141+ RequiredInsert a -> RequiredInsert $ runTag nullability tag a

142+ OptionalInsert ma -> OptionalInsert $ runTag nullability tag <$> ma

143+

144+ unnullifier _ SSpec {nullability} = \case

145+ RequiredInsert a -> RequiredInsert $ unnull nullability a

146+ OptionalInsert ma -> OptionalInsert $ unnull nullability <$> ma

147+

148+ {-# INLINABLE encodeTag #-}

149+ {-# INLINABLE decodeTag #-}

150+ {-# INLINABLE nullifier #-}

151+ {-# INLINABLE unnullifier #-}

152+

153+

154+

155+-- | @Inserts a b@ means that the columns in @a@ are compatible for inserting

156+-- with the table @b@.

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

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

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

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

src/Rel8/Schema/Name.hsnew file+112

@@ -0,0 +1,112 @@

1+{-# language DataKinds #-}

2+{-# language DerivingStrategies #-}

3+{-# language FlexibleContexts #-}

4+{-# language FlexibleInstances #-}

5+{-# language GeneralizedNewtypeDeriving #-}

6+{-# language MultiParamTypeClasses #-}

7+{-# language RankNTypes #-}

8+{-# language ScopedTypeVariables #-}

9+{-# language StandaloneKindSignatures #-}

10+{-# language TypeApplications #-}

11+{-# language TypeFamilies #-}

12+{-# language UndecidableInstances #-}

13+{-# language UndecidableSuperClasses #-}

14+

15+module Rel8.Schema.Name

16+ ( Name(..)

17+ , Col( NameCol )

18+ , Selects

19+ )

20+where

21+

22+-- base

23+import Data.Functor.Identity ( Identity )

24+import qualified Data.List.NonEmpty as NonEmpty

25+import Data.Kind ( Constraint, Type )

26+import Data.String ( IsString )

27+import Prelude

28+

29+-- rel8

30+import Rel8.Expr ( Expr )

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

32+import Rel8.Opaque ( Opaque, Opaque1 )

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

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

35+import Rel8.Schema.Context.Nullify

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

37+ )

38+import Rel8.Schema.HTable.Type ( HType( HType ) )

39+import qualified Rel8.Schema.Kind as K

40+import Rel8.Schema.Nullability ( Sql )

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

42+import Rel8.Table ( Table, Columns, Context, fromColumns, toColumns )

43+import Rel8.Table.Recontextualize ( Recontextualize )

44+import Rel8.Type ( DBType )

45+

46+

47+-- | A @Name@ is the name of a column, as it would be defined in a table's

48+-- schema definition. You can construct names by using the @OverloadedStrings@

49+-- extension and writing string literals. This is typically done when providing

50+-- a 'TableSchema' value.

51+type Name :: K.Context

52+newtype Name a = Name String

53+ deriving stock Show

54+ deriving newtype (IsString, Monoid, Semigroup)

55+

56+

57+instance Sql DBType a => Table Name (Name a) where

58+ type Columns (Name a) = HType a

59+ type Context (Name a) = Name

60+

61+ toColumns (Name a) = HType (NameCol a)

62+ fromColumns (HType (NameCol a)) = Name a

63+

64+

65+instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)

66+

67+

68+instance Sql DBType a => Recontextualize Identity Name (Identity a) (Name a)

69+

70+

71+instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)

72+

73+

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

75+

76+

77+instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)

78+

79+

80+instance Interpretation Name where

81+ newtype Col Name _spec = NameCol String

82+

83+

84+instance Labelable Name where

85+ labeler (NameCol a) = NameCol a

86+ unlabeler (NameCol a) = NameCol a

87+

88+

89+instance Nullifiable Name where

90+ encodeTag _ = nameFromLabel

91+ decodeTag _ = mempty

92+ nullifier _ _ (NameCol name) = NameCol name

93+ unnullifier _ _ (NameCol name) = NameCol name

94+

95+ {-# INLINABLE encodeTag #-}

96+ {-# INLINABLE decodeTag #-}

97+ {-# INLINABLE nullifier #-}

98+ {-# INLINABLE unnullifier #-}

99+

100+

101+nameFromLabel :: forall labels necessity db a.

102+ KnownLabels labels => Col Name ('Spec labels necessity db a)

103+nameFromLabel = case labelsSing @labels of

104+ labels -> NameCol (NonEmpty.last (renderLabels labels))

105+

106+

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

108+-- the 'Expr' columns in @b@.

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

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

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

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

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

@@ -29,11 +29,11 @@ import qualified Opaleye.Internal.Manipulation as Opaleye

29-- rel8

30import Rel8.Expr ( Expr )

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

32+import Rel8.Schema.Name ( Selects )

32import Rel8.Schema.Table ( TableSchema )

33import Rel8.Schema.Table ( TableSchema )

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

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

34import Rel8.Table ( fromColumns, toColumns )

35import Rel8.Table ( fromColumns, toColumns )

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

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

36−import Rel8.Table.Recontextualize ( Selects )

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

38

39-- text

src/Rel8/Statement/Insert.hs+4−31

@@ -1,9 +1,6 @@

1−{-# language DuplicateRecordFields #-}

2−{-# language FlexibleContexts #-}

3{-# language GADTs #-}

1{-# language GADTs #-}

4{-# language NamedFieldPuns #-}

2{-# language NamedFieldPuns #-}

5{-# language ScopedTypeVariables #-}

3{-# language ScopedTypeVariables #-}

6−{-# language StandaloneKindSignatures #-}

7{-# language TypeApplications #-}

4{-# language TypeApplications #-}

8

5

9module Rel8.Statement.Insert

6module Rel8.Statement.Insert

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

15

12

16-- base

13-- base

17import Control.Exception ( throwIO )

14import Control.Exception ( throwIO )

18−import Data.Kind ( Type )

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

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

20import Prelude

16import Prelude

21

17

@@ -26,14 +22,15 @@ import qualified Hasql.Encoders as Hasql

26import qualified Hasql.Session as Hasql

22import qualified Hasql.Session as Hasql

27import qualified Hasql.Statement as Hasql

23import qualified Hasql.Statement as Hasql

28

24

29−-- rel8

25+-- opaleye

30import qualified Opaleye.Internal.Manipulation as Opaleye

26import qualified Opaleye.Internal.Manipulation as Opaleye

31import qualified Opaleye.Manipulation as Opaleye

27import qualified Opaleye.Manipulation as Opaleye

28+

29+-- rel8

32−import Rel8.Schema.Table ( TableSchema )

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

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

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

34import Rel8.Table ( fromColumns, toColumns )

32import Rel8.Table ( fromColumns, toColumns )

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

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

36−import Rel8.Table.Recontextualize ( Inserts, Selects )

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

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

38

35

39-- text

36-- text

@@ -41,30 +38,6 @@ import qualified Data.Text as Text ( pack )

41import Data.Text.Encoding ( encodeUtf8 )

38import Data.Text.Encoding ( encodeUtf8 )

42

39

43

40

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

45−type Insert :: Type -> Type

46−data Insert a where

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

48− { into :: TableSchema names

49− -- ^ Which table to insert into.

50− , rows :: [inserts]

51− -- ^ The rows to insert.

52− , onConflict :: OnConflict

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

54− -- table.

55− , returning :: Returning names a

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

57− }

58− -> Insert a

59−

60−

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

62−-- statement.

63−data OnConflict

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

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

66−

67−

68-- | Run an @INSERT@ statement

41-- | Run an @INSERT@ statement

69--

42--

70-- >>> :{

43-- >>> :{

src/Rel8/Statement/Returning.hs+1−1

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

12import Prelude ()

13

14-- rel8

15−import Rel8.Table.Recontextualize ( Selects )

15+import Rel8.Schema.Name ( Selects )

16import Rel8.Table.Serialize ( Serializable )

17

18

src/Rel8/Statement/Select.hs+1−1

@@ -21,7 +21,7 @@ import qualified Hasql.Statement as Hasql

21-- rel8

22import Rel8.Query ( Query )

23import Rel8.Query.SQL ( sqlForQuery, sqlForQueryWithNames )

24−import Rel8.Table.Recontextualize ( Selects )

24+import Rel8.Schema.Name ( Selects )

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

26

27-- text

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

@@ -31,12 +31,12 @@ import Data.Profunctor ( lmap )

31-- rel8

32import Rel8.Expr ( Expr )

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

34+import Rel8.Schema.Name ( Selects )

34import Rel8.Schema.Table ( TableSchema )

35import Rel8.Schema.Table ( TableSchema )

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

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

36import Rel8.Table ( fromColumns, toColumns )

37import Rel8.Table ( fromColumns, toColumns )

37import Rel8.Table.Insert ( toInsert )

38import Rel8.Table.Insert ( toInsert )

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

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

39−import Rel8.Table.Recontextualize ( Selects )

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

41

42-- text

src/Rel8/Statement/View.hs+1−1

@@ -22,9 +22,9 @@ import qualified Hasql.Statement as Hasql

22-- rel8

23import Rel8.Query ( Query )

24import Rel8.Query.SQL ( sqlForQueryWithNames )

25+import Rel8.Schema.Name ( Selects )

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

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

26import Rel8.Table.Alternative ( emptyTable )

27import Rel8.Table.Alternative ( emptyTable )

27−import Rel8.Table.Recontextualize ( Selects )

28

29-- text

30import qualified Data.Text as Text

src/Rel8/Table.hs+6−32

@@ -20,12 +20,11 @@ import Data.Kind ( Constraint, Type )

20import Prelude

21

22-- rel8

23−import Rel8.Aggregate ( Aggregate )

24−import Rel8.Expr ( Expr )

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

25import Rel8.Opaque ( Opaque, Opaque1 )

24import Rel8.Opaque ( Opaque, Opaque1 )

26−import Rel8.Schema.Context ( Col(..), Insertion(..), Name(..) )

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

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

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

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

27+import Rel8.Schema.HTable ( HTable )

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

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

30import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

29import Rel8.Schema.HTable.Label ( HLabel, hlabel, hunlabel )

31import Rel8.Schema.HTable.Pair ( HPair(..) )

30import Rel8.Schema.HTable.Pair ( HPair(..) )

@@ -35,7 +34,7 @@ import Rel8.Schema.HTable.Trio ( HTrio(..) )

35import Rel8.Schema.HTable.Type ( HType( HType ) )

34import Rel8.Schema.HTable.Type ( HType( HType ) )

36import qualified Rel8.Schema.Kind as K

35import qualified Rel8.Schema.Kind as K

37import Rel8.Schema.Nullability ( Sql )

36import Rel8.Schema.Nullability ( Sql )

38−import Rel8.Schema.Spec ( SSpec( SSpec ), KnownSpec )

37+import Rel8.Schema.Spec ( KnownSpec )

39import Rel8.Type ( DBType )

38import Rel8.Type ( DBType )

40

39

41

40

@@ -78,25 +77,6 @@ instance KnownSpec spec => Table context (Col context spec) where

78 fromColumns = unHIdentity

77 fromColumns = unHIdentity

79

78

80

79

81−instance Table Expr a => Table Aggregate (Aggregate a) where

82− type Columns (Aggregate a) = Columns a

83− type Context (Aggregate a) = Aggregate

84−

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

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

87− fromColumns as = fmap fromColumns $ htabulateA $ \field ->

88− case hfield as field of

89− Aggregation a -> DB <$> a

90−

91−

92−instance Sql DBType a => Table Expr (Expr a) where

93− type Columns (Expr a) = HType a

94− type Context (Expr a) = Expr

95−

96− toColumns a = HType (DB a)

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

98−

99−

100instance Sql DBType a => Table Identity (Identity a) where

80instance Sql DBType a => Table Identity (Identity a) where

101 type Columns (Identity a) = HType a

81 type Columns (Identity a) = HType a

102 type Context (Identity a) = Identity

82 type Context (Identity a) = Identity

@@ -105,20 +85,14 @@ instance Sql DBType a => Table Identity (Identity a) where

105 fromColumns (HType (Result a)) = Identity a

85 fromColumns (HType (Result a)) = Identity a

106

86

107

87

88+{-}

108instance Sql DBType a => Table Insertion (Insertion a) where

89instance Sql DBType a => Table Insertion (Insertion a) where

109 type Columns (Insertion a) = HType a

90 type Columns (Insertion a) = HType a

110 type Context (Insertion a) = Insertion

91 type Context (Insertion a) = Insertion

111

92

112 toColumns (Insertion a) = HType (RequiredInsert a)

93 toColumns (Insertion a) = HType (RequiredInsert a)

113 fromColumns (HType (RequiredInsert a)) = Insertion a

94 fromColumns (HType (RequiredInsert a)) = Insertion a

114−

95+-}

115−

116−instance Sql DBType a => Table Name (Name a) where

117− type Columns (Name a) = HType a

118− type Context (Name a) = Name

119−

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

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

122

96

123

97

124instance

98instance

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

@@ -18,10 +18,9 @@ import Data.Functor.Identity ( Identity( Identity ) )

18import Prelude

19

20-- rel8

21−import Rel8.Aggregate ( Aggregate )

21+import Rel8.Aggregate ( Aggregate, Aggregates, Col(..) )

22−import Rel8.Expr ( Expr )

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

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

24−import Rel8.Schema.Context ( Col(..) )

25import Rel8.Schema.Dict ( Dict( Dict ) )

24import Rel8.Schema.Dict ( Dict( Dict ) )

26import Rel8.Schema.HTable ( htabulate, hfield, hdicts, hspecs )

25import Rel8.Schema.HTable ( htabulate, hfield, hdicts, hspecs )

27import Rel8.Schema.HTable.Vectorize ( hvectorize )

26import Rel8.Schema.HTable.Vectorize ( hvectorize )

@@ -31,7 +30,6 @@ import Rel8.Table ( Table, Columns, toColumns, fromColumns )

31import Rel8.Table.Eq ( EqTable )

30import Rel8.Table.Eq ( EqTable )

32import Rel8.Table.List ( ListTable )

31import Rel8.Table.List ( ListTable )

33import Rel8.Table.NonEmpty ( NonEmptyTable )

32import Rel8.Table.NonEmpty ( NonEmptyTable )

34−import Rel8.Table.Recontextualize ( Aggregates )

35import Rel8.Type.Eq ( DBEq )

33import Rel8.Type.Eq ( DBEq )

36

34

37

35

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

@@ -12,9 +12,8 @@ where

12import Prelude

13

14-- rel8

15−import Rel8.Expr ( Expr )

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

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

17−import Rel8.Schema.Context ( Col(..) )

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

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

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

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

20

19

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

@@ -23,11 +23,10 @@ import Data.List.NonEmpty ( NonEmpty( (:|) ) )

23import Prelude hiding ( seq )

24

25-- rel8

26−import Rel8.Expr ( Expr )

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

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

28import Rel8.Expr.Eq ( seq, sne )

29import Rel8.Opaque ( Opaque )

30−import Rel8.Schema.Context ( Col(..) )

31import Rel8.Schema.Dict ( Dict( Dict ) )

30import Rel8.Schema.Dict ( Dict( Dict ) )

32import Rel8.Schema.HTable

31import Rel8.Schema.HTable

33 ( HConstrainTable

32 ( HConstrainTable

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

@@ -13,12 +13,12 @@ where

13import Prelude

14

15-- rel8

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

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

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

17−import Rel8.Schema.Context ( Col(..) )

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

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

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

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

20import Rel8.Table ( fromColumns, toColumns )

21import Rel8.Table ( fromColumns, toColumns )

21−import Rel8.Table.Recontextualize ( Inserts )

22

23

24-- | @toInsert@ converts a 'Table' of 'Expr's into a 'Table' that can be used

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

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

15import Prelude

16

17-- rel8

18−import Rel8.Expr ( Expr )

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

19import Rel8.Expr.Array ( sappend, sempty )

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

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

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

22import Rel8.Schema.HTable.Vectorize ( happend, hempty )

21import Rel8.Schema.HTable.Vectorize ( happend, hempty )

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

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

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

@@ -24,10 +24,10 @@ import Prelude

24import Text.Casing ( quietSnake )

25

26-- rel8

27−import Rel8.Expr ( Expr )

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

28import Rel8.Kind.Labels ( renderLabels )

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

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

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

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

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

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

33

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

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

15import Prelude

16

17-- rel8

18−import Rel8.Expr ( Expr )

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

19import Rel8.Expr.Array ( sappend1 )

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

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

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

22import Rel8.Schema.HTable.Vectorize ( happend )

21import Rel8.Schema.HTable.Vectorize ( happend )

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

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

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

@@ -33,7 +33,7 @@ import Data.Profunctor ( dimap, lmap )

33

34-- rel8

35import Rel8.Aggregate ( Aggregate( Aggregate ) )

36−import Rel8.Expr ( Expr )

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

37import Rel8.Expr.Opaleye

38 ( scastExpr

39 , fromPrimExpr, toPrimExpr

@@ -41,12 +41,12 @@ import Rel8.Expr.Opaleye

41 , fromColumn, toColumn

42 )

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

44−import Rel8.Schema.Context ( Col(..), Insertion, Name(..) )

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

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

45+import Rel8.Schema.Insert ( Insert, Inserts, Col(..) )

46+import Rel8.Schema.Name ( Name, Selects, Col(..) )

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

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

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

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

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

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

49−import Rel8.Table.Recontextualize ( Selects, Inserts )

50import Rel8.Table.Undefined ( undefined )

51

52-- semigroupoids

@@ -95,7 +95,7 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $

95 specs -> case hfield names field of

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

97 where

98− go :: SSpec spec -> Col Name spec -> Opaleye.TableFields (Col Insertion spec) (Col Expr spec)

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

99 go SSpec {necessity, info, nullability} (NameCol name) =

100 case necessity of

101 SRequired ->

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

@@ -20,12 +20,11 @@ import Data.Kind ( Constraint, Type )

20import Prelude hiding ( seq )

21

22-- rel8

23−import Rel8.Expr ( Expr )

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

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

25import Rel8.Expr.Eq ( seq )

26import Rel8.Expr.Ord ( slt, sgt)

27import Rel8.Opaque ( Opaque )

28−import Rel8.Schema.Context ( Col(..) )

29import Rel8.Schema.Dict ( Dict( Dict ) )

28import Rel8.Schema.Dict ( Dict( Dict ) )

30import Rel8.Schema.HTable

29import Rel8.Schema.HTable

31 ( HConstrainTable

30 ( HConstrainTable

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

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

15import Prelude

16

17-- rel8

18+import Rel8.Expr ( unDB )

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

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

19import Rel8.Order ( Order )

20import Rel8.Order ( Order )

20−import Rel8.Schema.Context ( unDB )

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

22import Rel8.Schema.HTable (htabulateA, hfield, hdicts, hspecs)

23import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

src/Rel8/Table/Recontextualize.hs+8−82

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

1{-# language DataKinds #-}

2−{-# language FlexibleContexts #-}

3{-# language FlexibleInstances #-}

2{-# language FlexibleInstances #-}

4{-# language FunctionalDependencies #-}

3{-# language FunctionalDependencies #-}

5{-# language StandaloneKindSignatures #-}

4{-# language StandaloneKindSignatures #-}

@@ -9,10 +8,6 @@

9

8

10module Rel8.Table.Recontextualize

9module Rel8.Table.Recontextualize

11 ( Recontextualize

10 ( Recontextualize

12− , Aggregates

13− , Encodes

14− , Selects

15− , Inserts

16 )

11 )

17where

12where

18

13

@@ -22,10 +17,8 @@ import Data.Kind ( Constraint, Type )

22import Prelude ()

17import Prelude ()

23

18

24-- rel8

19-- rel8

25−import Rel8.Aggregate ( Aggregate )

26−import Rel8.Expr ( Expr )

27−import Rel8.Opaque ( Opaque, Opaque1 )

20+import Rel8.Opaque ( Opaque1 )

28−import Rel8.Schema.Context ( Col(..), Insertion, Name )

21+import Rel8.Schema.Context ( Col )

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

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

30import Rel8.Schema.HTable ( HTable )

23import Rel8.Schema.HTable ( HTable )

31import qualified Rel8.Schema.Kind as K

24import qualified Rel8.Schema.Kind as K

@@ -54,59 +47,23 @@ instance KnownSpec spec =>

54 Recontextualize from to (Col from spec) (Col to spec)

47 Recontextualize from to (Col from spec) (Col to spec)

55

48

56

49

57−instance Sql DBType a =>

50+{-

58− Recontextualize Aggregate Aggregate (Aggregate (Expr a)) (Aggregate (Expr a))

59−

60−

61−instance Sql DBType a =>

62− Recontextualize Aggregate Expr (Aggregate (Expr a)) (Expr a)

63−

64−

65−instance Sql DBType a =>

66− Recontextualize Aggregate Identity (Aggregate (Expr a)) (Identity a)

67−

68−

69instance Sql DBType a =>

51instance Sql DBType a =>

70 Recontextualize Aggregate Insertion (Aggregate (Expr a)) (Insertion a)

52 Recontextualize Aggregate Insertion (Aggregate (Expr a)) (Insertion a)

71

53

72

54

73−instance Sql DBType a =>

74− Recontextualize Aggregate Name (Aggregate (Expr a)) (Name a)

75−

76−

77−instance Sql DBType a =>

78− Recontextualize Expr Aggregate (Expr a) (Aggregate (Expr a))

79−

80−

81−instance Sql DBType a => Recontextualize Expr Expr (Expr a) (Expr a)

82−

83−

84−instance Sql DBType a => Recontextualize Expr Identity (Expr a) (Identity a)

85−

86−

87instance Sql DBType a => Recontextualize Expr Insertion (Expr a) (Insertion a)

55instance Sql DBType a => Recontextualize Expr Insertion (Expr a) (Insertion a)

88−

56+-}

89−

90−instance Sql DBType a => Recontextualize Expr Name (Expr a) (Name a)

91−

92−

93−instance Sql DBType a =>

94− Recontextualize Identity Aggregate (Identity a) (Aggregate (Expr a))

95−

96−

97−instance Sql DBType a => Recontextualize Identity Expr (Identity a) (Expr a)

98

57

99

58

100instance Sql DBType a => Recontextualize Identity Identity (Identity a) (Identity a)

59instance Sql DBType a => Recontextualize Identity Identity (Identity a) (Identity a)

101

60

102

61

62+{-

103instance Sql DBType a =>

63instance Sql DBType a =>

104 Recontextualize Identity Insertion (Identity a) (Insertion a)

64 Recontextualize Identity Insertion (Identity a) (Insertion a)

105

65

106

66

107−instance Sql DBType a => Recontextualize Identity Name (Identity a) (Name a)

108−

109−

110instance Sql DBType a =>

67instance Sql DBType a =>

111 Recontextualize Insertion Aggregate (Insertion a) (Aggregate (Expr a))

68 Recontextualize Insertion Aggregate (Insertion a) (Aggregate (Expr a))

112

69

@@ -124,20 +81,8 @@ instance Sql DBType a => Recontextualize Insertion Insertion (Insertion a) (Inse

124instance Sql DBType a => Recontextualize Insertion Name (Insertion a) (Name a)

81instance Sql DBType a => Recontextualize Insertion Name (Insertion a) (Name a)

125

82

126

83

127−instance Sql DBType a =>

128− Recontextualize Name Aggregate (Name a) (Aggregate (Expr a))

129−

130−

131−instance Sql DBType a => Recontextualize Name Expr (Name a) (Expr a)

132−

133−

134−instance Sql DBType a => Recontextualize Name Identity (Name a) (Identity a)

135−

136−

137instance Sql DBType a => Recontextualize Name Insertion (Name a) (Insertion a)

84instance Sql DBType a => Recontextualize Name Insertion (Name a) (Insertion a)

138−

85+-}

139−

140−instance Sql DBType a => Recontextualize Name Name (Name a) (Name a)

141

86

142

87

143instance Recontextualize from to (Opaque1 from a) (Opaque1 to a)

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

@@ -188,19 +133,7 @@ instance

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

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

189

134

190

135

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

136+{-

192−-- for the columns in @b@.

193−type Aggregates :: Type -> Type -> Constraint

194−class Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

195−instance Recontextualize Aggregate Expr aggregates exprs => Aggregates aggregates exprs

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

197−

198−

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

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

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

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

203−

204

137

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

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

206-- with the table @b@.

139-- with the table @b@.

@@ -208,11 +141,4 @@ type Inserts :: Type -> Type -> Constraint

208class Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts

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

209instance Recontextualize Expr Insertion exprs inserts => Inserts exprs inserts

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

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

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

211−

144+-}

212−

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

214−-- the 'Expr' columns in @b@.

215−type Selects :: Type -> Type -> Constraint

216−class Recontextualize Name Expr names exprs => Selects names exprs

217−instance Recontextualize Name Expr names exprs => Selects names exprs

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

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

@@ -28,7 +28,7 @@ import Prelude

28import qualified Hasql.Decoders as Hasql

29

30-- rel8

31−import Rel8.Expr ( Expr )

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

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

33import Rel8.Opaque ( Opaque )

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

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

54import Rel8.Table.List ( ListTable )

55import Rel8.Table.Maybe ( MaybeTable )

56import Rel8.Table.NonEmpty ( NonEmptyTable )

57−import Rel8.Table.Recontextualize ( Encodes )

58import Rel8.Table.These ( TheseTable )

57import Rel8.Table.These ( TheseTable )

59import Rel8.Type ( DBType )

58import Rel8.Type ( DBType )

60

59

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

@@ -11,9 +11,8 @@ where

11import Prelude hiding ( undefined )

12

13-- rel8

14−import Rel8.Expr ( Expr )

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

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

16−import Rel8.Schema.Context ( Col(..) )

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

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

18import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

17import Rel8.Schema.Nullability ( Nullability( Nullable, NonNullable ) )

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

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