8cb6d48 · rel8 · git.iko.soy

git.iko.soy/rel8

on master help sign in

Generalize nullable to work on `Table`s

8cb6d48Shane O'Brien6 years ago

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

compare with master

unifiedsplit

@@ -5,7 +5,7 @@

5{-# options -fno-warn-redundant-constraints #-}

7module Rel8.Expr.Null

8− ( null, snull, nullable, nullableOf

8+ ( null, snull, nullableExpr, nullableOf

9 , isNull, isNonNull

10 , nullify, unsafeUnnullify

11 , mapNull, liftOpNull

@@ -40,8 +40,8 @@ unsafeUnnullify (Expr a) = Expr a

42-- | Like 'maybe', but to eliminate @null@.

43−nullable :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b

43+nullableExpr :: Expr b -> (Expr a -> Expr b) -> Expr (Maybe a) -> Expr b

44−nullable b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)

44+nullableExpr b f ma = boolExpr (f (unsafeUnnullify ma)) b (isNull ma)

47nullableOf :: DBType a => Maybe (Expr a) -> Expr (Maybe a)

src/Rel8/Expr/Ord.hs+10−11

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

22-- rel8

23import Rel8.Expr ( Expr( Expr ) )

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

25−import Rel8.Expr.Null ( isNull, isNonNull, nullable, unsafeLiftOpNull )

25+import Rel8.Expr.Null ( isNull, isNonNull, nullableExpr, unsafeLiftOpNull )

26import Rel8.Expr.Opaleye ( toPrimExpr, zipPrimExprsWith )

27−import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql )

27+import Rel8.Schema.Null ( Nullity( Null, NotNull ), Sql, nullable )

28−import qualified Rel8.Schema.Null as Schema ( nullable )

29import Rel8.Type.Ord ( DBOrd )

28import Rel8.Type.Ord ( DBOrd )

@@ -49,7 +48,7 @@ ge = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>=))

49-- as @null@ will sort below any other value. For a version of @<@ that exactly

48-- as @null@ will sort below any other value. For a version of @<@ that exactly

50-- matches SQL, see '(<?)'.

49-- matches SQL, see '(<?)'.

51(<.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

50(<.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

52−(<.) = case Schema.nullable @a of

51+(<.) = case nullable @a of

53 Null -> \ma mb -> isNull ma &&. isNonNull mb ||. ma <? mb

52 Null -> \ma mb -> isNull ma &&. isNonNull mb ||. ma <? mb

54 NotNull -> lt

53 NotNull -> lt

55infix 4 <.

54infix 4 <.

@@ -59,7 +58,7 @@ infix 4 <.

59-- as @null@ will sort below any other value. For a version of @<=@ that exactly

58-- as @null@ will sort below any other value. For a version of @<=@ that exactly

60-- matches SQL, see '(<=?)'.

59-- matches SQL, see '(<=?)'.

61(<=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

60(<=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

62−(<=.) = case Schema.nullable @a of

61+(<=.) = case nullable @a of

63 Null -> \ma mb -> isNull ma ||. ma <=? mb

62 Null -> \ma mb -> isNull ma ||. ma <=? mb

64 NotNull -> le

63 NotNull -> le

65infix 4 <=.

64infix 4 <=.

@@ -69,7 +68,7 @@ infix 4 <=.

69-- as @null@ will sort below any other value. For a version of @>@ that exactly

68-- as @null@ will sort below any other value. For a version of @>@ that exactly

70-- matches SQL, see '(>?)'.

69-- matches SQL, see '(>?)'.

71(>.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

70(>.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

72−(>.) = case Schema.nullable @a of

71+(>.) = case nullable @a of

73 Null -> \ma mb -> isNonNull ma &&. isNull mb ||. ma >? mb

72 Null -> \ma mb -> isNonNull ma &&. isNull mb ||. ma >? mb

74 NotNull -> gt

73 NotNull -> gt

75infix 4 >.

74infix 4 >.

@@ -79,7 +78,7 @@ infix 4 >.

79-- as @null@ will sort below any other value. For a version of @>=@ that

78-- as @null@ will sort below any other value. For a version of @>=@ that

80-- exactly matches SQL, see '(>=?)'.

79-- exactly matches SQL, see '(>=?)'.

81(>=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

80(>=.) :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr Bool

82−(>=.) = case Schema.nullable @a of

81+(>=.) = case nullable @a of

83 Null -> \ma mb -> isNull mb ||. ma >=? mb

82 Null -> \ma mb -> isNull mb ||. ma >=? mb

84 NotNull -> ge

83 NotNull -> ge

85infix 4 >=.

84infix 4 >=.

@@ -118,8 +117,8 @@ infix 4 >=?

118--

117--

119-- Corresponds to the SQL @least()@ function.

118-- Corresponds to the SQL @least()@ function.

120leastExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a

119leastExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a

121−leastExpr ma mb = case Schema.nullable @a of

120+leastExpr ma mb = case nullable @a of

122− Null -> nullable ma (\a -> nullable mb (least_ a) mb) ma

121+ Null -> nullableExpr ma (\a -> nullableExpr mb (least_ a) mb) ma

123 NotNull -> least_ ma mb

122 NotNull -> least_ ma mb

124 where

123 where

125 least_ a b = Expr (Opaleye.FunExpr "LEAST" [toPrimExpr a, toPrimExpr b])

124 least_ a b = Expr (Opaleye.FunExpr "LEAST" [toPrimExpr a, toPrimExpr b])

@@ -130,8 +129,8 @@ leastExpr ma mb = case Schema.nullable @a of

130--

129--

131-- Corresponds to the SQL @greatest()@ function.

130-- Corresponds to the SQL @greatest()@ function.

132greatestExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a

131greatestExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a

133−greatestExpr ma mb = case Schema.nullable @a of

132+greatestExpr ma mb = case nullable @a of

134− Null -> nullable mb (\a -> nullable ma (greatest_ a) mb) ma

133+ Null -> nullableExpr mb (\a -> nullableExpr ma (greatest_ a) mb) ma

135 NotNull -> greatest_ ma mb

134 NotNull -> greatest_ ma mb

136 where

135 where

137 greatest_ a b =

136 greatest_ a b =

src/Rel8/Table/Bool.hs+7

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

5module Rel8.Table.Bool

6 ( bool

7 , case_

8+ , nullable

8 )

9 )

9where

10where

@@ -14,6 +15,7 @@ import Prelude

14-- rel8

15-- rel8

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

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

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

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

18+import Rel8.Expr.Null ( isNull, unsafeUnnullify )

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

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

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

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

@@ -40,3 +42,8 @@ case_ (map (fmap toColumns) -> branches) (toColumns -> fallback) =

40 DB fallbackExpr ->

42 DB fallbackExpr ->

41 case map (fmap (unDB . (`hfield` field))) branches of

43 case map (fmap (unDB . (`hfield` field))) branches of

42 branchExprs -> DB (caseExpr branchExprs fallbackExpr)

44 branchExprs -> DB (caseExpr branchExprs fallbackExpr)

45+

46+

47+-- | Like 'maybe', but to eliminate @null@.

48+nullable :: Table Expr b => b -> (Expr a -> b) -> Expr (Maybe a) -> b

49+nullable b f ma = bool (f (unsafeUnnullify ma)) b (isNull ma)