@@ -35,7 +35,7 @@ module Squeal.PostgreSQL.Expression.Range
3535 ( range
3636 , Range (..)
3737 , (<=..<=), (<..<), (<=..<), (<..<=)
38− , halfGT, halfGTE, halfLT, halfLTE
38+ , greaterThan, atLeast, lessThan, atMost
3939 , singleton, whole
4040 , Bound (..)
4141 , closed, open
@@ -47,6 +47,7 @@ import qualified GHC.Generics as GHC
4747import qualified Generics.SOP as SOP
4848
4949import Squeal.PostgreSQL.Expression
50+import Squeal.PostgreSQL.Expression.Type hiding (bool)
5051import Squeal.PostgreSQL.PG
5152import Squeal.PostgreSQL.Render
5253import Squeal.PostgreSQL.Schema
@@ -54,14 +55,26 @@ import Squeal.PostgreSQL.Schema
5455-- $setup
5556-- >>> import Squeal.PostgreSQL
5657
57−-- | >>> printSQL $ range (halfGTE now)
58−-- [now(), )
59−-- >>> printSQL $ range (0 <..<= (pi & astype numeric))
60−-- (0, (pi() :: numeric)]
58+-- | Construct a `range`
59+--
60+-- >>> printSQL $ range tstzrange (atLeast now)
61+-- tstzrange(now(), NULL, '[)')
62+-- >>> printSQL $ range numrange (0 <=..<= 2*pi)
63+-- numrange(0, (2 * pi()), '(]')
6164range
62− :: Range (Expression outer commons grp schemas params from ('NotNull ty))
65+ :: TypeExpression schemas (null ('PGrange ty))
66+ -> Range (Expression outer commons grp schemas params from ('NotNull ty))
6367 -> Expression outer commons grp schemas params from (null ('PGrange ty))
64−range = UnsafeExpression . renderSQL
68+range ty = \case
69+ Empty -> UnsafeExpression "empty"
70+ NonEmpty l u -> UnsafeExpression $ renderSQL ty <> parenthesized
71+ (commaSeparated [renderArg l, renderArg u, renderClopen l u])
72+ where
73+ renderArg (Bound _ x) = maybe "NULL" renderSQL x
74+ clopenLeft = bool "(" "["
75+ clopenRight = bool ")" "]"
76+ renderClopen (Bound l' _) (Bound u' _) =
77+ "\'" <> clopenLeft l' <> clopenRight u' <> "\'"
6578
6679data Bound x = Bound
6780 { closedBound :: Bool
@@ -83,27 +96,18 @@ data Range x
8396 deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
8497type instance PG (Range x) = 'PGrange (PG x)
8598
86−instance RenderSQL x => RenderSQL (Range x) where
87− renderSQL = \case
88− Empty -> "empty"
89− NonEmpty l u -> commaSeparated [renderLower l, renderUpper u]
90− where
91− renderLower (Bound isclosed x) =
92− bool "(" "[" isclosed <> maybe "" renderSQL x
93− renderUpper (Bound isclosed x) =
94− maybe "" renderSQL x <> bool ")" "]" isclosed
95−
9699(<=..<=), (<..<), (<=..<), (<..<=) :: x -> x -> Range x
100+infix 4 <=..<=, <..<, <=..<, <..<=
97101x <=..<= y = NonEmpty (closed (Just x)) (closed (Just y))
98102x <..< y = NonEmpty (open (Just x)) (open (Just y))
99103x <=..< y = NonEmpty (closed (Just x)) (open (Just y))
100104x <..<= y = NonEmpty (open (Just x)) (closed (Just y))
101105
102−halfGT, halfGTE, halfLT, halfLTE :: x -> Range x
103−halfGT x = NonEmpty (open (Just x)) (open Nothing)
104−halfGTE x = NonEmpty (closed (Just x)) (open Nothing)
105−halfLT x = NonEmpty (open Nothing) (open (Just x))
106−halfLTE x = NonEmpty (open Nothing) (closed (Just x))
106+greaterThan, atLeast, lessThan, atMost :: x -> Range x
107+greaterThan x = NonEmpty (open (Just x)) (open Nothing)
108+atLeast x = NonEmpty (closed (Just x)) (open Nothing)
109+lessThan x = NonEmpty (open Nothing) (open (Just x))
110+atMost x = NonEmpty (open Nothing) (closed (Just x))
107111
108112singleton :: x -> Range x
109113singleton x = x <=..<= x