06f67cf · rel8 · git.iko.soy

rel8.cabal+1−2

compare with master

unifiedsplit

@@ -62,7 +62,6 @@ library

62 Rel8.Expr.Text

63 Rel8.Expr.Time

64

65− Rel8.Kind.Bool

66 Rel8.Kind.Labels

65 Rel8.Kind.Labels

67 Rel8.Kind.Necessity

66 Rel8.Kind.Necessity

68

67

@@ -149,7 +148,7 @@ library

149 Rel8.Tabulate

148 Rel8.Tabulate

150

149

151 Rel8.Type

150 Rel8.Type

152− Rel8.Type.Array

151+ Rel8.Type.Array1D

153 Rel8.Type.Eq

152 Rel8.Type.Eq

154 Rel8.Type.Information

153 Rel8.Type.Information

155 Rel8.Type.Monoid

154 Rel8.Type.Monoid

src/Rel8/Expr.hs+2−2

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

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

26import Rel8.Expr.Opaleye

27 ( castExpr

28− , unsafeFromPrimExpr

28+ , fromPrimExpr

29 , mapPrimExpr

30 , zipPrimExprsWith

31 )

@@ -74,7 +74,7 @@ instance (DBNum db, Nullabilizes db a) => Num (Expr a) where

74

75 signum = castExpr . mapPrimExpr (Opaleye.UnExpr (Opaleye.UnOpOther "SIGN"))

76

77− fromInteger = castExpr . unsafeFromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit

77+ fromInteger = castExpr . fromPrimExpr . Opaleye.ConstExpr . Opaleye.IntegerLit

78

79

80instance (DBFractional db, Nullabilizes db a) => Fractional (Expr a) where

src/Rel8/Expr/Aggregate.hs+19−14

@@ -32,12 +32,13 @@ import Rel8.Expr.Bool ( caseExpr )

32import Rel8.Expr.Opaleye

33 ( castExpr

34 , fromPrimExpr

35− , unsafeFromPrimExpr

35+ , fromPrimExpr

36− , unsafeToPrimExpr

36+ , toPrimExpr

37 )

38import Rel8.Expr.Null ( null )

39import Rel8.Expr.Serialize ( litExpr )

40import Rel8.Schema.Nullability ( Nullability, Nullabilizes, nullabilization )

41+import Rel8.Type.Array ( fromPrimArray )

41import Rel8.Type.Eq ( DBEq )

42import Rel8.Type.Eq ( DBEq )

42import Rel8.Type.Num ( DBNum )

43import Rel8.Type.Num ( DBNum )

43import Rel8.Type.Ord ( DBMax, DBMin )

44import Rel8.Type.Ord ( DBMax, DBMin )

@@ -46,7 +47,7 @@ import Rel8.Type.Sum ( DBSum )

46

47

48

48count :: Expr a -> Aggregate (Expr Int64)

49count :: Expr a -> Aggregate (Expr Int64)

49−count = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

50+count = unsafeMakeAggregate toPrimExpr fromPrimExpr $

50 Just Aggregator

51 Just Aggregator

