@@ -11,6 +11,7 @@ Squeal expressions are the atoms used to build statements.
1111{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
1212{-# LANGUAGE
1313 AllowAmbiguousTypes
14+ , ConstraintKinds
1415 , DeriveGeneric
1516 , FlexibleContexts
1617 , FlexibleInstances
@@ -477,6 +478,14 @@ unsafeFunction
477478unsafeFunction fun x = UnsafeExpression $
478479 fun <> parenthesized (renderExpression x)
479480
481+unsafeVariadicFunction
482+ :: ByteString
483+ -- ^ function
484+ -> [Expression schema relations grouping params xty]
485+ -> Expression schema relations grouping params (yty)
486+unsafeVariadicFunction fun x = UnsafeExpression $
487+ fun <> parenthesized (commaSeparated (map renderExpression x))
488+
480489instance PGNum ty
481490 => Num (Expression schema relations grouping params (nullity ty)) where
482491 (+) = unsafeBinaryOp "+"
@@ -865,6 +874,168 @@ like
865874 -> Expression schema relations grouping params (nullity 'PGbool)
866875like = unsafeBinaryOp "LIKE"
867876
877+{-----------------------------------------
878+json and jsonb operators
879+see https://www.postgresql.org/docs/10/static/functions-json.html
880+-----------------------------------------}
881+
882+type IsJSONKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]
883+type IsJSON json = json `In` '[ 'PGjson, 'PGjsonb ]
884+
885+class IsArray arr => IsArrayOf arr ty
886+instance arrTy ~ expectTy => IsArrayOf ('PGvararray arrTy) expectTy
887+instance arrTy ~ expectTy => IsArrayOf ('PGfixarray n arrTy) expectTy
888+
889+-- IsArray will generate nicer error messages when it is all that is required.
890+class IsArray arr
891+instance IsArray ('PGvararray x)
892+instance IsArray ('PGfixarray n x)
893+
894+type IsPGtextArray arr = IsArrayOf arr 'PGtext
895+
896+-- | Get JSON value (object field or array element) at a key.
897+(.->)
898+ :: (IsJSON json, IsJSONKey key)
899+ => Expression schema relations grouping params (jnull json)
900+ -> Expression schema relations grouping params (knull key)
901+ -> Expression schema relations grouping params ('Null json)
902+(.->) = unsafeBinaryOp "->"
903+
904+-- | Get JSON value (object field or array element) at a key, as text.
905+(.->>)
906+ :: (IsJSON json, IsJSONKey key)
907+ => Expression schema relations grouping params (jnull json)
908+ -> Expression schema relations grouping params (knull key)
909+ -> Expression schema relations grouping params ('Null 'PGtext)
910+(.->>) = unsafeBinaryOp "->>"
911+
912+-- | Get JSON value at a specified path.
913+(.#>)
914+ :: (IsJSON json, IsPGtextArray path)
915+ => Expression schema relations grouping params (jnull json)
916+ -> Expression schema relations grouping params (knull path)
917+ -> Expression schema relations grouping params ('Null json)
918+(.#>) = unsafeBinaryOp "#>"
919+
920+-- | Get JSON value at a specified path as text.
921+(.#>>)
922+ :: (IsJSON json, IsPGtextArray path)
923+ => Expression schema relations grouping params (jnull json)
924+ -> Expression schema relations grouping params (knull path)
925+ -> Expression schema relations grouping params ('Null 'PGtext)
926+(.#>>) = unsafeBinaryOp "#>"
927+
928+-- Additional jsonb operators
929+
930+-- | Or operator for nulls; if either argument is null, then the result is null.
931+type family Null2 a b where
932+ Null2 'Null a = 'Null
933+ Null2 a 'Null = 'Null
934+ Null2 'NotNull 'NotNull = 'NotNull
935+
936+-- | See 'Null2'
937+type family NullOfN xs where
938+ NullOfN ('Null ty:xs) = 'Null
939+ NullOfN (x:xs) = NullOfN xs
940+ NullOfN '[] = 'NotNull
941+
942+-- | Does the left JSON value contain the right JSON path/value entries at the
943+-- top level?
944+(.@>)
945+ :: Expression schema relations grouping params (null0 'PGjsonb)
946+ -> Expression schema relations grouping params (null1 'PGjsonb)
947+ -> Expression schema relations grouping params (Null2 null0 null1 'PGbool)
948+(.@>) = unsafeBinaryOp "@>"
949+
950+-- | Are the left JSON path/value entries contained at the top level within the
951+-- right JSON value?
952+(.<@)
953+ :: Expression schema relations grouping params (null0 'PGjsonb)
954+ -> Expression schema relations grouping params (null1 'PGjsonb)
955+ -> Expression schema relations grouping params (Null2 null0 null1 'PGbool)
956+(.<@) = unsafeBinaryOp "<@"
957+
958+-- | Does the string exist as a top-level key within the JSON value?
959+(.?)
960+ :: Expression schema relations grouping params (null0 'PGjsonb)
961+ -> Expression schema relations grouping params (null1 'PGtext)
962+ -> Expression schema relations grouping params (Null2 null0 null1 'PGbool)
963+(.?) = unsafeBinaryOp "?"
964+
965+-- | Do any of these array strings exist as top-level keys?
966+(.?|)
967+ :: Expression schema relations grouping params (null0 'PGjsonb)
968+ -> Expression schema relations grouping params (null1 ('PGvararray 'PGtext))
969+ -> Expression schema relations grouping params (Null2 null0 null1 'PGbool)
970+(.?|) = unsafeBinaryOp "?|"
971+
972+-- | Do all of these array strings exist as top-level keys?
973+(.?&)
974+ :: Expression schema relations grouping params (null0 'PGjsonb)
975+ -> Expression schema relations grouping params (null1 ('PGvararray 'PGtext))
976+ -> Expression schema relations grouping params (Null2 null0 null1 'PGbool)
977+(.?&) = unsafeBinaryOp "?&"
978+
979+-- | Concatenate two jsonb values into a new jsonb value
980+(.||.)
981+ :: Expression schema relations grouping params (null0 'PGjsonb)
982+ -> Expression schema relations grouping params (null1 'PGjsonb)
983+ -> Expression schema relations grouping params (Null2 null0 null1 'PGjsonb)
984+(.||.) = unsafeBinaryOp "||"
985+
986+-- | Delete a key or keys from a JSON object, or remove an array element.
987+--
988+-- If the right operand is..
989+--
990+-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs
991+-- are matched based on their key value.
992+--
993+-- @ text[] @: Delete multiple key/value pairs or string elements
994+-- from left operand. Key/value pairs are matched based on their key value.
995+--
996+-- @ integer @: Delete the array element with specified index (Negative integers
997+-- count from the end). Throws an error if top level container is not an array.
998+(.-.)
999+ :: (key `In` '[ 'PGtext, 'PGvararray 'PGtext, 'PGint4, 'PGint2 ]) -- hlint error without parens here
1000+ => Expression schema relations grouping params (null0 'PGjsonb)
1001+ -> Expression schema relations grouping params (null1 key)
1002+ -> Expression schema relations grouping params (Null2 null0 null1 'PGjsonb)
1003+(.-.) = unsafeBinaryOp "-"
1004+
1005+-- | Delete the field or element with specified path (for JSON arrays, negative
1006+-- integers count from the end)
1007+(#-.)
1008+ :: IsPGtextArray arrayty
1009+ => Expression schema relations grouping params (null0 'PGjsonb)
1010+ -> Expression schema relations grouping params (null1 arrayty)
1011+ -> Expression schema relations grouping params (Null2 null0 null1 'PGjsonb)
1012+(#-.) = unsafeBinaryOp "#-"
1013+
1014+toJson
1015+ :: Expression schema relations grouping params (nullity ty)
1016+ -> Expression schema relations grouping params (nullity 'PGjson)
1017+toJson = unsafeFunction "to_json"
1018+
1019+toJsonb
1020+ :: Expression schema relations grouping params (nullity ty)
1021+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1022+toJsonb = unsafeUnaryOp "to_jsonb"
1023+
1024+arrayToJson
1025+ :: IsArray arr
1026+ => Expression schema relations grouping params (nullity arr)
1027+ -> Expression schema relations grouping params (nullity 'PGjson)
1028+arrayToJson = unsafeFunction "array_to_json"
1029+
1030+rowToJson
1031+ :: Expression schema relations grouping params (nullity ('PGcomposite ty))
1032+ -> Expression schema relations grouping params (nullity 'PGjson)
1033+rowToJson = unsafeFunction "row_to_json"
1034+
1035+-- TODO: jsonBuildArray, jsonbBuildArray, jsonObject, jsonbObject
1036+-- probably something like
1037+-- :: NP (Expression s r g p) xs -> Expression s r g p ('NotNull 'PGjson[b])
1038+
8681039{-----------------------------------------
8691040aggregation
8701041-----------------------------------------}