@@ -38,7 +38,6 @@ module Squeal.PostgreSQL.Expression.Range
3838 , moreThan, atLeast, lessThan, atMost
3939 , singleton, whole
4040 , Bound (..)
41− , closed, open
4241 , (<@.)
4342 , (@>.)
4443 , (&&.)
@@ -60,8 +59,6 @@ module Squeal.PostgreSQL.Expression.Range
6059 , rangeMerge
6160 ) where
6261
63−import Data.Bool
64−
6562import qualified GHC.Generics as GHC
6663import qualified Generics.SOP as SOP
6764
@@ -81,35 +78,31 @@ import Squeal.PostgreSQL.Schema
8178-- >>> printSQL $ range numrange (0 <=..< 2*pi)
8279-- numrange(0, (2 * pi()), '[)')
8380-- >>> printSQL $ range int4range Empty
84−-- (empty :: int4range)
81+-- ('empty' :: int4range)
8582range
8683 :: TypeExpression schemas (null ('PGrange ty))
8784 -> Range (Expression outer commons grp schemas params from ('NotNull ty))
8885 -> Expression outer commons grp schemas params from (null ('PGrange ty))
8986range ty = \case
9087 Empty -> UnsafeExpression $ parenthesized
91− ("empty" <+> "::" <+> renderSQL ty)
88+ (empty <+> "::" <+> renderSQL ty)
9289 NonEmpty l u -> UnsafeExpression $ renderSQL ty <> parenthesized
93− (commaSeparated [renderArg l, renderArg u, renderClopen l u])
94− where
95− renderArg (Bound _ x) = maybe "NULL" renderSQL x
96− renderClopen (Bound l' _) (Bound u' _) =
97− "\'" <> bool "(" "[" l' <> bool ")" "]" u' <> "\'"
98−
99−data Bound x = Bound
100− { closedBound :: Bool
101− , getBound :: Maybe x
102− } deriving
90+ (commaSeparated (args l u))
91+ where
92+ empty = singleQuote <> "empty" <> singleQuote
93+ args l u = [arg l, arg u, singleQuote <> bra l <> ket u <> singleQuote]
94+ singleQuote = "\'"
95+ arg = \case
96+ Infinite -> "NULL"; Closed x -> renderSQL x; Open x -> renderSQL x
97+ bra = \case Infinite -> "("; Closed _ -> "["; Open _ -> "("
98+ ket = \case Infinite -> ")"; Closed _ -> "]"; Open _ -> ")"
99+
100+data Bound x = Infinite | Closed x | Open x
101+ deriving
103102 ( Eq, Ord, Show, Read, GHC.Generic
104103 , Functor, Foldable, Traversable )
105− deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
106−closed, open :: Maybe x -> Bound x
107−closed = Bound True
108−open = Bound False
109−
110−data Range x
111− = Empty
112− | NonEmpty (Bound x) (Bound x)
104+
105+data Range x = Empty | NonEmpty (Bound x) (Bound x)
113106 deriving
114107 ( Eq, Ord, Show, Read, GHC.Generic
115108 , Functor, Foldable, Traversable )
@@ -118,22 +111,22 @@ type instance PG (Range x) = 'PGrange (PG x)
118111
119112(<=..<=), (<..<), (<=..<), (<..<=) :: x -> x -> Range x
120113infix 4 <=..<=, <..<, <=..<, <..<=
121−x <=..<= y = NonEmpty (closed (Just x)) (closed (Just y))
122−x <..< y = NonEmpty (open (Just x)) (open (Just y))
123−x <=..< y = NonEmpty (closed (Just x)) (open (Just y))
124−x <..<= y = NonEmpty (open (Just x)) (closed (Just y))
114+x <=..<= y = NonEmpty (Closed x) (Closed y)
115+x <..< y = NonEmpty (Open x) (Open y)
116+x <=..< y = NonEmpty (Closed x) (Open y)
117+x <..<= y = NonEmpty (Open x) (Closed y)
125118
126119moreThan, atLeast, lessThan, atMost :: x -> Range x
127−moreThan x = NonEmpty (open (Just x)) (open Nothing)
128−atLeast x = NonEmpty (closed (Just x)) (open Nothing)
129−lessThan x = NonEmpty (open Nothing) (open (Just x))
130−atMost x = NonEmpty (open Nothing) (closed (Just x))
120+moreThan x = NonEmpty (Open x) Infinite
121+atLeast x = NonEmpty (Closed x) Infinite
122+lessThan x = NonEmpty Infinite (Open x)
123+atMost x = NonEmpty Infinite (Closed x)
131124
132125singleton :: x -> Range x
133126singleton x = x <=..<= x
134127
135128whole :: Range x
136−whole = NonEmpty (open Nothing) (open Nothing)
129+whole = NonEmpty Infinite Infinite
137130
138131(<@.) :: Operator ('NotNull ty) (null ('PGrange ty)) ('Null 'PGbool)
139132(<@.) = unsafeBinaryOp "<@"
@@ -168,10 +161,10 @@ whole = NonEmpty (open Nothing) (open Nothing)
168161(-.) :: Operator (null ('PGrange ty)) (null ('PGrange ty)) (null ('PGrange ty))
169162(-.) = unsafeBinaryOp "-"
170163
171−lowerBound :: null ('PGrange ty) :--> null ty
164+lowerBound :: null ('PGrange ty) :--> 'Null ty
172165lowerBound = unsafeFunction "lower"
173166
174−upperBound :: null ('PGrange ty) :--> null ty
167+upperBound :: null ('PGrange ty) :--> 'Null ty
175168upperBound = unsafeFunction "upper"
176169
177170isEmpty :: null ('PGrange ty) :--> 'Null 'PGbool