51 { operation = Opaleye.AggrCount

52 { operation = Opaleye.AggrCount

52 , ordering = []

53 , ordering = []

@@ -55,7 +56,7 @@ count = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

55

56

57

57countDistinct :: DBEq a => Expr a -> Aggregate (Expr Int64)

58countDistinct :: DBEq a => Expr a -> Aggregate (Expr Int64)

58−countDistinct = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

59+countDistinct = unsafeMakeAggregate toPrimExpr fromPrimExpr $

59 Just Aggregator

60 Just Aggregator

60 { operation = Opaleye.AggrCount

61 { operation = Opaleye.AggrCount

61 , ordering = []

62 , ordering = []

@@ -72,7 +73,7 @@ countWhere condition = count (caseExpr [(condition, litExpr (Just True))] null)

72

73

74

74and :: Expr Bool -> Aggregate (Expr Bool)

75and :: Expr Bool -> Aggregate (Expr Bool)

75−and = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

76+and = unsafeMakeAggregate toPrimExpr fromPrimExpr $

76 Just Aggregator

77 Just Aggregator

77 { operation = Opaleye.AggrBoolAnd

78 { operation = Opaleye.AggrBoolAnd

78 , ordering = []

79 , ordering = []

@@ -81,7 +82,7 @@ and = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

81

82

83

83or :: Expr Bool -> Aggregate (Expr Bool)

84or :: Expr Bool -> Aggregate (Expr Bool)

84−or = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

85+or = unsafeMakeAggregate toPrimExpr fromPrimExpr $

85 Just Aggregator

86 Just Aggregator

86 { operation = Opaleye.AggrBoolOr

87 { operation = Opaleye.AggrBoolOr

87 , ordering = []

88 , ordering = []

@@ -90,7 +91,7 @@ or = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

90

91

92

92max :: (DBMax db, Nullabilizes db a) => Expr a -> Aggregate (Expr a)

93max :: (DBMax db, Nullabilizes db a) => Expr a -> Aggregate (Expr a)

93−max = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

94+max = unsafeMakeAggregate toPrimExpr fromPrimExpr $

94 Just Aggregator

95 Just Aggregator

95 { operation = Opaleye.AggrSum

96 { operation = Opaleye.AggrSum

96 , ordering = []

97 , ordering = []

@@ -99,7 +100,7 @@ max = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

99

100

101

101min :: (DBMin db, Nullabilizes db a) => Expr a -> Aggregate (Expr a)

102min :: (DBMin db, Nullabilizes db a) => Expr a -> Aggregate (Expr a)

102−min = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

103+min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

103 Just Aggregator

104 Just Aggregator

104 { operation = Opaleye.AggrSum

105 { operation = Opaleye.AggrSum

105 , ordering = []

106 , ordering = []

@@ -108,7 +109,7 @@ min = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

108

109

110

110sum :: (DBSum db, Nullabilizes db a) => Expr a -> Aggregate (Expr a)

111sum :: (DBSum db, Nullabilizes db a) => Expr a -> Aggregate (Expr a)

111−sum = unsafeMakeAggregate unsafeToPrimExpr (castExpr . unsafeFromPrimExpr) $

112+sum = unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

112 Just Aggregator

113 Just Aggregator

113 { operation = Opaleye.AggrSum

114 { operation = Opaleye.AggrSum

114 , ordering = []

115 , ordering = []

@@ -124,9 +125,9 @@ sumWhere condition a = sum (caseExpr [(condition, a)] 0)

124stringAgg :: (DBString db, Nullabilizes db a)

125stringAgg :: (DBString db, Nullabilizes db a)

125 => Expr db -> Expr a -> Aggregate (Expr a)

126 => Expr db -> Expr a -> Aggregate (Expr a)

126stringAgg delimiter =

127stringAgg delimiter =

127− unsafeMakeAggregate unsafeToPrimExpr (castExpr . unsafeFromPrimExpr) $

128+ unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

128 Just Aggregator

129 Just Aggregator

129− { operation = Opaleye.AggrStringAggr (unsafeToPrimExpr delimiter)

130+ { operation = Opaleye.AggrStringAggr (toPrimExpr delimiter)

130 , ordering = []

131 , ordering = []

131 , distinction = Opaleye.AggrAll

132 , distinction = Opaleye.AggrAll

132 }

133 }

@@ -137,22 +138,26 @@ groupByExpr = sgroupByExpr nullabilization

137

138

139

139listAggExpr :: Expr a -> Aggregate (Expr [a])

140listAggExpr :: Expr a -> Aggregate (Expr [a])

140−listAggExpr = unsafeMakeAggregate unsafeToPrimExpr fromPrimExpr $ Just

141+listAggExpr = unsafeMakeAggregate toPrimExpr from $ Just

141 Aggregator

142 Aggregator

142 { operation = Opaleye.AggrArr

143 { operation = Opaleye.AggrArr

143 , ordering = []

144 , ordering = []

144 , distinction = Opaleye.AggrAll

145 , distinction = Opaleye.AggrAll

145 }

146 }

147+ where

148+ from = fromPrimExpr . fromPrimArray

146

149

147

150

148nonEmptyAggExpr :: Expr a -> Aggregate (Expr (NonEmpty a))

151nonEmptyAggExpr :: Expr a -> Aggregate (Expr (NonEmpty a))

149−nonEmptyAggExpr = unsafeMakeAggregate unsafeToPrimExpr fromPrimExpr $ Just

152+nonEmptyAggExpr = unsafeMakeAggregate toPrimExpr from $ Just

150 Aggregator

153 Aggregator

151 { operation = Opaleye.AggrArr

154 { operation = Opaleye.AggrArr

152 , ordering = []

155 , ordering = []

153 , distinction = Opaleye.AggrAll

156 , distinction = Opaleye.AggrAll

154 }

157 }

158+ where

159+ from = fromPrimExpr . fromPrimArray

155

160

156

161

157sgroupByExpr :: DBEq db => Nullability db a -> Expr a -> Aggregate (Expr a)

162sgroupByExpr :: DBEq db => Nullability db a -> Expr a -> Aggregate (Expr a)

158−sgroupByExpr _ = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr Nothing

163+sgroupByExpr _ = unsafeMakeAggregate toPrimExpr fromPrimExpr Nothing

src/Rel8/Expr/Array.hs+7−13

@@ -22,38 +22,32 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

22-- rel8

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

24import Rel8.Expr.Opaleye

25− ( unsafeFromPrimExpr, unsafeToPrimExpr

25+ ( fromPrimExpr, toPrimExpr

26 , zipPrimExprsWith

27 )

28import Rel8.Type ( DBType, typeInformation )

29−import Rel8.Type.Array ( array )

29+import Rel8.Type.Array ( array, zipPrimArraysWith )

30import Rel8.Type.Information ( TypeInformation(..) )

31import Rel8.Schema.Nullability ( Nullability, Nullabilizes )

32

33

34sappend :: Expr [a] -> Expr [a] -> Expr [a]

35−sappend = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))

35+sappend = zipPrimExprsWith (zipPrimArraysWith (Opaleye.BinExpr (Opaleye.:||)))

36

37

38sappend1 :: Expr (NonEmpty a) -> Expr (NonEmpty a) -> Expr (NonEmpty a)

39−sappend1 = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))

39+sappend1 = zipPrimExprsWith (zipPrimArraysWith (Opaleye.BinExpr (Opaleye.:||)))

40

41

42sempty :: Nullability t a -> TypeInformation t -> Expr [a]

43−sempty _ info = unsafeFromPrimExpr $ array info []

43+sempty _ info = fromPrimExpr $ array info []

44

45

46listOf :: forall a t. (Nullabilizes t a, DBType t)

47 => [Expr a] -> Expr [a]

48−listOf =

49− unsafeFromPrimExpr .

50− array (typeInformation @t) .

48+listOf = fromPrimExpr . array (typeInformation @t) . fmap toPrimExpr

51− fmap unsafeToPrimExpr

52

49

53

50

54nonEmptyOf :: forall a t. (Nullabilizes t a, DBType t)

51nonEmptyOf :: forall a t. (Nullabilizes t a, DBType t)

55 => NonEmpty (Expr a) -> Expr (NonEmpty a)

52 => NonEmpty (Expr a) -> Expr (NonEmpty a)

56−nonEmptyOf =

57− unsafeFromPrimExpr .

58− array (typeInformation @t) .

53+nonEmptyOf = fromPrimExpr . array (typeInformation @t) . fmap toPrimExpr

59− fmap unsafeToPrimExpr

src/Rel8/Expr/Eq.hs+6−9

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

24import Rel8.Expr ( Expr )

25import Rel8.Expr.Bool ( (&&.), (||.), false, or_, coalesce )

26import Rel8.Expr.Null ( isNull, unsafeLiftOpNullable )

27−import Rel8.Expr.Opaleye

27+import Rel8.Expr.Opaleye ( fromPrimExpr, toPrimExpr, zipPrimExprsWith )

28− ( unsafeFromPrimExpr, unsafeToPrimExpr

29− , unsafeZipPrimExprsWith

30− )

31import Rel8.Schema.Nullability

28import Rel8.Schema.Nullability

32 ( Nullability( NonNullable, Nullable )

29 ( Nullability( NonNullable, Nullable )

33 , Nullabilizes, nullabilization

30 , Nullabilizes, nullabilization

@@ -36,11 +33,11 @@ import Rel8.Type.Eq ( DBEq )

36

33

37

34

38eq :: DBEq a => Expr a -> Expr a -> Expr Bool

35eq :: DBEq a => Expr a -> Expr a -> Expr Bool

39−eq = unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.:==))

36+eq = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:==))

40

37

41

38

42ne :: DBEq a => Expr a -> Expr a -> Expr Bool

39ne :: DBEq a => Expr a -> Expr a -> Expr Bool

43−ne = unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<>))

40+ne = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<>))

44

41

45

42

46seq :: DBEq db => Nullability db a -> Expr a -> Expr a -> Expr Bool

43seq :: DBEq db => Nullability db a -> Expr a -> Expr a -> Expr Bool

@@ -62,10 +59,10 @@ sin nullability (toList -> as) a = case nullability of

62 NonNullable -> case nonEmpty as of

59 NonNullable -> case nonEmpty as of

63 Nothing -> false

60 Nothing -> false

64 Just xs ->

61 Just xs ->

65− unsafeFromPrimExpr $

62+ fromPrimExpr $

66 Opaleye.BinExpr Opaleye.OpIn

63 Opaleye.BinExpr Opaleye.OpIn

67− (unsafeToPrimExpr a)

64+ (toPrimExpr a)

68− (Opaleye.ListExpr (unsafeToPrimExpr <$> xs))

65+ (Opaleye.ListExpr (toPrimExpr <$> xs))

69

66

70

67

71(==.) :: (DBEq db, Nullabilizes db a) => Expr a -> Expr a -> Expr Bool

68(==.) :: (DBEq db, Nullabilizes db a) => Expr a -> Expr a -> Expr Bool

src/Rel8/Expr/Function.hs+3−27

@@ -9,7 +9,6 @@ module Rel8.Expr.Function

9 ( Function, function

10 , nullaryFunction

11 , binaryOperator

12− , unsafeBinaryOperator

13 )

12 )

14where

13where

15

14

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

25import Rel8.Expr.Opaleye

24import Rel8.Expr.Opaleye

26 ( castExpr

25 ( castExpr

27 , fromPrimExpr, toPrimExpr, zipPrimExprsWith

26 , fromPrimExpr, toPrimExpr, zipPrimExprsWith

28− , unsafeZipPrimExprsWith

29 )

27 )

30−import Rel8.Kind.Bool ( KnownBool, IsList )

31import Rel8.Schema.Nullability ( Nullabilizes )

28import Rel8.Schema.Nullability ( Nullabilizes )

32import Rel8.Type ( DBType )

29import Rel8.Type ( DBType )

33

30

@@ -37,23 +34,12 @@ class Function arg res where

37 applyArgument :: ([Opaleye.PrimExpr] -> Opaleye.PrimExpr) -> arg -> res

34 applyArgument :: ([Opaleye.PrimExpr] -> Opaleye.PrimExpr) -> arg -> res

38

35

39

36

40−instance

41− ( arg ~ Expr a

42− , Nullabilizes _a a, KnownBool (IsList _a)

43− , DBType _b, Nullabilizes _b b, KnownBool (IsList _b)

44− )

45− => Function arg (Expr b)

37+instance (arg ~ Expr a, DBType db, Nullabilizes db b) => Function arg (Expr b)

46 where

38 where

47 applyArgument f a = castExpr $ fromPrimExpr $ f [toPrimExpr a]

39 applyArgument f a = castExpr $ fromPrimExpr $ f [toPrimExpr a]

48

40

49

41

50−instance

51− ( arg ~ Expr a

52− , Nullabilizes _a a, KnownBool (IsList _a)

53− , Function args res

54− ) =>

55− Function arg (args -> res)

42+instance (arg ~ Expr a, Function args res) => Function arg (args -> res) where

56− where

57 applyArgument f a = applyArgument (f . (toPrimExpr a :))

43 applyArgument f a = applyArgument (f . (toPrimExpr a :))

58

44

59

45

@@ -65,17 +51,7 @@ nullaryFunction :: (DBType db, Nullabilizes db a) => String -> Expr a

65nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])

51nullaryFunction name = castExpr $ Expr (Opaleye.FunExpr name [])

66

52

67

53

68−binaryOperator ::

54+binaryOperator :: (DBType db, Nullabilizes db c)

69− ( Nullabilizes _a a, KnownBool (IsList _a)

70− , Nullabilizes _b b, KnownBool (IsList _b)

71− , DBType _c, Nullabilizes _c c, KnownBool (IsList _c)

72− )

73 => String -> Expr a -> Expr b -> Expr c

55 => String -> Expr a -> Expr b -> Expr c

74binaryOperator operator a b =

56binaryOperator operator a b =

75 castExpr $ zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther operator)) a b

