06f67cf · rel8 · git.iko.soy

git.iko.soy/rel8

Introduce Array1D for interfacing with conventional postgres arrays, rendering the IsList stuff unnecessary

commit06f67cf03540eeeedd5994e30b45de964223d9fe authorShane O'Brien <shane.obrien@circuithub.com> dateTue 23 Mar 2021, 15:13 (6 years ago) parent3c5f54c

26 files changed+248−270

compare with master

unifiedsplit

rel8.cabal+1−2

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

6262 Rel8.Expr.Text

6363 Rel8.Expr.Time

6464

65− Rel8.Kind.Bool

6665 Rel8.Kind.Labels

6766 Rel8.Kind.Necessity

6867

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

149148 Rel8.Tabulate

150149

151150 Rel8.Type

152− Rel8.Type.Array

151+ Rel8.Type.Array1D

153152 Rel8.Type.Eq

154153 Rel8.Type.Information

155154 Rel8.Type.Monoid

src/Rel8/Expr.hs+2−2

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

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

2626import Rel8.Expr.Opaleye

2727 ( castExpr

28− , unsafeFromPrimExpr

28+ , fromPrimExpr

2929 , mapPrimExpr

3030 , zipPrimExprsWith

3131 )

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

7474

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

7676

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

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

7878

7979

8080instance (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 )

3232import Rel8.Expr.Opaleye

3333 ( castExpr

3434 , fromPrimExpr

35− , unsafeFromPrimExpr

36− , unsafeToPrimExpr

35+ , fromPrimExpr

36+ , toPrimExpr

3737 )

3838import Rel8.Expr.Null ( null )

3939import Rel8.Expr.Serialize ( litExpr )

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

41+import Rel8.Type.Array ( fromPrimArray )

4142import Rel8.Type.Eq ( DBEq )

4243import Rel8.Type.Num ( DBNum )

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

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

4647

4748

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

49−count = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

50+count = unsafeMakeAggregate toPrimExpr fromPrimExpr $

5051 Just Aggregator

