@@ -58,9 +58,13 @@ module Squeal.PostgreSQL.Expression.Range
5858 , rangeMerge
5959 ) where
6060
61+import Control.Applicative
62+import BinaryParser
63+import ByteString.StrictBuilder
6164import qualified GHC.Generics as GHC
6265import qualified Generics.SOP as SOP
6366
67+import Squeal.PostgreSQL.Binary
6468import Squeal.PostgreSQL.Expression
6569import Squeal.PostgreSQL.Expression.Type hiding (bool)
6670import Squeal.PostgreSQL.PG
@@ -84,11 +88,11 @@ range
8488 -> Expression outer commons grp schemas params from (null ('PGrange ty))
8589range ty = \case
8690 Empty -> UnsafeExpression $ parenthesized
87− (empty <+> "::" <+> renderSQL ty)
91+ (emp <+> "::" <+> renderSQL ty)
8892 NonEmpty l u -> UnsafeExpression $ renderSQL ty <> parenthesized
8993 (commaSeparated (args l u))
9094 where
91− empty = singleQuote <> "empty" <> singleQuote
95+ emp = singleQuote <> "empty" <> singleQuote
9296 args l u = [arg l, arg u, singleQuote <> bra l <> ket u <> singleQuote]
9397 singleQuote = "\'"
9498 arg = \case
@@ -107,6 +111,32 @@ data Range x = Empty | NonEmpty (Bound x) (Bound x)
107111 , Functor, Foldable, Traversable )
108112 deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
109113type instance PG (Range x) = 'PGrange (PG x)
114+instance ToParam x pg => ToParam (Range x) ('PGrange pg) where
115+ toParam = \case
116+ Empty -> K (bytes "\'empty\'")
117+ NonEmpty l u -> K $ mconcat
118+ [bytes (bra l), arg l, utf8Char ',', arg u, bytes (ket u)]
119+ where
120+ arg = \case
121+ Infinite -> ""
122+ Closed x -> unK (toParam @x @pg x)
123+ Open x -> unK (toParam @x @pg x)
124+ bra = \case Infinite -> "("; Closed _ -> "["; Open _ -> "("
125+ ket = \case Infinite -> ")"; Closed _ -> "]"; Open _ -> ")"
126+instance FromValue pg y => FromValue ('PGrange pg) (Range y) where
127+ fromValue =
128+ Empty <$ unitOfBytes "\'empty\'" <|> do
129+ boundL <- boundLOpen <|> boundLClosed <|> boundLInfinite
130+ unitOfBytes ","
131+ boundR <- boundROpen <|> boundRClosed <|> boundRInfinite
132+ return $ NonEmpty boundL boundR
133+ where
134+ boundLClosed = unitOfBytes "[" *> (Closed <$> fromValue @pg @y)
135+ boundLOpen = unitOfBytes "(" *> (Open <$> fromValue @pg @y)
136+ boundLInfinite = Infinite <$ unitOfBytes "("
137+ boundRClosed = (Closed <$> fromValue @pg @y) <* unitOfBytes "]"
138+ boundROpen = (Open <$> fromValue @pg @y) <* unitOfBytes ")"
139+ boundRInfinite = Infinite <$ unitOfBytes ")"
110140
111141(<=..<=), (<..<), (<=..<), (<..<=) :: x -> x -> Range x
112142infix 4 <=..<=, <..<, <=..<, <..<=