@@ -1,3 +1,13 @@
1+{-|
2+Module: Squeal.PostgreSQL.Expression.Json
3+Description: Json and Jsonb functions and operators
4+Copyright: (c) Eitan Chatav, 2019
5+Maintainer: eitan@morphism.tech
6+Stability: experimental
7+
8+Json and Jsonb functions and operators
9+-}
10+
111{-# LANGUAGE
212 DataKinds
313 , FlexibleContexts
@@ -11,6 +21,7 @@
1121 , TypeApplications
1222 , TypeOperators
1323 , UndecidableInstances
24+ , UndecidableSuperClasses
1425#-}
1526
1627module Squeal.PostgreSQL.Expression.Json
@@ -32,19 +43,13 @@ module Squeal.PostgreSQL.Expression.Json
3243 , rowToJson
3344 , jsonBuildArray
3445 , jsonbBuildArray
35− , PGBuildObject
36− , jsonBuildObject
37− , jsonbBuildObject
46+ , JsonBuildObject (..)
3847 , jsonObject
3948 , jsonbObject
4049 , jsonZipObject
4150 , jsonbZipObject
4251 , jsonArrayLength
4352 , jsonbArrayLength
44− , jsonExtractPath
45− , jsonbExtractPath
46− , jsonExtractPathAsText
47− , jsonbExtractPathAsText
4853 , jsonTypeof
4954 , jsonbTypeof
5055 , jsonStripNulls
@@ -59,10 +64,12 @@ module Squeal.PostgreSQL.Expression.Json
5964 , jsonbEachText
6065 , jsonObjectKeys
6166 , jsonbObjectKeys
67+ , JsonPopulateFunction
6268 , jsonPopulateRecord
6369 , jsonbPopulateRecord
6470 , jsonPopulateRecordSet
6571 , jsonbPopulateRecordSet
72+ , JsonToRecordFunction
6673 , jsonToRecord
6774 , jsonbToRecord
6875 , jsonToRecordSet
@@ -149,18 +156,18 @@ infixl 9 .?&
149156
150157-- | Delete a key or keys from a JSON object, or remove an array element.
151158--
152−-- If the right operand is..
159+-- If the right operand is
153160--
154−-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs
155−-- are matched based on their key value.
161+-- @ text @: Delete key / value pair or string element from left operand.
162+-- Key / value pairs are matched based on their key value,
156163--
157−-- @ text[] @: Delete multiple key/value pairs or string elements
158−-- from left operand. Key/value pairs are matched based on their key value.
164+-- @ text[] @: Delete multiple key / value pairs or string elements
165+-- from left operand. Key / value pairs are matched based on their key value,
159166--
160167-- @ integer @: Delete the array element with specified index (Negative integers
161168-- count from the end). Throws an error if top level container is not an array.
162169(.-.)
163− :: (key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]) -- hlint error without parens here
170+ :: key `In` '[ 'PGtext, 'PGvararray ('NotNull 'PGtext), 'PGint4, 'PGint2 ]
164171 => Operator (null 'PGjsonb) (null key) (null 'PGjsonb)
165172infixl 6 .-.
166173(.-.) = unsafeBinaryOp "-"
@@ -212,26 +219,20 @@ jsonBuildArray = unsafeFunctionN "json_build_array"
212219jsonbBuildArray :: SOP.SListI tuple => FunctionN tuple (null 'PGjsonb)
213220jsonbBuildArray = unsafeFunctionN "jsonb_build_array"
214221
215−class PGBuildObject tys where
216−instance PGBuildObject '[]
217−instance (PGBuildObject tys, key `In` PGJsonKey)
218− => PGBuildObject ('NotNull key ': value ': tys)
219−
220222-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
221223-- argument list. The elements of the argument list must alternate between text
222224-- and values.
223−jsonBuildObject
224− :: (SOP.SListI elems, PGBuildObject elems)
225− => FunctionN elems (null 'PGjson)
226−jsonBuildObject = unsafeFunctionN "json_build_object"
227−
228−-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a
229−-- variadic argument list. The elements of the argument list must alternate
230−-- between keys and values.
231−jsonbBuildObject
232− :: (SOP.SListI elems, PGBuildObject elems)
233− => FunctionN elems (null 'PGjsonb)
234−jsonbBuildObject = unsafeFunctionN "jsonb_build_object"
225+class SOP.SListI tys => JsonBuildObject tys where
226+
227+ jsonBuildObject :: FunctionN tys (null 'PGjson)
228+ jsonBuildObject = unsafeFunctionN "json_build_object"
229+
230+ jsonbBuildObject :: FunctionN tys (null 'PGjsonb)
231+ jsonbBuildObject = unsafeFunctionN "jsonb_build_object"
232+
233+instance JsonBuildObject '[]
234+instance (JsonBuildObject tys, key `In` PGJsonKey)
235+ => JsonBuildObject ('NotNull key ': value ': tys)
235236
236237-- | Builds a JSON object out of a text array.
237238-- The array must have two dimensions
@@ -280,46 +281,6 @@ jsonArrayLength = unsafeFunction "json_array_length"
280281jsonbArrayLength :: null 'PGjsonb :--> null 'PGint4
281282jsonbArrayLength = unsafeFunction "jsonb_array_length"
282283
283−-- | Returns JSON value pointed to by the given path (equivalent to #>
284−-- operator).
285−jsonExtractPath
286− :: SOP.SListI elems
287− => Expression outer commons grp schemas params from (null 'PGjson)
288− -> NP (Expression outer commons grp schemas params from) elems
289− -> Expression outer commons grp schemas params from (null 'PGjsonb)
290−jsonExtractPath x xs =
291− unsafeFunctionN "json_extract_path" (x :* xs)
292−
293−-- | Returns JSON value pointed to by the given path (equivalent to #>
294−-- operator).
295−jsonbExtractPath
296− :: SOP.SListI elems
297− => Expression outer commons grp schemas params from (null 'PGjsonb)
298− -> NP (Expression outer commons grp schemas params from) elems
299− -> Expression outer commons grp schemas params from (null 'PGjsonb)
300−jsonbExtractPath x xs =
301− unsafeFunctionN "jsonb_extract_path" (x :* xs)
302−
303−-- | Returns JSON value pointed to by the given path (equivalent to #>
304−-- operator), as text.
305−jsonExtractPathAsText
306− :: SOP.SListI elems
307− => Expression outer commons grp schemas params from (null 'PGjson)
308− -> NP (Expression outer commons grp schemas params from) elems
309− -> Expression outer commons grp schemas params from (null 'PGjson)
310−jsonExtractPathAsText x xs =
311− unsafeFunctionN "json_extract_path_text" (x :* xs)
312−
313−-- | Returns JSON value pointed to by the given path (equivalent to #>
314−-- operator), as text.
315−jsonbExtractPathAsText
316− :: SOP.SListI elems
317− => Expression outer commons grp schemas params from (null 'PGjsonb)
318− -> NP (Expression outer commons grp schemas params from) elems
319− -> Expression outer commons grp schemas params from (null 'PGjsonb)
320−jsonbExtractPathAsText x xs =
321− unsafeFunctionN "jsonb_extract_path_text" (x :* xs)
322−
323284-- | Returns the type of the outermost JSON value as a text string. Possible
324285-- types are object, array, string, number, boolean, and null.
325286jsonTypeof :: null 'PGjson :--> null 'PGtext
@@ -342,38 +303,36 @@ jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
342303
343304-- | @ jsonbSet target path new_value create_missing @
344305--
345−-- Returns target with the section designated by path replaced by new_value,
346−-- or with new_value added if create_missing is true ( default is true) and the
306+-- Returns target with the section designated by path replaced by @new_value@,
307+-- or with @new_value@ added if create_missing is
308+-- `Squeal.PostgreSQL.Expression.Logic.true` and the
347309-- item designated by path does not exist. As with the path orientated
348310-- operators, negative integers that appear in path count from the end of JSON
349311-- arrays.
350312jsonbSet
351− :: Expression outer commons grp schemas params from (null 'PGjsonb)
352− -> Expression outer commons grp schemas params from (null ('PGvararray ('NotNull 'PGtext)))
353− -> Expression outer commons grp schemas params from (null 'PGjsonb)
354− -> Maybe (Expression outer commons grp schemas params from (null 'PGbool))
355− -> Expression outer commons grp schemas params from (null 'PGjsonb)
356−jsonbSet tgt path val createMissing = case createMissing of
357− Just m -> unsafeFunctionN "jsonb_set" (tgt :* path :* val :* m :* Nil)
358− Nothing -> unsafeFunctionN "jsonb_set" (tgt :* path :* val :* Nil)
313+ :: FunctionN
314+ '[ null 'PGjsonb
315+ , null ('PGvararray ('NotNull 'PGtext))
316+ , null 'PGjsonb
317+ , null 'PGbool ] (null 'PGjsonb)
318+jsonbSet = unsafeFunctionN "jsonbSet"
359319
360320-- | @ jsonbInsert target path new_value insert_after @
361321--
362−-- Returns target with new_value inserted. If target section designated by
363−-- path is in a JSONB array, new_value will be inserted before target or after
364−-- if insert_after is true (default is false). If target section designated by
365−-- path is in JSONB object, new_value will be inserted only if target does not
322+-- Returns target with @new_value@ inserted. If target section designated by
323+-- path is in a JSONB array, @new_value@ will be inserted before target or after
324+-- if @insert_after@ is `Squeal.PostgreSQL.Expression.Logic.true`.
325+-- If target section designated by
326+-- path is in JSONB object, @new_value@ will be inserted only if target does not
366327-- exist. As with the path orientated operators, negative integers that appear
367328-- in path count from the end of JSON arrays.
368329jsonbInsert
369− :: Expression outer commons grp schemas params from (null 'PGjsonb)
370− -> Expression outer commons grp schemas params from (null ('PGvararray ('NotNull 'PGtext)))
371− -> Expression outer commons grp schemas params from (null 'PGjsonb)
372− -> Maybe (Expression outer commons grp schemas params from (null 'PGbool))
373− -> Expression outer commons grp schemas params from (null 'PGjsonb)
374−jsonbInsert tgt path val insertAfter = case insertAfter of
375− Just i -> unsafeFunctionN "jsonb_insert" (tgt :* path :* val :* i :* Nil)
376− Nothing -> unsafeFunctionN "jsonb_insert" (tgt :* path :* val :* Nil)
330+ :: FunctionN
331+ '[ null 'PGjsonb
332+ , null ('PGvararray ('NotNull 'PGtext))
333+ , null 'PGjsonb
334+ , null 'PGbool ] (null 'PGjsonb)
335+jsonbInsert = unsafeFunctionN "jsonb_insert"
377336
378337-- | Returns its argument as indented JSON text.
379338jsonbPretty :: null 'PGjsonb :--> null 'PGtext
@@ -439,55 +398,53 @@ jsonbObjectKeys
439398 '["jsonb_object_keys" ::: 'NotNull 'PGtext]
440399jsonbObjectKeys = unsafeSetOfFunction
441400
442−unsafePopulateFunction
443− :: forall fun schemas null outer commons params ty row
444− . KnownSymbol fun
445− => Alias fun
446− -> TypeExpression schemas (null ('PGcomposite row))
447− -> Expression outer commons 'Ungrouped schemas params '[] ty
401+-- | Build rows from Json types.
402+type JsonPopulateFunction fun json
403+ = forall schemas row outer commons params
404+ . json `In` PGJsonType
405+ => TypeExpression schemas ('NotNull ('PGcomposite row)) -- ^ row type
406+ -> Expression outer commons 'Ungrouped schemas params '[] ('NotNull json)
407+ -- ^ json type
448408 -> FromClause outer commons schemas params '[fun ::: row]
409+
410+unsafePopulateFunction
411+ :: forall fun ty
412+ . KnownSymbol fun => Alias fun -> JsonPopulateFunction fun ty
449413unsafePopulateFunction _fun ty expr = UnsafeFromClause $ renderSymbol @fun
450414 <> parenthesized ("null::" <> renderSQL ty <> ", " <> renderSQL expr)
451415
452416-- | Expands the JSON expression to a row whose columns match the record
453417-- type defined by the given table.
454−jsonPopulateRecord
455− :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
456− -> Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjson) -- ^ json object
457− -> FromClause outer commons schemas params '["json_populate_record" ::: row]
418+jsonPopulateRecord :: JsonPopulateFunction "json_populate_record" 'PGjson
458419jsonPopulateRecord = unsafePopulateFunction #json_populate_record
459420
460421-- | Expands the binary JSON expression to a row whose columns match the record
461422-- type defined by the given table.
462−jsonbPopulateRecord
463− :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
464− -> Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjsonb) -- ^ jsonb object
465− -> FromClause outer commons schemas params '["jsonb_populate_record" ::: row]
423+jsonbPopulateRecord :: JsonPopulateFunction "jsonb_populate_record" 'PGjsonb
466424jsonbPopulateRecord = unsafePopulateFunction #jsonb_populate_record
467425
468426-- | Expands the outermost array of objects in the given JSON expression to a
469427-- set of rows whose columns match the record type defined by the given table.
470−jsonPopulateRecordSet
471− :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
472− -> Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjson) -- ^ json array
473− -> FromClause outer commons schemas params '["json_populate_record_set" ::: row]
428+jsonPopulateRecordSet :: JsonPopulateFunction "json_populate_record_set" 'PGjson
474429jsonPopulateRecordSet = unsafePopulateFunction #json_populate_record_set
475430
476431-- | Expands the outermost array of objects in the given binary JSON expression
477432-- to a set of rows whose columns match the record type defined by the given
478433-- table.
479−jsonbPopulateRecordSet
480− :: TypeExpression schemas (nullity ('PGcomposite row)) -- ^ row type
481− -> Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjsonb) -- ^ jsonb array
482− -> FromClause outer commons schemas params '["jsonb_populate_record_set" ::: row]
434+jsonbPopulateRecordSet :: JsonPopulateFunction "jsonb_populate_record_set" 'PGjsonb
483435jsonbPopulateRecordSet = unsafePopulateFunction #jsonb_populate_record_set
484436
485−unsafeRecordFunction
486− :: (SOP.SListI record, json `In` PGJsonType)
487− => ByteString
488− -> Expression outer commons 'Ungrouped schemas params '[] (nullity json)
489− -> Aliased (NP (Aliased (TypeExpression schemas))) (tab ::: record)
490− -> FromClause outer commons schemas params '[tab ::: record]
437+-- | Build rows from Json types.
438+type JsonToRecordFunction json
439+ = forall outer commons schemas params tab row
440+ . (SOP.SListI row, json `In` PGJsonType)
441+ => Expression outer commons 'Ungrouped schemas params '[] ('NotNull json)
442+ -- ^ json type
443+ -> Aliased (NP (Aliased (TypeExpression schemas))) (tab ::: row)
444+ -- ^ row type
445+ -> FromClause outer commons schemas params '[tab ::: row]
446+
447+unsafeRecordFunction :: ByteString -> JsonToRecordFunction json
491448unsafeRecordFunction fun expr (types `As` tab) = UnsafeFromClause $
492449 fun <> parenthesized (renderSQL expr) <+> "AS" <+> renderSQL tab
493450 <> parenthesized (renderCommaSeparated renderTy types)
@@ -496,33 +453,17 @@ unsafeRecordFunction fun expr (types `As` tab) = UnsafeFromClause $
496453 renderTy (ty `As` alias) = renderSQL alias <+> renderSQL ty
497454
498455-- | Builds an arbitrary record from a JSON object.
499−jsonToRecord
500− :: SOP.SListI record
501− => Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjson) -- ^ json object
502− -> Aliased (NP (Aliased (TypeExpression schemas))) (tab ::: record)
503− -> FromClause outer commons schemas params '[tab ::: record]
456+jsonToRecord :: JsonToRecordFunction 'PGjson
504457jsonToRecord = unsafeRecordFunction "json_to_record"
505458
506459-- | Builds an arbitrary record from a binary JSON object.
507−jsonbToRecord
508− :: SOP.SListI record
509− => Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjsonb) -- ^ jsonb object
510− -> Aliased (NP (Aliased (TypeExpression schemas))) (tab ::: record)
511− -> FromClause outer commons schemas params '[tab ::: record]
460+jsonbToRecord :: JsonToRecordFunction 'PGjsonb
512461jsonbToRecord = unsafeRecordFunction "jsonb_to_record"
513462
514463-- | Builds an arbitrary set of records from a JSON array of objects.
515−jsonToRecordSet
516− :: SOP.SListI record
517− => Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjson) -- ^ json array
518− -> Aliased (NP (Aliased (TypeExpression schemas))) (tab ::: record)
519− -> FromClause outer commons schemas params '[tab ::: record]
464+jsonToRecordSet :: JsonToRecordFunction 'PGjson
520465jsonToRecordSet = unsafeRecordFunction "json_to_record_set"
521466
522467-- | Builds an arbitrary set of records from a binary JSON array of objects.
523−jsonbToRecordSet
524− :: SOP.SListI record
525− => Expression outer commons 'Ungrouped schemas params '[] (nullity 'PGjsonb) -- ^ jsonb array
526− -> Aliased (NP (Aliased (TypeExpression schemas))) (tab ::: record)
527− -> FromClause outer commons schemas params '[tab ::: record]
468+jsonbToRecordSet :: JsonToRecordFunction 'PGjsonb
528469jsonbToRecordSet = unsafeRecordFunction "jsonb_to_record_set"