@@ -60,7 +60,7 @@ module Squeal.PostgreSQL.Expression
6060 , unsafeUnaryOpL
6161 , unsafeUnaryOpR
6262 , unsafeFunction
63− , unsafeVariadicFunction
63+ , unsafeFunctionHet
6464 , atan2_
6565 , cast
6666 , quot_
@@ -136,6 +136,7 @@ module Squeal.PostgreSQL.Expression
136136 , rowToJson
137137 , jsonBuildArray
138138 , jsonbBuildArray
139+ , PGBuildObject
139140 , jsonBuildObject
140141 , jsonbBuildObject
141142 , jsonObject
@@ -296,11 +297,17 @@ instance RenderSQL (Expression outer grp commons schemas params from ty) where
296297 renderSQL = renderExpression
297298
298299-- | An `Expr` is a closed `Expression`.
300+-- It is a F`RankNType` but don't be scared.
301+-- Think of it as an expression which sees no
302+-- namespaces, so you can't use parameters
303+-- or alias references. It can be used as
304+-- a simple piece of more complex `Expression`s.
299305type Expr x
300306 = forall outer grp commons schemas params from
301307 . Expression outer grp commons schemas params from x
302308 -- ^ cannot reference aliases
303309
310+-- | A `RankNType` for binary operators.
304311type Operator x1 x2 y
305312 = forall outer grp commons schemas params from
306313 . Expression outer grp commons schemas params from x1
@@ -310,6 +317,11 @@ type Operator x1 x2 y
310317 -> Expression outer grp commons schemas params from y
311318 -- ^ output
312319
320+-- | A `RankNType` for functions with a single argument.
321+-- These could be either function calls or unary operators.
322+-- This is a subtype of the usual Haskell function type `Prelude.->`,
323+-- indeed a subcategory as it is closed under the usual
324+-- `Prelude..` and `Prelude.id`.
313325type (:-->) x y
314326 = forall outer grp commons schemas params from
315327 . Expression outer grp commons schemas params from x
@@ -658,16 +670,6 @@ unsafeFunctionHet
658670unsafeFunctionHet fun xs = UnsafeExpression $
659671 fun <> parenthesized (renderCommaSeparated renderSQL xs)
660672
661−-- | Helper for defining variadic functions.
662−unsafeVariadicFunction
663− :: SListI elems
664− => ByteString
665− -- ^ function
666− -> NP (Expression outer grp commons schemas params from) elems
667− -> Expression outer grp commons schemas params from ret
668−unsafeVariadicFunction fun x = UnsafeExpression $
669− fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderSQL) x)))
670−
671673instance ty `In` PGNum
672674 => Num (Expression outer grp commons schemas params from (null ty)) where
673675 (+) = unsafeBinaryOp "+"
@@ -911,8 +913,7 @@ infix 4 .<=
911913(.>) = unsafeBinaryOp ">"
912914infix 4 .>
913915
914−{- | between
915−>>> printSQL $ true `between` (null_, false)
916+{- | >>> printSQL $ true `between` (null_, false)
916917TRUE BETWEEN NULL AND FALSE
917918-}
918919between
@@ -923,8 +924,7 @@ between
923924between a (x,y) = UnsafeExpression $ renderSQL a <+> "BETWEEN"
924925 <+> renderSQL x <+> "AND" <+> renderSQL y
925926
926−{- | not between
927−>>> printSQL $ true `notBetween` (null_, false)
927+{- | >>> printSQL $ true `notBetween` (null_, false)
928928TRUE NOT BETWEEN NULL AND FALSE
929929-}
930930notBetween
@@ -936,6 +936,7 @@ notBetween a (x,y) = UnsafeExpression $ renderSQL a <+> "NOT BETWEEN"
936936 <+> renderSQL x <+> "AND" <+> renderSQL y
937937
938938{- | between, after sorting the comparison values
939+
939940>>> printSQL $ true `betweenSymmetric` (null_, false)
940941TRUE BETWEEN SYMMETRIC NULL AND FALSE
941942-}
@@ -948,6 +949,7 @@ betweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
948949 <+> "BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
949950
950951{- | not between, after sorting the comparison values
952+
951953>>> printSQL $ true `notBetweenSymmetric` (null_, false)
952954TRUE NOT BETWEEN SYMMETRIC NULL AND FALSE
953955-}
@@ -960,6 +962,7 @@ notBetweenSymmetric a (x,y) = UnsafeExpression $ renderSQL a
960962 <+> "NOT BETWEEN SYMMETRIC" <+> renderSQL x <+> "AND" <+> renderSQL y
961963
962964{- | not equal, treating null like an ordinary value
965+
963966>>> printSQL $ true `isDistinctFrom` null_
964967(TRUE IS DISTINCT FROM NULL)
965968-}
@@ -967,6 +970,7 @@ isDistinctFrom :: Operator (null0 ty) (null1 ty) ('Null 'PGbool)
967970isDistinctFrom = unsafeBinaryOp "IS DISTINCT FROM"
968971
969972{- | equal, treating null like an ordinary value
973+
970974>>> printSQL $ true `isNotDistinctFrom` null_
971975(TRUE IS NOT DISTINCT FROM NULL)
972976-}
@@ -974,6 +978,7 @@ isNotDistinctFrom :: Operator (null0 ty) (null1 ty) ('NotNull 'PGbool)
974978isNotDistinctFrom = unsafeBinaryOp "IS NOT DISTINCT FROM"
975979
976980{- | is true
981+
977982>>> printSQL $ true & isTrue
978983(TRUE IS TRUE)
979984-}
@@ -981,6 +986,7 @@ isTrue :: null0 'PGbool :--> null1 'PGbool
981986isTrue = unsafeUnaryOpR "IS TRUE"
982987
983988{- | is false or unknown
989+
984990>>> printSQL $ true & isNotTrue
985991(TRUE IS NOT TRUE)
986992-}
@@ -988,6 +994,7 @@ isNotTrue :: null0 'PGbool :--> null1 'PGbool
988994isNotTrue = unsafeUnaryOpR "IS NOT TRUE"
989995
990996{- | is false
997+
991998>>> printSQL $ true & isFalse
992999(TRUE IS FALSE)
9931000-}
@@ -995,6 +1002,7 @@ isFalse :: null0 'PGbool :--> null1 'PGbool
9951002isFalse = unsafeUnaryOpR "IS FALSE"
9961003
9971004{- | is true or unknown
1005+
9981006>>> printSQL $ true & isNotFalse
9991007(TRUE IS NOT FALSE)
10001008-}
@@ -1002,6 +1010,7 @@ isNotFalse :: null0 'PGbool :--> null1 'PGbool
10021010isNotFalse = unsafeUnaryOpR "IS NOT FALSE"
10031011
10041012{- | is unknown
1013+
10051014>>> printSQL $ true & isUnknown
10061015(TRUE IS UNKNOWN)
10071016-}
@@ -1009,6 +1018,7 @@ isUnknown :: null0 'PGbool :--> null1 'PGbool
10091018isUnknown = unsafeUnaryOpR "IS UNKNOWN"
10101019
10111020{- | is true or false
1021+
10121022>>> printSQL $ true & isNotUnknown
10131023(TRUE IS NOT UNKNOWN)
10141024-}
@@ -1145,15 +1155,15 @@ infixl 8 .->>
11451155
11461156-- | Get JSON value at a specified path.
11471157(.#>)
1148− :: (json `In` PGJsonType, PGTextArray "(.#>)" path)
1149− => Operator (null json) (null path) ('Null json)
1158+ :: json `In` PGJsonType
1159+ => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null json)
11501160infixl 8 .#>
11511161(.#>) = unsafeBinaryOp "#>"
11521162
11531163-- | Get JSON value at a specified path as text.
11541164(.#>>)
1155− :: (json `In` PGJsonType, PGTextArray "(.#>>)" path)
1156− => Operator (null json) (null path) ('Null 'PGtext)
1165+ :: json `In` PGJsonType
1166+ => Operator (null json) (null ('PGvararray ('NotNull 'PGtext))) ('Null 'PGtext)
11571167infixl 8 .#>>
11581168(.#>>) = unsafeBinaryOp "#>>"
11591169
@@ -1214,9 +1224,7 @@ infixl 6 .-.
12141224
12151225-- | Delete the field or element with specified path (for JSON arrays, negative
12161226-- integers count from the end)
1217−(#-.)
1218− :: PGTextArray "(#-.)" arrayty
1219− => Operator (null 'PGjsonb) (null arrayty) (null 'PGjsonb)
1227+(#-.) :: Operator (null 'PGjsonb) (null ('PGvararray ('NotNull 'PGtext))) (null 'PGjsonb)
12201228infixl 6 #-.
12211229(#-.) = unsafeBinaryOp "#-"
12221230
@@ -1254,9 +1262,7 @@ toJsonb = unsafeFunction "to_jsonb"
12541262
12551263-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
12561264-- becomes a JSON array of arrays.
1257−arrayToJson
1258− :: PGArray "arrayToJson" arr
1259− => null arr :--> null 'PGjson
1265+arrayToJson :: null ('PGvararray ty) :--> null 'PGjson
12601266arrayToJson = unsafeFunction "array_to_json"
12611267
12621268-- | Returns the row as a JSON object.
@@ -1265,98 +1271,69 @@ rowToJson = unsafeFunction "row_to_json"
12651271
12661272-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
12671273-- argument list.
1268−jsonBuildArray
1269− :: SListI elems
1270− => NP (Expression outer grp commons schemas params from) elems
1271− -> Expression outer grp commons schemas params from (null 'PGjson)
1272−jsonBuildArray = unsafeVariadicFunction "json_build_array"
1274+jsonBuildArray :: SListI tuple => FunctionHet tuple (null 'PGjson)
1275+jsonBuildArray = unsafeFunctionHet "json_build_array"
12731276
12741277-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
12751278-- variadic argument list.
1276−jsonbBuildArray
1277− :: SListI elems
1278− => NP (Expression outer grp commons schemas params from) elems
1279− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1280−jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"
1281−
1282−unsafeRowFunction
1283− :: SOP.SListI elems
1284− => NP (Aliased (Expression outer grp commons schemas params from)) elems
1285− -> [ByteString]
1286−unsafeRowFunction =
1287− (`appEndo` []) . hcfoldMap (Proxy :: SOP.Proxy SOP.Top)
1288− (\(col `As` name) -> Endo $ \xs ->
1289− renderAliasString name : renderSQL col : xs)
1290− where
1291− renderAliasString :: KnownSymbol alias => Alias alias -> ByteString
1292− renderAliasString = singleQuotedText . fromString . symbolVal
1279+jsonbBuildArray :: SListI tuple => FunctionHet tuple (null 'PGjsonb)
1280+jsonbBuildArray = unsafeFunctionHet "jsonb_build_array"
1281+
1282+class PGBuildObject tys where
1283+instance PGBuildObject '[]
1284+instance (PGBuildObject tys, key `In` PGJsonKey)
1285+ => PGBuildObject ('NotNull key ': value ': tys)
12931286
12941287-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
12951288-- argument list. The elements of the argument list must alternate between text
12961289-- and values.
12971290jsonBuildObject
1298− :: SOP.SListI elems
1299− => NP (Aliased (Expression outer grp commons schemas params from)) elems
1300− -> Expression outer grp commons schemas params from (null 'PGjson)
1301−jsonBuildObject
1302− = unsafeFunction "json_build_object"
1303− . UnsafeExpression
1304− . commaSeparated
1305− . unsafeRowFunction
1291+ :: (SListI elems, PGBuildObject elems)
1292+ => FunctionHet elems (null 'PGjson)
1293+jsonBuildObject = unsafeFunctionHet "json_build_object"
13061294
13071295-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a
13081296-- variadic argument list. The elements of the argument list must alternate
1309−-- between text and values.
1297+-- between keys and values.
13101298jsonbBuildObject
1311− :: SOP.SListI elems
1312− => NP (Aliased (Expression outer grp commons schemas params from)) elems
1313− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1314−jsonbBuildObject
1315− = unsafeFunction "jsonb_build_object"
1316− . UnsafeExpression
1317− . commaSeparated
1318− . unsafeRowFunction
1319−
1320−-- | Builds a JSON object out of a text array. The array must have either
1321−-- exactly one dimension with an even number of members, in which case they are
1322−-- taken as alternating key/value pairs, or two dimensions such that each inner
1323−-- array has exactly two elements, which are taken as a key/value pair.
1299+ :: (SListI elems, PGBuildObject elems)
1300+ => FunctionHet elems (null 'PGjsonb)
1301+jsonbBuildObject = unsafeFunctionHet "jsonb_build_object"
1302+
1303+-- | Builds a JSON object out of a text array.
1304+-- The array must have two dimensions
1305+-- such that each inner array has exactly two elements,
1306+-- which are taken as a key/value pair.
13241307jsonObject
1325− :: PGArrayOf "jsonObject" arr ('NotNull 'PGtext)
1326− => null arr :--> null 'PGjson
1308+ :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
1309+ :--> null 'PGjson
13271310jsonObject = unsafeFunction "json_object"
13281311
1329−-- | Builds a binary JSON object out of a text array. The array must have either
1330−-- exactly one dimension with an even number of members, in which case they are
1331−-- taken as alternating key/value pairs, or two dimensions such that each inner
1332−-- array has exactly two elements, which are taken as a key/value pair.
1312+-- | Builds a binary JSON object out of a text array.
1313+-- The array must have two dimensions
1314+-- such that each inner array has exactly two elements,
1315+-- which are taken as a key/value pair.
13331316jsonbObject
1334− :: PGArrayOf "jsonbObject" arr ('NotNull 'PGtext)
1335− => null arr :--> null 'PGjsonb
1317+ :: null ('PGfixarray '[n,2] ('NotNull 'PGtext))
1318+ :--> null 'PGjsonb
13361319jsonbObject = unsafeFunction "jsonb_object"
13371320
13381321-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
13391322-- keys and one for values, that are zipped pairwise to create a JSON object.
1340−jsonZipObject
1341− :: ( PGArrayOf "jsonZipObject" keysArray ('NotNull 'PGtext)
1342− , PGArrayOf "jsonZipObject" valuesArray ('NotNull 'PGtext))
1343− => Expression outer grp commons schemas params from (null keysArray)
1344− -> Expression outer grp commons schemas params from (null valuesArray)
1345− -> Expression outer grp commons schemas params from (null 'PGjson)
1346−jsonZipObject ks vs =
1347− unsafeVariadicFunction "json_object" (ks :* vs :* Nil)
1323+jsonZipObject :: FunctionHet
1324+ '[ null ('PGvararray ('NotNull 'PGtext))
1325+ , null ('PGvararray ('NotNull 'PGtext)) ]
1326+ ( null 'PGjson )
1327+jsonZipObject = unsafeFunctionHet "json_object"
13481328
1349−-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1329+-- | This is an alternate form of 'jsonbObject' that takes two arrays; one for
13501330-- keys and one for values, that are zipped pairwise to create a binary JSON
13511331-- object.
1352−jsonbZipObject
1353− :: ( PGArrayOf "jsonbZipObject" keysArray ('NotNull 'PGtext)
1354− , PGArrayOf "jsonbZipObject" valuesArray ('NotNull 'PGtext))
1355− => Expression outer grp commons schemas params from (null keysArray)
1356− -> Expression outer grp commons schemas params from (null valuesArray)
1357− -> Expression outer grp commons schemas params from (null 'PGjsonb)
1358−jsonbZipObject ks vs =
1359− unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)
1332+jsonbZipObject :: FunctionHet
1333+ '[ null ('PGvararray ('NotNull 'PGtext))
1334+ , null ('PGvararray ('NotNull 'PGtext)) ]
1335+ ( null 'PGjsonb )
1336+jsonbZipObject = unsafeFunctionHet "jsonb_object"
13601337
13611338{-----------------------------------------
13621339Table 9.46: JSON processing functions
@@ -1378,7 +1355,7 @@ jsonExtractPath
13781355 -> NP (Expression outer grp commons schemas params from) elems
13791356 -> Expression outer grp commons schemas params from (null 'PGjsonb)
13801357jsonExtractPath x xs =
1381− unsafeVariadicFunction "json_extract_path" (x :* xs)
1358+ unsafeFunctionHet "json_extract_path" (x :* xs)
13821359
13831360-- | Returns JSON value pointed to by the given path (equivalent to #>
13841361-- operator).
@@ -1388,7 +1365,7 @@ jsonbExtractPath
13881365 -> NP (Expression outer grp commons schemas params from) elems
13891366 -> Expression outer grp commons schemas params from (null 'PGjsonb)
13901367jsonbExtractPath x xs =
1391− unsafeVariadicFunction "jsonb_extract_path" (x :* xs)
1368+ unsafeFunctionHet "jsonb_extract_path" (x :* xs)
13921369
13931370-- | Returns JSON value pointed to by the given path (equivalent to #>
13941371-- operator), as text.
@@ -1398,7 +1375,7 @@ jsonExtractPathAsText
13981375 -> NP (Expression outer grp commons schemas params from) elems
13991376 -> Expression outer grp commons schemas params from (null 'PGjson)
14001377jsonExtractPathAsText x xs =
1401− unsafeVariadicFunction "json_extract_path_text" (x :* xs)
1378+ unsafeFunctionHet "json_extract_path_text" (x :* xs)
14021379
14031380-- | Returns JSON value pointed to by the given path (equivalent to #>
14041381-- operator), as text.
@@ -1408,7 +1385,7 @@ jsonbExtractPathAsText
14081385 -> NP (Expression outer grp commons schemas params from) elems
14091386 -> Expression outer grp commons schemas params from (null 'PGjsonb)
14101387jsonbExtractPathAsText x xs =
1411− unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)
1388+ unsafeFunctionHet "jsonb_extract_path_text" (x :* xs)
14121389
14131390-- | Returns the type of the outermost JSON value as a text string. Possible
14141391-- types are object, array, string, number, boolean, and null.
@@ -1438,15 +1415,14 @@ jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
14381415-- operators, negative integers that appear in path count from the end of JSON
14391416-- arrays.
14401417jsonbSet
1441− :: PGTextArray "jsonbSet" arr
1442− => Expression outer grp commons schemas params from (null 'PGjsonb)
1443− -> Expression outer grp commons schemas params from (null arr)
1418+ :: Expression outer grp commons schemas params from (null 'PGjsonb)
1419+ -> Expression outer grp commons schemas params from (null ('PGvararray ('NotNull 'PGtext)))
14441420 -> Expression outer grp commons schemas params from (null 'PGjsonb)
14451421 -> Maybe (Expression outer grp commons schemas params from (null 'PGbool))
14461422 -> Expression outer grp commons schemas params from (null 'PGjsonb)
14471423jsonbSet tgt path val createMissing = case createMissing of
1448− Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)
1449− Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)
1424+ Just m -> unsafeFunctionHet "jsonb_set" (tgt :* path :* val :* m :* Nil)
1425+ Nothing -> unsafeFunctionHet "jsonb_set" (tgt :* path :* val :* Nil)
14501426
14511427-- | @ jsonbInsert target path new_value insert_after @
14521428--
@@ -1457,15 +1433,14 @@ jsonbSet tgt path val createMissing = case createMissing of
14571433-- exist. As with the path orientated operators, negative integers that appear
14581434-- in path count from the end of JSON arrays.
14591435jsonbInsert
1460− :: PGTextArray "jsonbInsert" arr
1461− => Expression outer grp commons schemas params from (null 'PGjsonb)
1462− -> Expression outer grp commons schemas params from (null arr)
1436+ :: Expression outer grp commons schemas params from (null 'PGjsonb)
1437+ -> Expression outer grp commons schemas params from (null ('PGvararray ('NotNull 'PGtext)))
14631438 -> Expression outer grp commons schemas params from (null 'PGjsonb)
14641439 -> Maybe (Expression outer grp commons schemas params from (null 'PGbool))
14651440 -> Expression outer grp commons schemas params from (null 'PGjsonb)
14661441jsonbInsert tgt path val insertAfter = case insertAfter of
1467− Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1468− Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)
1442+ Just i -> unsafeFunctionHet "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1443+ Nothing -> unsafeFunctionHet "jsonb_insert" (tgt :* path :* val :* Nil)
14691444
14701445-- | Returns its argument as indented JSON text.
14711446jsonbPretty :: null 'PGjsonb :--> null 'PGtext