5152 { operation = Opaleye.AggrCount

5253 , ordering = []

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

5556

5657

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

58−countDistinct = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

59+countDistinct = unsafeMakeAggregate toPrimExpr fromPrimExpr $

5960 Just Aggregator

6061 { operation = Opaleye.AggrCount

6162 , ordering = []

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

7273

7374

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

75−and = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

76+and = unsafeMakeAggregate toPrimExpr fromPrimExpr $

7677 Just Aggregator

7778 { operation = Opaleye.AggrBoolAnd

7879 , ordering = []

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

8182

8283

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

84−or = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

85+or = unsafeMakeAggregate toPrimExpr fromPrimExpr $

8586 Just Aggregator

8687 { operation = Opaleye.AggrBoolOr

8788 , ordering = []

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

9091

9192

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

93−max = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

94+max = unsafeMakeAggregate toPrimExpr fromPrimExpr $

9495 Just Aggregator

9596 { operation = Opaleye.AggrSum

9697 , ordering = []

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

99100

100101

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

102−min = unsafeMakeAggregate unsafeToPrimExpr unsafeFromPrimExpr $

103+min = unsafeMakeAggregate toPrimExpr fromPrimExpr $

103104 Just Aggregator

104105 { operation = Opaleye.AggrSum

105106 , ordering = []

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

108109

109110

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

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

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

112113 Just Aggregator

113114 { operation = Opaleye.AggrSum

114115 , ordering = []

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

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

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

126127stringAgg delimiter =

127− unsafeMakeAggregate unsafeToPrimExpr (castExpr . unsafeFromPrimExpr) $

128+ unsafeMakeAggregate toPrimExpr (castExpr . fromPrimExpr) $

128129 Just Aggregator

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

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

130131 , ordering = []

131132 , distinction = Opaleye.AggrAll

132133 }

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

137138

138139

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

140−listAggExpr = unsafeMakeAggregate unsafeToPrimExpr fromPrimExpr $ Just

141+listAggExpr = unsafeMakeAggregate toPrimExpr from $ Just

141142 Aggregator

142143 { operation = Opaleye.AggrArr

143144 , ordering = []

144145 , distinction = Opaleye.AggrAll

145146 }

147+ where

148+ from = fromPrimExpr . fromPrimArray

146149

147150

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

149−nonEmptyAggExpr = unsafeMakeAggregate unsafeToPrimExpr fromPrimExpr $ Just

152+nonEmptyAggExpr = unsafeMakeAggregate toPrimExpr from $ Just

150153 Aggregator

151154 { operation = Opaleye.AggrArr

152155 , ordering = []

153156 , distinction = Opaleye.AggrAll

154157 }

158+ where

159+ from = fromPrimExpr . fromPrimArray

155160

156161

157162sgroupByExpr :: 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

2222-- rel8

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

2424import Rel8.Expr.Opaleye

25− ( unsafeFromPrimExpr, unsafeToPrimExpr

25+ ( fromPrimExpr, toPrimExpr

2626 , zipPrimExprsWith

2727 )

2828import Rel8.Type ( DBType, typeInformation )

29−import Rel8.Type.Array ( array )

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

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

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

3232

3333

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

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

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

3636

3737

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

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

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

4040

4141

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

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

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

4444

4545

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

4747 => [Expr a] -> Expr [a]

48−listOf =

49− unsafeFromPrimExpr .

50− array (typeInformation @t) .

51− fmap unsafeToPrimExpr

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

5249

5350

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

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

56−nonEmptyOf =

57− unsafeFromPrimExpr .

58− array (typeInformation @t) .

59− fmap unsafeToPrimExpr

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

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

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

2424import Rel8.Expr ( Expr )

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

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

27−import Rel8.Expr.Opaleye

28− ( unsafeFromPrimExpr, unsafeToPrimExpr

29− , unsafeZipPrimExprsWith

30− )

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

3128import Rel8.Schema.Nullability

3229 ( Nullability( NonNullable, Nullable )

3330 , Nullabilizes, nullabilization

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

3633

3734

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

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

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

4037

4138

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

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

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

4441

4542

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

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

6259 NonNullable -> case nonEmpty as of

6360 Nothing -> false

6461 Just xs ->

65− unsafeFromPrimExpr $

62+ fromPrimExpr $

6663 Opaleye.BinExpr Opaleye.OpIn

67− (unsafeToPrimExpr a)

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

64+ (toPrimExpr a)

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

6966

7067

7168(==.) :: (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

99 ( Function, function

1010 , nullaryFunction

1111 , binaryOperator

12− , unsafeBinaryOperator

1312 )

1413where

1514

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

2524import Rel8.Expr.Opaleye

2625 ( castExpr

2726 , fromPrimExpr, toPrimExpr, zipPrimExprsWith

28− , unsafeZipPrimExprsWith

2927 )

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

3128import Rel8.Schema.Nullability ( Nullabilizes )

3229import Rel8.Type ( DBType )

3330

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

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

3835

3936

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)

4638 where

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

4840

4941

50−instance

51− ( arg ~ Expr a

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

53− , Function args res

54− ) =>

55− Function arg (args -> res)

56− where

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

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

5844

5945

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

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

6652

6753

68−binaryOperator ::

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

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

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

72− )

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

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

7456binaryOperator operator a b =

7557 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

2222-- rel8

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

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

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

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

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

2727import Rel8.Type ( DBType, typeInformation )

2828import Rel8.Type.Information ( TypeInformation )

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

4646

4747

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

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

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

5050

5151

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

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

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

5454

5555

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

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

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

1111 ( castExpr, unsafeCastExpr

1212 , scastExpr, sunsafeCastExpr

1313 , unsafeLiteral

14− , unsafeFromPrimExpr, unsafeToPrimExpr, unsafeMapPrimExpr

15− , unsafeZipPrimExprsWith, unsafeTraversePrimExpr

16− , sfromPrimExpr, stoPrimExpr

17− , fromPrimExpr, toPrimExpr, mapPrimExpr, zipPrimExprsWith

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

1815 , toColumn, fromColumn

1916 )

2017where

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

2825

2926-- rel8

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

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

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

3329import Rel8.Type ( DBType, typeInformation )

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

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

4945sunsafeCastExpr :: ()

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

5147sunsafeCastExpr _ TypeInformation {typeName} =

52− Expr . Opaleye.CastExpr typeName . unsafeToPrimExpr

48+ fromPrimExpr . Opaleye.CastExpr typeName . toPrimExpr

5349

5450

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

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

5753

5854

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

60−unsafeFromPrimExpr = Expr

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

56+fromPrimExpr = Expr

6157

6258

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

64−unsafeToPrimExpr (Expr a) = a

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

60+toPrimExpr (Expr a) = a

6561

6662

67−unsafeMapPrimExpr :: ()

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

69−unsafeMapPrimExpr f = unsafeFromPrimExpr . f . unsafeToPrimExpr

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

64+mapPrimExpr f = fromPrimExpr . f . toPrimExpr

7065

7166

72−unsafeZipPrimExprsWith :: ()

67+zipPrimExprsWith :: ()

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

7469 -> Expr a -> Expr b -> Expr c

75−unsafeZipPrimExprsWith f a b =

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

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

7771

7872

79−unsafeTraversePrimExpr :: Functor f

73+traversePrimExpr :: Functor f

8074 => (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

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

75+traversePrimExpr f = fmap fromPrimExpr . f . toPrimExpr

13876

13977

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

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

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

2424import Rel8.Expr ( Expr( Expr ) )

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

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

27−import Rel8.Expr.Opaleye ( unsafeZipPrimExprsWith )

27+import Rel8.Expr.Opaleye ( zipPrimExprsWith )

2828import Rel8.Schema.Nullability

2929 ( Nullability( NonNullable, Nullable )

3030 , Nullabilizes, nullabilization

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

3333

3434

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

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

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

3737

3838

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

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

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

4141

4242

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

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

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

4545

4646

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

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

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

4949

5050

5151slt :: 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

2222-- rel8

2323import Rel8.Expr ( Expr )

2424import Rel8.Expr.Null ( unsafeUnnullify )

25−import Rel8.Expr.Opaleye ( unsafeToPrimExpr )

25+import Rel8.Expr.Opaleye ( toPrimExpr )

2626import Rel8.Order ( Order( Order ) )

2727import Rel8.Type.Ord ( DBOrd )

2828

2929

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

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

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

3232 where

3333 orderOp :: Opaleye.OrderOp

3434 orderOp = Opaleye.OrderOp

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

3838

3939

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

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

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

4242 where

4343 orderOp :: Opaleye.OrderOp

4444 orderOp = Opaleye.OrderOp

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

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

2323-- base

2424import Data.Bool ( Bool )

2525import Data.Int ( Int32 )

26−import Data.List.NonEmpty ( NonEmpty )

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

2827import Prelude ()

2928

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

3332-- rel8

3433import Rel8.Expr ( Expr )

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

35+import Rel8.Type.Array1D ( Array1D )

3636

3737-- text

3838import Data.Text (Text)

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

185185

186186

187187regexpSplitToArray :: ()

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

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

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

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

191191

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

1919-- rel8

2020import Rel8.Expr.Bool ( true )

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

22−import Rel8.Expr.Opaleye ( unsafeToPrimExpr )

22+import Rel8.Expr.Opaleye ( toPrimExpr )

2323import Rel8.Query ( Query )

2424import Rel8.Query.Filter ( where_ )

2525import Rel8.Query.Opaleye ( mapOpaleye )

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

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

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

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

40− condition = unsafeToPrimExpr true

40+ condition = toPrimExpr true

4141

4242

4343catMaybeTable :: MaybeTable a -> Query a

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

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

2323import qualified Opaleye.Internal.Sql as Opaleye

2424

2525-- rel8

26−import Rel8.Expr.Opaleye ( unsafeToPrimExpr )

26+import Rel8.Expr.Opaleye ( toPrimExpr )

2727import Rel8.Query ( Query )

2828import Rel8.Query.Opaleye ( toOpaleye )

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

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

6767 select = Opaleye.foldPrimQuery Opaleye.sqlQueryGenerator query

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

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

7171 makeAttr label expr =

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

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

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

3232import Rel8.Expr.Aggregate ( groupByExpr )

3333import Rel8.Expr.Bool ( boolExpr )

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

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

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

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

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

3838import Rel8.Schema.Context

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

7878 decodeTag (Aggregation aggregate) = fold $ undoGroupBy aggregate

7979

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

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

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

8282 runTag nullability tag <$> aggregate

8383

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

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

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

1515import Prelude

1616

1717-- rel8

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

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

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

2120import Rel8.Schema.Dict ( Dict( Dict ) )

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

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

4241

4342

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

45− HTable (HType a)

46− where

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

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

4845 type HField (HType a) = HTypeField a

4946

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

5653 , necessity = SRequired

5754 , info = typeInformation

5855 , nullability = nullabilization

59− , isList = boolSing

6056 }

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

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

3232import Prelude

3333

3434-- rel8

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

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

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

3837import Rel8.Schema.HTable

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

5049

5150

5251class Vector list where

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

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

5553 vectorTypeInformation :: ()

5654 => Nullability a ma

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

5957

6058

6159instance Vector [] where

62− listIsList _ = Refl

6360 listIsn'tMaybe _ = Refl

6461 vectorTypeInformation = listTypeInformation

6562

6663

6764instance Vector NonEmpty where

68− listIsList _ = Refl

6965 listIsn'tMaybe _ = Refl

7066 vectorTypeInformation = nonEmptyTypeInformation

7167

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

104100 Dict -> VectorizeSpec Dict

105101

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

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

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

109− Refl -> VectorizeSpec SSpec

110− { nullability = NonNullable

111− , info = vectorTypeInformation nullability info

112− , isList = STrue

113− , ..

114− }

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

104+ Refl -> VectorizeSpec SSpec

105+ { nullability = NonNullable

106+ , info = vectorTypeInformation nullability info

107+ , ..

108+ }

115109

116110 {-# INLINABLE hfield #-}

117111 {-# INLINABLE htabulate #-}

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

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

77module Rel8.Schema.Spec

88 ( Spec( Spec )

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

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

1010 , KnownSpec( specSing )

1111 , Context, KTable

1212 )

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

1717import Prelude ()

1818

1919-- rel8

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

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

2221import Rel8.Kind.Necessity

2322 ( Necessity

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

4039 , necessity :: SNecessity necessity

4140 , info :: TypeInformation db

4241 , nullability :: Nullability db a

43− , isList :: SBool (IsList db)

4442 }

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

4644

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

5553 , KnownNecessity necessity

5654 , DBType db

5755 , Nullabilizes db a

58− , KnownBool (IsList db)

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

6057 where

6158 specSing = SSpec

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

6360 , necessity = necessitySing

6461 , info = typeInformation

6562 , nullability = nullabilization

66− , isList = boolSing

6763 }

6864

6965

src/Rel8/Table.hs+2−15

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

2222-- rel8

2323import Rel8.Aggregate ( Aggregate )

2424import Rel8.Expr ( Expr )

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

2625import Rel8.Opaque ( Opaque, Opaque1 )

2726import Rel8.Schema.Context

2827 ( Aggregation( Aggregation )

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

8382 Aggregation a -> DB <$> a

8483

8584

86−instance

87− ( DBType db

88− , Nullabilizes db a

89− , KnownBool (IsList db)

90− )

91− => Table DB (Expr a)

92− where

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

9386 type Columns (Expr a) = HType a

9487 type Context (Expr a) = DB

9588

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

9790 fromColumns (HType (DB a)) = a

9891

9992

100−instance

101− ( DBType db

102− , Nullabilizes db a

103− , KnownBool (IsList db)

104− )

105− => Table Result (Identity a)

106− where

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

10794 type Columns (Identity a) = HType a

10895 type Context (Identity a) = Result

10996

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

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

3535import Rel8.Aggregate ( Aggregate( Aggregate ) )

3636import Rel8.Expr.Opaleye

3737 ( scastExpr

38− , unsafeFromPrimExpr, unsafeToPrimExpr

39− , unsafeTraversePrimExpr

40− , sfromPrimExpr, stoPrimExpr

38+ , fromPrimExpr, toPrimExpr

39+ , traversePrimExpr

4140 , fromColumn, toColumn

4241 )

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

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

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

6463 WrapApplicative $

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

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

67− f (unsafeToPrimExpr a, unsafeToPrimExpr b)

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

6866

6967

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

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

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

7371 fmap fromColumns .

7472 unwrapApplicative .

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

73+ htraverse

74+ (\(DB a) ->

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

7676 toColumns

7777

7878

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

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

9696 where

9797 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) =

9999 case necessity of

100100 SRequired ->

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

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

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

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

107107 Opaleye.optionalTableField name

108− where

109− fromPrimExpr = sfromPrimExpr nullability isList

110− toPrimExpr = stoPrimExpr nullability isList

111108

112109

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

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

115112 fmap fromColumns .

116113 unwrapApplicative .

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

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

118115 toColumns

119116{-# INLINABLE unpackspec #-}

120117

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

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

129126 fmap fromColumns $

130127 unwrapApplicative .

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

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

132129 toColumns as

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

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

2424-- rel8

2525import Rel8.Aggregate ( Aggregate )

2626import Rel8.Expr ( Expr )

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

2827import Rel8.Opaque ( Opaque, Opaque1 )

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

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

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

5251 , b from -> a

5352

5453

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

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

5655 Recontextualize Aggregation Aggregation (Aggregate (Expr a)) (Aggregate (Expr a))

5756

5857

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

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

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

6160

6261

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

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

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

6564

6665

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

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

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

6968

7069

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

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

7271 Recontextualize DB DB (Expr a) (Expr a)

7372

7473

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

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

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

7776

7877

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

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

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

8180

8281

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

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

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

8584

8685

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

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

8887 Recontextualize Result Result (Identity a) (Identity a)

8988

9089

src/Rel8/Table/Serialize.hs−3

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

2929-- rel8

3030import Rel8.Expr ( Expr )

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

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

3332import Rel8.Opaque ( Opaque )

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

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

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

141140

142141instance

143142 ( DBType a

144− , IsList a ~ 'False

145143 , IsMaybe a ~ 'False

146144 , IsTabular a ~ 'False

147145 , x ~ Expr a

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

166164instance

167165 ( DBType a

168166 , Nullabilizes a (Maybe a)

169− , KnownBool (IsList a)

170167 , isTabular ~ 'False

171168 , IsMaybeTabular a ~ 'False

172169 , x ~ Maybe a

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

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

66 ( array

77 , listTypeInformation

88 , nonEmptyTypeInformation

9+ , fromPrimArray, toPrimArray, zipPrimArraysWith

910 )

1011where

1112

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

2829array :: Foldable f

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

3031array TypeInformation {typeName} =

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

32+ fromPrimArray .

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

3334 Opaleye.ArrayExpr . toList

3435

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

6162 where

6263 parse = maybe (Left message) Right . nonEmpty

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

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 )

1313import Prelude

1414

1515-- rel8

16−import Rel8.Kind.Bool ( IsList )

1716import Rel8.Type ( DBType )

1817

1918-- scientific

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

2120

2221

2322type DBNum :: Type -> Constraint

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

23+class DBType a => DBNum a

2524instance DBNum Int16

2625instance DBNum Int32

2726instance DBNum Int64

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

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

1313import Prelude

1414

1515-- rel8

16−import Rel8.Kind.Bool ( IsList )

1716import Rel8.Type ( DBType )

1817

1918-- scientific

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

2423

2524

2625type DBSum :: Type -> Constraint

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

26+class DBType a => DBSum a

2827instance DBSum Int16

2928instance DBSum Int32

3029instance DBSum Int64