57 castExpr $ zipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther operator)) a b

76−

77−

78−unsafeBinaryOperator :: (DBType _c, Nullabilizes _c c)

79− => String -> Expr a -> Expr b -> Expr c

80−unsafeBinaryOperator operator a b =

81− castExpr $ unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.OpOther operator)) a b

src/Rel8/Expr/Null.hs+3−3

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

22-- rel8

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

24import Rel8.Expr.Bool ( (||.), boolExpr )

25−import Rel8.Expr.Opaleye ( scastExpr, unsafeMapPrimExpr )

25+import Rel8.Expr.Opaleye ( scastExpr, mapPrimExpr )

26import Rel8.Schema.Nullability ( Nullability( Nullable ), IsMaybe )

27import Rel8.Type ( DBType, typeInformation )

28import Rel8.Type.Information ( TypeInformation )

@@ -46,11 +46,11 @@ nullableOf = maybe null nullify

46

47

48isNull :: Expr (Maybe a) -> Expr Bool

49−isNull = unsafeMapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNull)

49+isNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNull)

50

51

52isNonNull :: Expr (Maybe a) -> Expr Bool

53−isNonNull = unsafeMapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNotNull)

53+isNonNull = mapPrimExpr (Opaleye.UnExpr Opaleye.OpIsNotNull)

54

55

56mapNullable :: (IsMaybe b ~ 'False, DBType b)

src/Rel8/Expr/Opaleye.hs+12−74

@@ -11,10 +11,7 @@ module Rel8.Expr.Opaleye

11 ( castExpr, unsafeCastExpr

12 , scastExpr, sunsafeCastExpr

13 , unsafeLiteral

14− , unsafeFromPrimExpr, unsafeToPrimExpr, unsafeMapPrimExpr

15− , unsafeZipPrimExprsWith, unsafeTraversePrimExpr

16− , sfromPrimExpr, stoPrimExpr

17− , fromPrimExpr, toPrimExpr, mapPrimExpr, zipPrimExprsWith

14+ , fromPrimExpr, toPrimExpr, mapPrimExpr, zipPrimExprsWith, traversePrimExpr

18 , toColumn, fromColumn

15 , toColumn, fromColumn

19 )

16 )

20where

17where

@@ -28,7 +25,6 @@ import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

28

25

29-- rel8

26-- rel8

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

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

31−import Rel8.Kind.Bool ( SBool( SFalse, STrue ), KnownBool, boolSing, IsList )

32import Rel8.Schema.Nullability ( Nullability, Nullabilizes, nullabilization )

28import Rel8.Schema.Nullability ( Nullability, Nullabilizes, nullabilization )

33import Rel8.Type ( DBType, typeInformation )

29import Rel8.Type ( DBType, typeInformation )

34import Rel8.Type.Information ( TypeInformation(..) )

30import Rel8.Type.Information ( TypeInformation(..) )

@@ -49,92 +45,34 @@ scastExpr = sunsafeCastExpr

49sunsafeCastExpr :: ()

45sunsafeCastExpr :: ()

50 => Nullability db b -> TypeInformation db -> Expr a -> Expr b

46 => Nullability db b -> TypeInformation db -> Expr a -> Expr b

51sunsafeCastExpr _ TypeInformation {typeName} =

47sunsafeCastExpr _ TypeInformation {typeName} =

52− Expr . Opaleye.CastExpr typeName . unsafeToPrimExpr

48+ fromPrimExpr . Opaleye.CastExpr typeName . toPrimExpr

53

49

54

50

55unsafeLiteral :: (DBType db, Nullabilizes db a) => String -> Expr a

51unsafeLiteral :: (DBType db, Nullabilizes db a) => String -> Expr a

56unsafeLiteral = castExpr . Expr . Opaleye.ConstExpr . Opaleye.OtherLit

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

57

53

58

54

59−unsafeFromPrimExpr :: Opaleye.PrimExpr -> Expr a

55+fromPrimExpr :: Opaleye.PrimExpr -> Expr a

60−unsafeFromPrimExpr = Expr

56+fromPrimExpr = Expr

61

57

62

58

63−unsafeToPrimExpr :: Expr a -> Opaleye.PrimExpr

59+toPrimExpr :: Expr a -> Opaleye.PrimExpr

64−unsafeToPrimExpr (Expr a) = a

60+toPrimExpr (Expr a) = a

65

61

66

62

67−unsafeMapPrimExpr :: ()

