git.iko.soy/rel8
on bb078d2 help sign in
rel8/src/Rel8/Expr/Ord.hs
132 lines 3.4 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(<.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
77(<.) = slt nullabilization
78infix 4 <.
81-- | The PostgreSQL @<=@ operator.
82(<=.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
83(<=.) = sle nullabilization
84infix 4 <=.
87-- | The PostgreSQL @>@ operator.
88(>.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
89(>.) = sgt nullabilization
90infix 4 >.
93-- | The PostgreSQL @>=@ operator.
94(>=.) :: Sql DBOrd a => Expr a -> Expr a -> Expr Bool
95(>=.) = sge nullabilization
96infix 4 >=.
99(<?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
100a <? b = coalesce $ unsafeLiftOpNullable lt a b
101infix 4 <?
104(<=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
105a <=? b = coalesce $ unsafeLiftOpNullable le a b
106infix 4 <=?
109(>?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
110a >? b = coalesce $ unsafeLiftOpNullable gt a b
111infix 4 >?
114(>=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
115a >=? b = coalesce $ unsafeLiftOpNullable ge a b
116infix 4 >=?
119leastExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a
120leastExpr ma mb = case nullabilization @a of
121 Nullable -> nullable ma (\a -> nullable mb (least_ a) mb) ma
122 NonNullable -> least_ ma mb
123 where
124 least_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "LEAST" [a, b])
127greatestExpr :: forall a. Sql DBOrd a => Expr a -> Expr a -> Expr a
128greatestExpr ma mb = case nullabilization @a of
129 Nullable -> nullable mb (\a -> nullable ma (greatest_ a) mb) ma
130 NonNullable -> greatest_ ma mb
131 where
132 greatest_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "GREATEST" [a, b])