git.iko.soy/rel8
on f3daaff help sign in
rel8/src/Rel8/Expr/Ord.hs
157 lines 4.7 kB history raw
1{-# language DataKinds #-}
2{-# language FlexibleContexts #-}
3{-# language LambdaCase #-}
4{-# language GADTs #-}
5{-# language ScopedTypeVariables #-}
6{-# language TypeApplications #-}
8{-# options_ghc -fno-warn-redundant-constraints #-}
10module Rel8.Expr.Ord
11 ( slt, sle, sgt, sge
12 , (<.), (<=.), (>.), (>=.)
13 , (<?), (<=?), (>?), (>=?)
14 , leastExpr, greatestExpr
15 )
16where
18-- base
19import Prelude
21-- opaleye
22import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
24-- rel8
25import Rel8.Expr ( Expr( Expr ) )
26import Rel8.Expr.Bool ( (&&.), (||.), coalesce )
27import Rel8.Expr.Null ( isNull, isNonNull, nullable, unsafeLiftOpNullable )
28import Rel8.Expr.Opaleye ( zipPrimExprsWith )
29import Rel8.Schema.Nullability
30 ( Nullability( NonNullable, Nullable )
31 , Sql, nullabilization
32 )
33import Rel8.Type.Ord ( DBOrd )
36lt :: DBOrd a => Expr a -> Expr a -> Expr Bool
37lt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<))
40le :: DBOrd a => Expr a -> Expr a -> Expr Bool
41le = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<=))
44gt :: DBOrd a => Expr a -> Expr a -> Expr Bool
45gt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>))
48ge :: DBOrd a => Expr a -> Expr a -> Expr Bool
49ge = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>=))
52slt :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
53slt = \case
54 Nullable -> \ma mb -> isNull ma &&. isNonNull mb ||. ma <? mb
55 NonNullable -> lt
58sle :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
59sle = \case
60 Nullable -> \ma mb -> isNull ma ||. ma <=? mb
61 NonNullable -> le
64sgt :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
65sgt = \case
66 Nullable -> \ma mb -> isNonNull ma &&. isNull mb ||. ma >? mb
67 NonNullable -> gt
70sge :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
71sge = \case
72 Nullable -> \ma mb -> isNull mb ||. ma >=? mb
73 NonNullable -> ge
76-- | Corresponds to the SQL @<@ operator. Note that this differs from SQL @<@
77-- as @null@ will sort below any other value. For a version of @<@ that exactly
78-- matches SQL, see '(<?)'.
79(<.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
80(<.) = slt nullabilization
81infix 4 <.
84-- | Corresponds to the SQL @<=@ operator. Note that this differs from SQL @<=@
85-- as @null@ will sort below any other value. For a version of @<=@ that exactly
86-- matches SQL, see '(<=?)'.
87(<=.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
88(<=.) = sle nullabilization
89infix 4 <=.
92-- | Corresponds to the SQL @>@ operator. Note that this differs from SQL @>@
93-- as @null@ will sort below any other value. For a version of @>@ that exactly
94-- matches SQL, see '(>?)'.
95(>.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
96(>.) = sgt nullabilization
97infix 4 >.
100-- | Corresponds to the SQL @>=@ operator. Note that this differs from SQL @>@
101-- as @null@ will sort below any other value. For a version of @>=@ that
102-- exactly matches SQL, see '(>=?)'.
103(>=.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
104(>=.) = sge nullabilization
105infix 4 >=.
108-- | Corresponds to the SQL @<@ operator. Returns @null@ if either arguments
109-- are @null@.
110(<?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
111a <? b = coalesce $ unsafeLiftOpNullable lt a b
112infix 4 <?
115-- | Corresponds to the SQL @<=@ operator. Returns @null@ if either arguments
116-- are @null@.
117(<=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
118a <=? b = coalesce $ unsafeLiftOpNullable le a b
119infix 4 <=?
122-- | Corresponds to the SQL @>@ operator. Returns @null@ if either arguments
123-- are @null@.
124(>?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
125a >? b = coalesce $ unsafeLiftOpNullable gt a b
126infix 4 >?
129-- | Corresponds to the SQL @>=@ operator. Returns @null@ if either arguments
130-- are @null@.
131(>=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
132a >=? b = coalesce $ unsafeLiftOpNullable ge a b
133infix 4 >=?
136-- | Given two expressions, return the expression that sorts less than the
137-- other.
138--
139-- Corresponds to the SQL @least()@ function.
140leastExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a
141leastExpr ma mb = case nullabilization @a of
142 Nullable -> nullable ma (\a -> nullable mb (least_ a) mb) ma
143 NonNullable -> least_ ma mb
144 where
145 least_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "LEAST" [a, b])
148-- | Given two expressions, return the expression that sorts greater than the
149-- other.
150--
151-- Corresponds to the SQL @greatest()@ function.
152greatestExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a
153greatestExpr ma mb = case nullabilization @a of
154 Nullable -> nullable mb (\a -> nullable ma (greatest_ a) mb) ma
155 NonNullable -> greatest_ ma mb
156 where
157 greatest_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "GREATEST" [a, b])