git.iko.soy/rel8
on cf03bcd help sign in
rel8/src/Rel8/Expr/Ord.hs
130 lines 3.4 kB history raw
1{-# language DataKinds #-}
2{-# language LambdaCase #-}
3{-# language GADTs #-}
4{-# language ScopedTypeVariables #-}
5{-# language TypeApplications #-}
7{-# options_ghc -fno-warn-redundant-constraints #-}
9module Rel8.Expr.Ord
10 ( slt, sle, sgt, sge
11 , (<.), (<=.), (>.), (>=.)
12 , (<?), (<=?), (>?), (>=?)
13 , leastExpr, greatestExpr
14 )
15where
17-- base
18import Prelude
20-- opaleye
21import qualified Opaleye.Internal.HaskellDB.PrimQuery as Opaleye
23-- rel8
24import Rel8.Expr ( Expr( Expr ) )
25import Rel8.Expr.Bool ( (&&.), (||.), coalesce )
26import Rel8.Expr.Null ( isNull, isNonNull, nullable, unsafeLiftOpNullable )
27import Rel8.Expr.Opaleye ( zipPrimExprsWith )
28import Rel8.Schema.Nullability
29 ( Nullability( NonNullable, Nullable )
30 , Nullabilizes, nullabilization
31 )
32import Rel8.Type.Ord ( DBOrd )
35lt :: DBOrd a => Expr a -> Expr a -> Expr Bool
36lt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<))
39le :: DBOrd a => Expr a -> Expr a -> Expr Bool
40le = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:<=))
43gt :: DBOrd a => Expr a -> Expr a -> Expr Bool
44gt = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>))
47ge :: DBOrd a => Expr a -> Expr a -> Expr Bool
48ge = zipPrimExprsWith (Opaleye.BinExpr (Opaleye.:>=))
51slt :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
52slt = \case
53 Nullable -> \ma mb -> isNull ma &&. isNonNull mb ||. ma <? mb
54 NonNullable -> lt
57sle :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
58sle = \case
59 Nullable -> \ma mb -> isNull ma ||. ma <=? mb
60 NonNullable -> le
63sgt :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
64sgt = \case
65 Nullable -> \ma mb -> isNonNull ma &&. isNull mb ||. ma >? mb
66 NonNullable -> gt
69sge :: DBOrd db => Nullability db a -> Expr a -> Expr a -> Expr Bool
70sge = \case
71 Nullable -> \ma mb -> isNull mb ||. ma >=? mb
72 NonNullable -> ge
75(<.) :: (DBOrd db, Nullabilizes db a) => Expr a -> Expr a -> Expr Bool
76(<.) = slt nullabilization
77infix 4 <.
80(<=.) :: (DBOrd db, Nullabilizes db a) => Expr a -> Expr a -> Expr Bool
81(<=.) = sle nullabilization
82infix 4 <=.
85(>.) :: (DBOrd db, Nullabilizes db a) => Expr a -> Expr a -> Expr Bool
86(>.) = sgt nullabilization
87infix 4 >.
90(>=.) :: (DBOrd db, Nullabilizes db a) => Expr a -> Expr a -> Expr Bool
91(>=.) = sge nullabilization
92infix 4 >=.
95(<?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
96a <? b = coalesce $ unsafeLiftOpNullable lt a b
97infix 4 <?
100(<=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
101a <=? b = coalesce $ unsafeLiftOpNullable le a b
102infix 4 <=?
105(>?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
106a >? b = coalesce $ unsafeLiftOpNullable gt a b
107infix 4 >?
110(>=?) :: DBOrd a => Expr (Maybe a) -> Expr (Maybe a) -> Expr Bool
111a >=? b = coalesce $ unsafeLiftOpNullable ge a b
112infix 4 >=?
115leastExpr :: forall a db. (DBOrd db, Nullabilizes db a)
116 => Expr a -> Expr a -> Expr a
117leastExpr ma mb = case nullabilization @a of
118 Nullable -> nullable ma (\a -> nullable mb (least_ a) mb) ma
119 NonNullable -> least_ ma mb
120 where
121 least_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "LEAST" [a, b])
124greatestExpr :: forall a db. (DBOrd db, Nullabilizes db a)
125 => Expr a -> Expr a -> Expr a
126greatestExpr ma mb = case nullabilization @a of
127 Nullable -> nullable mb (\a -> nullable ma (greatest_ a) mb) ma
128 NonNullable -> greatest_ ma mb
129 where
130 greatest_ (Expr a) (Expr b) = Expr (Opaleye.FunExpr "GREATEST" [a, b])