68− => (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Expr a -> Expr b

63+mapPrimExpr :: (Opaleye.PrimExpr -> Opaleye.PrimExpr) -> Expr a -> Expr b

69−unsafeMapPrimExpr f = unsafeFromPrimExpr . f . unsafeToPrimExpr

64+mapPrimExpr f = fromPrimExpr . f . toPrimExpr

70

65

71

66

72−unsafeZipPrimExprsWith :: ()

67+zipPrimExprsWith :: ()

73 => (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)

68 => (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)

74 -> Expr a -> Expr b -> Expr c

69 -> Expr a -> Expr b -> Expr c

75−unsafeZipPrimExprsWith f a b =

70+zipPrimExprsWith f a b = fromPrimExpr (f (toPrimExpr a) (toPrimExpr b))

76− unsafeFromPrimExpr (f (unsafeToPrimExpr a) (unsafeToPrimExpr b))

77

71

78

72

79−unsafeTraversePrimExpr :: Functor f

73+traversePrimExpr :: Functor f

80 => (Opaleye.PrimExpr -> f Opaleye.PrimExpr) -> Expr a -> f (Expr b)

74 => (Opaleye.PrimExpr -> f Opaleye.PrimExpr) -> Expr a -> f (Expr b)

81−unsafeTraversePrimExpr f = fmap unsafeFromPrimExpr . f . unsafeToPrimExpr

82−

83−

84−fromPrimExpr ::

85− ( KnownBool (IsList _a), Nullabilizes _a a

86− )

87− => Opaleye.PrimExpr -> Expr a

88−fromPrimExpr = sfromPrimExpr nullabilization boolSing

89−

90−

91−toPrimExpr ::

92− ( KnownBool (IsList _a), Nullabilizes _a a

93− )

94− => Expr a -> Opaleye.PrimExpr

95−toPrimExpr = stoPrimExpr nullabilization boolSing

96−

97−

98−sfromPrimExpr :: ()

99− => Nullability _a a -> SBool (IsList _a) -> Opaleye.PrimExpr -> Expr a

100−sfromPrimExpr _ = \case

101− SFalse -> unsafeFromPrimExpr

102− STrue -> \a -> Expr $

103− Opaleye.CaseExpr

104− [ (Opaleye.UnExpr Opaleye.OpIsNull a, Opaleye.ConstExpr Opaleye.NullLit)

105− ]

106− (Opaleye.UnExpr (Opaleye.UnOpOther "ROW") a)

107−

108−

109−stoPrimExpr :: ()

110− => Nullability _a a -> SBool (IsList _a) -> Expr a -> Opaleye.PrimExpr

111−stoPrimExpr _ = \case

112− SFalse -> unsafeToPrimExpr

113− STrue -> \(Expr a) ->

114− Opaleye.CaseExpr

115− [ (Opaleye.UnExpr Opaleye.OpIsNull a, Opaleye.ConstExpr Opaleye.NullLit)

116− ]

117− -- Requires at least Postgres 13

118− (Opaleye.CompositeExpr a "f1")

119−

120−

121−mapPrimExpr ::

122− ( KnownBool (IsList _a), Nullabilizes _a a

123− , KnownBool (IsList _b), Nullabilizes _b b

124− )

125− => (Opaleye.PrimExpr -> Opaleye.PrimExpr)

126− -> Expr a -> Expr b

127−mapPrimExpr f = fromPrimExpr . f . toPrimExpr

75+traversePrimExpr f = fmap fromPrimExpr . f . toPrimExpr

128−

129−

130−zipPrimExprsWith ::

131− ( KnownBool (IsList _a), Nullabilizes _a a

132− , KnownBool (IsList _b), Nullabilizes _b b

133− , KnownBool (IsList _c), Nullabilizes _c c

134− )

135− => (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)

136− -> Expr a -> Expr b -> Expr c

137−zipPrimExprsWith f a b = fromPrimExpr (f (toPrimExpr a) (toPrimExpr b))

138

76

139

77

140toColumn :: Opaleye.PrimExpr -> Opaleye.Column b

78toColumn :: Opaleye.PrimExpr -> Opaleye.Column b

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

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

24import Rel8.Expr ( Expr( Expr ) )

25import Rel8.Expr.Bool ( (&&.), (||.), coalesce )

26import Rel8.Expr.Null ( isNull, isNonNull, nullable, unsafeLiftOpNullable )

27−import Rel8.Expr.Opaleye ( unsafeZipPrimExprsWith )

27+import Rel8.Expr.Opaleye ( zipPrimExprsWith )

28import Rel8.Schema.Nullability

29 ( Nullability( NonNullable, Nullable )

30 , Nullabilizes, nullabilization

@@ -33,19 +33,19 @@ import Rel8.Type.Ord ( DBOrd )

33

34

35lt :: DBOrd a => Expr a -> Expr a -> Expr Bool

36−lt = unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<))

36+lt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<))

37

38

39le :: DBOrd a => Expr a -> Expr a -> Expr Bool

40−le = unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<=))

40+le = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<=))

41

42

43gt :: DBOrd a => Expr a -> Expr a -> Expr Bool

44−gt = unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>))

44+gt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>))

45

46

47ge :: DBOrd a => Expr a -> Expr a -> Expr Bool

48−ge = unsafeZipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>=))

48+ge = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>=))

49

50

51slt :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool

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

@@ -22,13 +22,13 @@ import qualified Opaleye.Internal.Order as Opaleye

22-- rel8

23import Rel8.Expr ( Expr )

24import Rel8.Expr.Null ( unsafeUnnullify )

25−import Rel8.Expr.Opaleye ( unsafeToPrimExpr )

25+import Rel8.Expr.Opaleye ( toPrimExpr )

26import Rel8.Order ( Order( Order ) )

27import Rel8.Type.Ord ( DBOrd )

28

29

30asc :: DBOrd a => Order (Expr a)

31−asc = Order $ Opaleye.Order (\expr -> [(orderOp, unsafeToPrimExpr expr)])

31+asc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

32 where

33 orderOp :: Opaleye.OrderOp

34 orderOp = Opaleye.OrderOp

@@ -38,7 +38,7 @@ asc = Order $ Opaleye.Order (\expr -> [(orderOp, unsafeToPrimExpr expr)])

38

39

40desc :: DBOrd a => Order (Expr a)

41−desc = Order $ Opaleye.Order (\expr -> [(orderOp, unsafeToPrimExpr expr)])

41+desc = Order $ Opaleye.Order (\expr -> [(orderOp, toPrimExpr expr)])

42 where

43 orderOp :: Opaleye.OrderOp

44 orderOp = Opaleye.OrderOp

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

@@ -23,7 +23,6 @@ where

23-- base

24import Data.Bool ( Bool )

25import Data.Int ( Int32 )

26−import Data.List.NonEmpty ( NonEmpty )

27import Data.Maybe ( Maybe( Nothing, Just ) )

26import Data.Maybe ( Maybe( Nothing, Just ) )

28import Prelude ()

27import Prelude ()

29

28

@@ -33,6 +32,7 @@ import Data.ByteString ( ByteString )

33-- rel8

32-- rel8

34import Rel8.Expr ( Expr )

33import Rel8.Expr ( Expr )

35import Rel8.Expr.Function ( binaryOperator, function, nullaryFunction )

34import Rel8.Expr.Function ( binaryOperator, function, nullaryFunction )

35+import Rel8.Type.Array1D ( Array1D )

36

37-- text

38import Data.Text (Text)

@@ -185,7 +185,7 @@ regexpReplace a b c Nothing = function "regexp_replace" a b c

185

186

187regexpSplitToArray :: ()

188− => Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr (NonEmpty Text)

188+ => Expr Text -> Expr Text -> Maybe (Expr Text) -> Expr (Array1D Text)

189regexpSplitToArray a b (Just c) = function "regexp_split_to_array" a b c

190regexpSplitToArray a b Nothing = function "regexp_split_to_array" a b

191

src/Rel8/Kind/Bool.hsdeleted−43

@@ -1,43 +0,0 @@

1−{-# language DataKinds #-}

2−{-# language GADTs #-}

3−{-# language StandaloneKindSignatures #-}

4−{-# language TypeFamilies #-}

5−

6−module Rel8.Kind.Bool

7− ( Bool( False, True )

8− , SBool ( SFalse, STrue )

9− , KnownBool( boolSing )

10− , IsList

11− )

12−where

13−

14−-- base

15−import Data.Kind ( Constraint, Type )

16−import Data.List.NonEmpty ( NonEmpty )

17−import Prelude

18−

19−

20−type SBool :: Bool -> Type

21−data SBool bool where

22− SFalse :: SBool 'False

23− STrue :: SBool 'True

24−

25−

26−type KnownBool :: Bool -> Constraint

27−class KnownBool bool where

28− boolSing :: SBool bool

29−

30−

31−instance KnownBool 'False where

32− boolSing = SFalse

33−

34−

35−instance KnownBool 'True where

36− boolSing = STrue

37−

38−

39−type IsList :: Type -> Bool

40−type family IsList a where

41− IsList [_] = 'True

42− IsList (NonEmpty _) = 'True

43− IsList _ = 'False

src/Rel8/Query/Maybe.hs+2−2

@@ -19,7 +19,7 @@ import qualified Opaleye.Internal.Unpackspec as Opaleye

19-- rel8

20import Rel8.Expr.Bool ( true )

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

22−import Rel8.Expr.Opaleye ( unsafeToPrimExpr )

22+import Rel8.Expr.Opaleye ( toPrimExpr )

23import Rel8.Query ( Query )

24import Rel8.Query.Filter ( where_ )

25import Rel8.Query.Opaleye ( mapOpaleye )

@@ -37,7 +37,7 @@ optional = mapOpaleye $ Opaleye.QueryArr . go

37 (t', bindings) = Opaleye.run $

38 Opaleye.runUnpackspec unpackspec (Opaleye.extractAttr "maybe" tag') t

39 join = Opaleye.Join Opaleye.LeftJoin condition [] bindings left right

40− condition = unsafeToPrimExpr true

40+ condition = toPrimExpr true

41

42

43catMaybeTable :: MaybeTable a -> Query a

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

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

23import qualified Opaleye.Internal.Sql as Opaleye

24

25-- rel8

26−import Rel8.Expr.Opaleye ( unsafeToPrimExpr )

26+import Rel8.Expr.Opaleye ( toPrimExpr )

27import Rel8.Query ( Query )

28import Rel8.Query.Opaleye ( toOpaleye )

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

@@ -67,6 +67,6 @@ selectFrom (toColumns -> names) (toColumns -> exprs) query =

67 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query

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

69 Name name -> case hfield exprs field of

70− DB (unsafeToPrimExpr -> expr) -> Const (pure (makeAttr name expr))

70+ DB (toPrimExpr -> expr) -> Const (pure (makeAttr name expr))

71 makeAttr label expr =

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

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

@@ -32,7 +32,7 @@ import Rel8.Expr ( Expr( Expr ) )

32import Rel8.Expr.Aggregate ( groupByExpr )

33import Rel8.Expr.Bool ( boolExpr )

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

35−import Rel8.Expr.Opaleye ( unsafeFromPrimExpr, unsafeToPrimExpr )

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

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

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

38import Rel8.Schema.Context

@@ -78,7 +78,7 @@ instance Nullifiable Aggregation where

78 decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate

79

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

81− mapInputs (unsafeToPrimExpr . runTag nullability tag . unsafeFromPrimExpr) $

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

82 runTag nullability tag <$> aggregate

83

84 unnullifier _ SSpec {nullability} (Aggregation aggregate) =

src/Rel8/Schema/HTable/Type.hs+1−5

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

15import Prelude

16

17-- rel8

18−import Rel8.Kind.Bool ( KnownBool, boolSing, IsList )

19import Rel8.Kind.Labels ( SLabels( SLabel ) )

18import Rel8.Kind.Labels ( SLabels( SLabel ) )

20import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )

19import Rel8.Kind.Necessity ( Necessity( Required ), SNecessity( SRequired ) )

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

20import Rel8.Schema.Dict ( Dict( Dict ) )

@@ -41,9 +40,7 @@ data HTypeField a spec where

41 HTypeField :: HTypeField a ('Spec '[""] 'Required (Unnullify a) a)

40 HTypeField :: HTypeField a ('Spec '[""] 'Required (Unnullify a) a)

42

41

43

42

44−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

43+instance (DBType db, Nullabilizes db a) => HTable (HType a) where

45− HTable (HType a)

46− where

47 type HConstrainTable (HType a) c = c ('Spec '[""] 'Required (Unnullify a) a)

44 type HConstrainTable (HType a) c = c ('Spec '[""] 'Required (Unnullify a) a)

48 type HField (HType a) = HTypeField a

45 type HField (HType a) = HTypeField a

49

46

@@ -56,5 +53,4 @@ instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

56 , necessity = SRequired

53 , necessity = SRequired

57 , info = typeInformation

54 , info = typeInformation

58 , nullability = nullabilization

55 , nullability = nullabilization

59− , isList = boolSing

60 }

56 }

src/Rel8/Schema/HTable/Vectorize.hs+6−12

@@ -32,7 +32,6 @@ import Data.Type.Equality ( (:~:)( Refl ) )

32import Prelude

33

34-- rel8

35−import Rel8.Kind.Bool ( IsList, SBool( STrue ) )

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

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

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

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

38import Rel8.Schema.HTable

37import Rel8.Schema.HTable

@@ -50,7 +49,6 @@ import Data.Zip ( Unzip, Repeat, Zippy(..) )

50

49

51

50

52class Vector list where

51class Vector list where

53− listIsList :: proxy a -> IsList (list a) :~: 'True

54 listIsn'tMaybe :: proxy a -> IsMaybe (list a) :~: 'False

52 listIsn'tMaybe :: proxy a -> IsMaybe (list a) :~: 'False

55 vectorTypeInformation :: ()

53 vectorTypeInformation :: ()

56 => Nullability a ma

54 => Nullability a ma

@@ -59,13 +57,11 @@ class Vector list where

59

57

60

58

61instance Vector [] where

59instance Vector [] where

62− listIsList _ = Refl

63 listIsn'tMaybe _ = Refl

60 listIsn'tMaybe _ = Refl

64 vectorTypeInformation = listTypeInformation

61 vectorTypeInformation = listTypeInformation

65

62

66

63

67instance Vector NonEmpty where

64instance Vector NonEmpty where

68− listIsList _ = Refl

69 listIsn'tMaybe _ = Refl

65 listIsn'tMaybe _ = Refl

70 vectorTypeInformation = nonEmptyTypeInformation

66 vectorTypeInformation = nonEmptyTypeInformation

71

67

@@ -104,14 +100,12 @@ instance (HTable table, Vector list) => HTable (HVectorize list table) where

104 Dict -> VectorizeSpec Dict

100 Dict -> VectorizeSpec Dict

105

101

106 hspecs = HVectorize $ htabulate $ \field -> case hfield hspecs field of

102 hspecs = HVectorize $ htabulate $ \field -> case hfield hspecs field of

107− SSpec {..} -> case listIsList @list nullability of

108− Refl -> case listIsn'tMaybe @list nullability of

103+ SSpec {..} -> case listIsn'tMaybe @list nullability of

109− Refl -> VectorizeSpec SSpec

104+ Refl -> VectorizeSpec SSpec

110− { nullability = NonNullable

105+ { nullability = NonNullable

111− , info = vectorTypeInformation nullability info

106+ , info = vectorTypeInformation nullability info

112− , isList = STrue

113− , ..

107+ , ..

114− }

108+ }

115

109

116 {-# INLINABLE hfield #-}

110 {-# INLINABLE hfield #-}

117 {-# INLINABLE htabulate #-}

111 {-# INLINABLE htabulate #-}

src/Rel8/Schema/Spec.hs+1−5

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

6

7module Rel8.Schema.Spec

8 ( Spec( Spec )

9− , SSpec( SSpec, labels, necessity, info, nullability, isList )

9+ , SSpec( SSpec, labels, necessity, info, nullability )

10 , KnownSpec( specSing )

11 , Context, KTable

12 )

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

17import Prelude ()

18

19-- rel8

20−import Rel8.Kind.Bool ( SBool, KnownBool, boolSing, IsList )

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

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

22import Rel8.Kind.Necessity

21import Rel8.Kind.Necessity

23 ( Necessity

22 ( Necessity

@@ -40,7 +39,6 @@ data SSpec spec where

40 , necessity :: SNecessity necessity

39 , necessity :: SNecessity necessity

41 , info :: TypeInformation db

40 , info :: TypeInformation db

42 , nullability :: Nullability db a

41 , nullability :: Nullability db a

43− , isList :: SBool (IsList db)

44 }

42 }

45 -> SSpec ('Spec labels necessity db a)

43 -> SSpec ('Spec labels necessity db a)

46

44

@@ -55,7 +53,6 @@ instance

55 , KnownNecessity necessity

53 , KnownNecessity necessity

56 , DBType db

54 , DBType db

57 , Nullabilizes db a

55 , Nullabilizes db a

58− , KnownBool (IsList db)

59 ) => KnownSpec ('Spec labels necessity db a)

56 ) => KnownSpec ('Spec labels necessity db a)

60 where

57 where

61 specSing = SSpec

58 specSing = SSpec

@@ -63,7 +60,6 @@ instance

63 , necessity = necessitySing

60 , necessity = necessitySing

64 , info = typeInformation

61 , info = typeInformation

65 , nullability = nullabilization

62 , nullability = nullabilization

66− , isList = boolSing

67 }

63 }

68

64

69

65

src/Rel8/Table.hs+2−15

@@ -22,7 +22,6 @@ import Prelude

22-- rel8

23import Rel8.Aggregate ( Aggregate )

24import Rel8.Expr ( Expr )

25−import Rel8.Kind.Bool ( KnownBool, IsList )

26import Rel8.Opaque ( Opaque, Opaque1 )

25import Rel8.Opaque ( Opaque, Opaque1 )

27import Rel8.Schema.Context

26import Rel8.Schema.Context

28 ( Aggregation( Aggregation )

27 ( Aggregation( Aggregation )

@@ -83,13 +82,7 @@ instance Table DB a => Table Aggregation (Aggregate a) where

83 Aggregation a -> DB <$> a

82 Aggregation a -> DB <$> a

84

83

85

84

86−instance

87− ( DBType db

88− , Nullabilizes db a

85+instance (DBType db, Nullabilizes db a) => Table DB (Expr a) where

89− , KnownBool (IsList db)

90− )

91− => Table DB (Expr a)

92− where

93 type Columns (Expr a) = HType a

86 type Columns (Expr a) = HType a

94 type Context (Expr a) = DB

87 type Context (Expr a) = DB

95

88

@@ -97,13 +90,7 @@ instance

97 fromColumns (HType (DB a)) = a

90 fromColumns (HType (DB a)) = a

98

91

99

92

100−instance

101− ( DBType db

102− , Nullabilizes db a

103− , KnownBool (IsList db)

104− )

105− => Table Result (Identity a)

93+instance (DBType db, Nullabilizes db a) => Table Result (Identity a) where

106− where

107 type Columns (Identity a) = HType a

94 type Columns (Identity a) = HType a

108 type Context (Identity a) = Result

95 type Context (Identity a) = Result

109

96

src/Rel8/Table/Opaleye.hs+9−12

@@ -35,9 +35,8 @@ import Data.Profunctor ( dimap, lmap )

35import Rel8.Aggregate ( Aggregate( Aggregate ) )

36import Rel8.Expr.Opaleye

37 ( scastExpr

38− , unsafeFromPrimExpr, unsafeToPrimExpr

38+ , fromPrimExpr, toPrimExpr

39− , unsafeTraversePrimExpr

39+ , traversePrimExpr

40− , sfromPrimExpr, stoPrimExpr

41 , fromColumn, toColumn

40 , fromColumn, toColumn

42 )

41 )

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

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

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

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

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

64 WrapApplicative $

63 WrapApplicative $

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

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

66− (DB a, DB b) -> DB . unsafeFromPrimExpr <$>

65+ (DB a, DB b) -> DB . fromPrimExpr <$> f (toPrimExpr a, toPrimExpr b)

67− f (unsafeToPrimExpr a, unsafeToPrimExpr b)

68

66

69

67

70distinctspec :: Table DB a => Opaleye.Distinctspec a a

68distinctspec :: Table DB a => Opaleye.Distinctspec a a

@@ -72,7 +70,9 @@ distinctspec =

72 Opaleye.Distinctspec $ Opaleye.Aggregator $ Opaleye.PackMap $ \f ->

70 Opaleye.Distinctspec $ Opaleye.Aggregator $ Opaleye.PackMap $ \f ->

73 fmap fromColumns .

71 fmap fromColumns .

74 unwrapApplicative .

72 unwrapApplicative .

73+ htraverse

74+ (\(DB a) ->

75− htraverse (\(DB a) -> WrapApplicative $ DB . unsafeFromPrimExpr <$> f (Nothing, unsafeToPrimExpr a)) .

75+ WrapApplicative $ DB . fromPrimExpr <$> f (Nothing, toPrimExpr a)) .

76 toColumns

77

78

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

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

96 where

97 go :: SSpec spec -> Name spec -> Opaleye.TableFields (Insertion spec) (DB spec)

98− go SSpec {necessity, info, nullability, isList} (Name name) =

98+ go SSpec {necessity, info, nullability} (Name name) =

99 case necessity of

100 SRequired ->

101 lmap (\(RequiredInsert a) -> toColumn $ toPrimExpr a) $

@@ -105,16 +105,13 @@ tableFields (toColumns -> names) = dimap toColumns fromColumns $

105 lmap (\(OptionalInsert ma) -> toColumn . toPrimExpr <$> ma) $

106 DB . scastExpr nullability info . fromPrimExpr . fromColumn <$>

107 Opaleye.optionalTableField name

108− where

109− fromPrimExpr = sfromPrimExpr nullability isList

110− toPrimExpr = stoPrimExpr nullability isList

111

108

112

109

113unpackspec :: Table DB a => Opaleye.Unpackspec a a

110unpackspec :: Table DB a => Opaleye.Unpackspec a a

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

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

115 fmap fromColumns .

112 fmap fromColumns .

116 unwrapApplicative .

113 unwrapApplicative .

117− htraverse (\(DB a) -> WrapApplicative $ DB <$> unsafeTraversePrimExpr f a) .

114+ htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) .

118 toColumns

115 toColumns

119{-# INLINABLE unpackspec #-}

116{-# INLINABLE unpackspec #-}

120

117

@@ -128,5 +125,5 @@ toPackMap :: Table DB a

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

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

129 fmap fromColumns $

126 fmap fromColumns $

130 unwrapApplicative .

127 unwrapApplicative .

131− htraverse (\(DB a) -> WrapApplicative $ DB <$> unsafeTraversePrimExpr f a) $

128+ htraverse (\(DB a) -> WrapApplicative $ DB <$> traversePrimExpr f a) $

132 toColumns as

129 toColumns as

src/Rel8/Table/Recontextualize.hs+9−10

@@ -24,7 +24,6 @@ import Prelude ()

24-- rel8

25import Rel8.Aggregate ( Aggregate )

26import Rel8.Expr ( Expr )

27−import Rel8.Kind.Bool ( KnownBool, IsList )

28import Rel8.Opaque ( Opaque, Opaque1 )

27import Rel8.Opaque ( Opaque, Opaque1 )

29import Rel8.Schema.Context ( Aggregation, DB, Insertion, Name, Result )

28import Rel8.Schema.Context ( Aggregation, DB, Insertion, Name, Result )

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

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

@@ -52,39 +51,39 @@ class

52 , b from -> a

51 , b from -> a

53

52

54

53

55−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

54+instance (DBType db, Nullabilizes db a) =>

56 Recontextualize Aggregation Aggregation (Aggregate (Expr a)) (Aggregate (Expr a))

55 Recontextualize Aggregation Aggregation (Aggregate (Expr a)) (Aggregate (Expr a))

57

56

58

57

59−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

58+instance (DBType db, Nullabilizes db a) =>

60 Recontextualize Aggregation DB (Aggregate (Expr a)) (Expr a)

59 Recontextualize Aggregation DB (Aggregate (Expr a)) (Expr a)

61

60

62

61

63−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

62+instance (DBType db, Nullabilizes db a) =>

64 Recontextualize Aggregation Result (Aggregate (Expr a)) (Identity a)

63 Recontextualize Aggregation Result (Aggregate (Expr a)) (Identity a)

65

64

66

65

67−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

66+instance (DBType db, Nullabilizes db a) =>

68 Recontextualize DB Aggregation (Expr a) (Aggregate (Expr a))

67 Recontextualize DB Aggregation (Expr a) (Aggregate (Expr a))

69

68

70

69

71−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

70+instance (DBType db, Nullabilizes db a) =>

72 Recontextualize DB DB (Expr a) (Expr a)

71 Recontextualize DB DB (Expr a) (Expr a)

73

72

74

73

75−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

74+instance (DBType db, Nullabilizes db a) =>

76 Recontextualize DB Result (Expr a) (Identity a)

75 Recontextualize DB Result (Expr a) (Identity a)

77

76

78

77

79−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

78+instance (DBType db, Nullabilizes db a) =>

80 Recontextualize Result Aggregation (Identity a) (Aggregate (Expr a))

79 Recontextualize Result Aggregation (Identity a) (Aggregate (Expr a))

81

80

82

81

83−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

82+instance (DBType db, Nullabilizes db a) =>

84 Recontextualize Result DB (Identity a) (Expr a)

83 Recontextualize Result DB (Identity a) (Expr a)

85

84

86

85

87−instance (DBType db, Nullabilizes db a, KnownBool (IsList db)) =>

86+instance (DBType db, Nullabilizes db a) =>

88 Recontextualize Result Result (Identity a) (Identity a)

87 Recontextualize Result Result (Identity a) (Identity a)

89

88

90

89

src/Rel8/Table/Serialize.hs−3

@@ -29,7 +29,6 @@ import qualified Hasql.Decoders as Hasql

29-- rel8

30import Rel8.Expr ( Expr )

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

32−import Rel8.Kind.Bool ( KnownBool, IsList )

33import Rel8.Opaque ( Opaque )

32import Rel8.Opaque ( Opaque )

34import Rel8.Schema.Context ( DB(..), Result(..) )

33import Rel8.Schema.Context ( DB(..), Result(..) )

35import Rel8.Schema.Context.Label ( labeler, unlabeler )

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

@@ -141,7 +140,6 @@ class (Table DB exprs, isTabular ~ IsTabular a) =>

141

140

142instance

141instance

143 ( DBType a

142 ( DBType a

144− , IsList a ~ 'False

145 , IsMaybe a ~ 'False

143 , IsMaybe a ~ 'False

146 , IsTabular a ~ 'False

144 , IsTabular a ~ 'False

147 , x ~ Expr a

145 , x ~ Expr a

@@ -166,7 +164,6 @@ instance

166instance

164instance

167 ( DBType a

165 ( DBType a

168 , Nullabilizes a (Maybe a)

166 , Nullabilizes a (Maybe a)

169− , KnownBool (IsList a)

170 , isTabular ~ 'False

167 , isTabular ~ 'False

171 , IsMaybeTabular a ~ 'False

168 , IsMaybeTabular a ~ 'False

172 , x ~ Maybe a

169 , x ~ Maybe a

src/Rel8/Type/Array.hs+16−1

@@ -6,6 +6,7 @@ module Rel8.Type.Array

6 ( array

7 , listTypeInformation

8 , nonEmptyTypeInformation

9+ , fromPrimArray, toPrimArray, zipPrimArraysWith

9 )

10 )

10where

11where

11

12

@@ -28,7 +29,7 @@ import Rel8.Type.Information ( TypeInformation(..), parseTypeInformation )

28array :: Foldable f

29array :: Foldable f

29 => TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr

30 => TypeInformation a -> f Opaleye.PrimExpr -> Opaleye.PrimExpr

30array TypeInformation {typeName} =

31array TypeInformation {typeName} =

31− Opaleye.UnExpr (Opaleye.UnOpOther "ROW") .

32+ fromPrimArray .

32 Opaleye.CastExpr (typeName <> "[]") .

33 Opaleye.CastExpr (typeName <> "[]") .

33 Opaleye.ArrayExpr . toList

34 Opaleye.ArrayExpr . toList

34

35

@@ -61,3 +62,17 @@ nonEmptyTypeInformation nullability =

61 where

62 where

62 parse = maybe (Left message) Right . nonEmpty

63 parse = maybe (Left message) Right . nonEmpty

63 message = "failed to decode NonEmptyList: got empty list"

64 message = "failed to decode NonEmptyList: got empty list"

65+

66+

67+fromPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr

68+fromPrimArray = Opaleye.UnExpr (Opaleye.UnOpOther "ROW")

69+

70+

71+toPrimArray :: Opaleye.PrimExpr -> Opaleye.PrimExpr

72+toPrimArray a = Opaleye.CompositeExpr a "f1"

73+

74+

75+zipPrimArraysWith :: ()

76+ => (Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr)

77+ -> Opaleye.PrimExpr -> Opaleye.PrimExpr -> Opaleye.PrimExpr

78+zipPrimArraysWith f a b = fromPrimArray (f (toPrimArray a) (toPrimArray b))

src/Rel8/Type/Array1D.hsnew file+133

@@ -0,0 +1,133 @@

1+{-# language DataKinds #-}

2+{-# language DeriveTraversable #-}

3+{-# language DerivingStrategies #-}

4+{-# language GeneralizedNewtypeDeriving #-}

5+{-# language NamedFieldPuns #-}

6+{-# language StandaloneKindSignatures #-}

7+{-# language TypeFamilies #-}

8+{-# language UndecidableInstances #-}

9+

10+{-# options_ghc -fno-warn-redundant-constraints #-}

11+

12+module Rel8.Type.Array1D

13+ ( Array1D( Array1D )

14+ , getArray1D

15+ )

16+where

17+

18+-- aeson

19+import Data.Aeson

20+ ( ToJSON

21+ , ToJSON1

22+ , ToJSONKey

23+ , FromJSON

24+ , FromJSON1

25+ , FromJSONKey

26+ )

27+

28+-- base

29+import Control.Applicative ( Alternative, (<|>) )

30+import Control.Monad ( MonadPlus )

31+import Data.Functor.Classes ( Eq1, Ord1, Read1, Show1 )

32+import Data.Kind ( Type )

33+import GHC.Exts ( IsList )

34+import Prelude hiding ( null )

35+

36+-- hasql

37+import qualified Hasql.Decoders as Hasql

38+

39+-- opaleye

40+import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye

41+

42+-- rel8

43+import Rel8.Expr.Opaleye ( zipPrimExprsWith )

44+import Rel8.Expr.Serialize ( litExpr )

45+import Rel8.Schema.Nullability

46+ ( Nullability( Nullable, NonNullable )

47+ , Nullabilizes, nullabilization

48+ )

49+import Rel8.Type ( DBType, typeInformation )

50+import Rel8.Type.Eq ( DBEq )

51+import Rel8.Type.Information ( TypeInformation(..) )

52+import Rel8.Type.Monoid ( DBMonoid, memptyExpr )

53+import Rel8.Type.Ord ( DBMax, DBMin, DBOrd )

54+import Rel8.Type.Semigroup ( DBSemigroup, (<>.) )

55+

56+-- semigroupoids

57+import Data.Functor.Alt ( Alt, (<!>) )

58+import Data.Functor.Apply ( Apply )

59+import Data.Functor.Bind ( Bind )

60+import Data.Functor.Plus ( Plus )

61+

62+-- semialign

63+import Data.Align ( Align )

64+import Data.Semialign ( Semialign )

65+import Data.Zip ( Repeat, Unzip, Zip )

66+

67+

68+newtype Array1D a = Array1D [a]

69+ deriving stock Traversable

70+ deriving newtype

71+ ( Eq, Ord, Read, Show, Semigroup, Monoid, IsList

72+ , Functor, Foldable

73+ , Eq1, Ord1, Read1, Show1

74+ , FromJSON1, ToJSON1, FromJSON, FromJSONKey, ToJSON, ToJSONKey

75+ , Apply, Applicative, Alternative, Plus, Bind, Monad, MonadPlus

76+ , Align, Semialign, Repeat, Unzip, Zip

77+ )

78+

79+

80+instance Alt Array1D where

81+ (<!>) = (<|>)

82+

83+

84+getArray1D :: Array1D a -> [a]

85+getArray1D (Array1D a) = a

86+

87+

88+type IsArray1D :: Type -> Bool

89+type family IsArray1D a where

90+ IsArray1D (Array1D _) = 'True

91+ IsArray1D _ = 'False

92+

93+

94+array1DTypeInformation :: IsArray1D db ~ 'False

95+ => Nullability db a

96+ -> TypeInformation db

97+ -> TypeInformation (Array1D a)

98+array1DTypeInformation nullability info = TypeInformation

99+ { decode = case nullability of

100+ Nullable -> Array1D <$> Hasql.listArray (Hasql.nullable decode)

101+ NonNullable -> Array1D <$> Hasql.listArray (Hasql.nonNullable decode)

102+ , encode = case nullability of

103+ Nullable -> Opaleye.ArrayExpr . fmap (maybe null encode) . getArray1D

104+ NonNullable -> Opaleye.ArrayExpr . fmap encode . getArray1D

105+ , typeName = typeName <> "[]"

106+ }

107+ where

108+ TypeInformation {encode, decode, typeName} = info

109+ null = Opaleye.ConstExpr Opaleye.NullLit

110+

111+

112+instance (DBType db, Nullabilizes db a, IsArray1D db ~ 'False) => DBType (Array1D a) where

113+ typeInformation = array1DTypeInformation nullabilization typeInformation

114+

115+

116+instance (DBEq db, Nullabilizes db a, IsArray1D db ~ 'False) => DBEq (Array1D a)

117+

118+

119+instance (DBOrd db, Nullabilizes db a, IsArray1D db ~ 'False) => DBOrd (Array1D a)

120+

121+

122+instance (DBMax db, Nullabilizes db a, IsArray1D db ~ 'False) => DBMax (Array1D a)

123+

124+

125+instance (DBMin db, Nullabilizes db a, IsArray1D db ~ 'False) => DBMin (Array1D a)

126+

127+

128+instance (DBType db, Nullabilizes db a, IsArray1D db ~ 'False) => DBSemigroup (Array1D a) where

129+ (<>.) = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:||))

130+

131+

132+instance (DBType db, Nullabilizes db a, IsArray1D db ~ 'False) => DBMonoid (Array1D a) where

133+ memptyExpr = litExpr mempty

src/Rel8/Type/Num.hs+1−2

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

13import Prelude

14

15-- rel8

16−import Rel8.Kind.Bool ( IsList )

17import Rel8.Type ( DBType )

16import Rel8.Type ( DBType )

18

17

19-- scientific

18-- scientific

@@ -21,7 +20,7 @@ import Data.Scientific ( Scientific )

21

20

22

21

23type DBNum :: Type -> Constraint

22type DBNum :: Type -> Constraint

24−class (DBType a, IsList a ~ 'False) => DBNum a

23+class DBType a => DBNum a

25instance DBNum Int16

24instance DBNum Int16

26instance DBNum Int32

25instance DBNum Int32

27instance DBNum Int64

26instance DBNum Int64

src/Rel8/Type/Sum.hs+1−2

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

13import Prelude

14

15-- rel8

16−import Rel8.Kind.Bool ( IsList )

17import Rel8.Type ( DBType )

16import Rel8.Type ( DBType )

18

17

19-- scientific

18-- scientific

@@ -24,7 +23,7 @@ import Data.Time.Clock ( DiffTime, NominalDiffTime )

24

23

25

24

26type DBSum :: Type -> Constraint

25type DBSum :: Type -> Constraint

27−class (DBType a, IsList a ~ 'False) => DBSum a

26+class DBType a => DBSum a

28instance DBSum Int16

27instance DBSum Int16

29instance DBSum Int32

28instance DBSum Int32

30instance DBSum Int64

29instance DBSum Int64