@@ -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
@@ -25,6 +26,7 @@ Squeal expressions are the atoms used to build statements.
2526 , TypeInType
2627 , TypeOperators
2728 , UndecidableInstances
29+ , RankNTypes
2830#-}
2931
3032module Squeal.PostgreSQL.Expression
@@ -48,6 +50,7 @@ module Squeal.PostgreSQL.Expression
4850 , unsafeBinaryOp
4951 , unsafeUnaryOp
5052 , unsafeFunction
53+ , unsafeVariadicFunction
5154 , atan2_
5255 , cast
5356 , quot_
@@ -83,6 +86,53 @@ module Squeal.PostgreSQL.Expression
8386 , upper
8487 , charLength
8588 , like
89+ -- ** json or jsonb operators
90+ , PGarray
91+ , PGarrayOf
92+ , PGjsonKey
93+ , PGjson_
94+ , (.->)
95+ , (.->>)
96+ , (.#>)
97+ , (.#>>)
98+ -- *** jsonb only operators
99+ , (.@>)
100+ , (.<@)
101+ , (.?)
102+ , (.?|)
103+ , (.?&)
104+ , (.-.)
105+ , (#-.)
106+ -- *** Functions
107+ , jsonLit
108+ , jsonbLit
109+ , toJson
110+ , toJsonb
111+ , arrayToJson
112+ , rowToJson
113+ , jsonBuildArray
114+ , jsonbBuildArray
115+ , jsonBuildObject
116+ , jsonbBuildObject
117+ , jsonObject
118+ , jsonbObject
119+ , jsonZipObject
120+ , jsonbZipObject
121+ , jsonArrayLength
122+ , jsonbArrayLength
123+ , jsonExtractPath
124+ , jsonbExtractPath
125+ , jsonExtractPathAsText
126+ , jsonbExtractPathAsText
127+ , jsonObjectKeys
128+ , jsonbObjectKeys
129+ , jsonTypeof
130+ , jsonbTypeof
131+ , jsonStripNulls
132+ , jsonbStripNulls
133+ , jsonbSet
134+ , jsonbInsert
135+ , jsonbPretty
86136 -- ** Aggregation
87137 , unsafeAggregate, unsafeAggregateDistinct
88138 , sum_, sumDistinct
@@ -135,8 +185,10 @@ module Squeal.PostgreSQL.Expression
135185import Control.Category
136186import Control.DeepSeq
137187import Data.ByteString (ByteString)
188+import Data.ByteString.Lazy (toStrict)
138189import Data.Function ((&))
139−import Data.Semigroup
190+import Data.Semigroup hiding (All)
191+import qualified Data.Aeson as JSON
140192import Data.Ratio
141193import Data.String
142194import Generics.SOP hiding (from)
@@ -477,6 +529,16 @@ unsafeFunction
477529unsafeFunction fun x = UnsafeExpression $
478530 fun <> parenthesized (renderExpression x)
479531
532+-- | Helper for defining variadic functions.
533+unsafeVariadicFunction
534+ :: SListI elems
535+ => ByteString
536+ -- ^ function
537+ -> NP (Expression schema relations grouping params) elems
538+ -> Expression schema relations grouping params ret
539+unsafeVariadicFunction fun x = UnsafeExpression $
540+ fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderExpression) x)))
541+
480542instance PGNum ty
481543 => Num (Expression schema relations grouping params (nullity ty)) where
482544 (+) = unsafeBinaryOp "+"
@@ -865,6 +927,400 @@ like
865927 -> Expression schema relations grouping params (nullity 'PGbool)
866928like = unsafeBinaryOp "LIKE"
867929
930+{-----------------------------------------
931+ -- json and jsonb support
932+
933+See https://www.postgresql.org/docs/10/static/functions-json.html -- most
934+comments lifted directly from this page.
935+
936+Table 9.44: json and jsonb operators
937+-----------------------------------------}
938+
939+-- | Get JSON value (object field or array element) at a key.
940+(.->)
941+ :: (PGjson_ json, PGjsonKey key)
942+ => Expression schema relations grouping params (nullity json)
943+ -> Expression schema relations grouping params (nullity key)
944+ -> Expression schema relations grouping params ('Null json)
945+(.->) = unsafeBinaryOp "->"
946+
947+-- | Get JSON value (object field or array element) at a key, as text.
948+(.->>)
949+ :: (PGjson_ json, PGjsonKey key)
950+ => Expression schema relations grouping params (nullity json)
951+ -> Expression schema relations grouping params (nullity key)
952+ -> Expression schema relations grouping params ('Null 'PGtext)
953+(.->>) = unsafeBinaryOp "->>"
954+
955+-- | Get JSON value at a specified path.
956+(.#>)
957+ :: (PGjson_ json, PGtextArray "(.#>)" path)
958+ => Expression schema relations grouping params (nullity json)
959+ -> Expression schema relations grouping params (nullity path)
960+ -> Expression schema relations grouping params ('Null json)
961+(.#>) = unsafeBinaryOp "#>"
962+
963+-- | Get JSON value at a specified path as text.
964+(.#>>)
965+ :: (PGjson_ json, PGtextArray "(.#>>)" path)
966+ => Expression schema relations grouping params (nullity json)
967+ -> Expression schema relations grouping params (nullity path)
968+ -> Expression schema relations grouping params ('Null 'PGtext)
969+(.#>>) = unsafeBinaryOp "#>>"
970+
971+-- Additional jsonb operators
972+
973+-- | Does the left JSON value contain the right JSON path/value entries at the
974+-- top level?
975+(.@>)
976+ :: Expression schema relations grouping params (nullity 'PGjsonb)
977+ -> Expression schema relations grouping params (nullity 'PGjsonb)
978+ -> Condition schema relations grouping params
979+(.@>) = unsafeBinaryOp "@>"
980+
981+-- | Are the left JSON path/value entries contained at the top level within the
982+-- right JSON value?
983+(.<@)
984+ :: Expression schema relations grouping params (nullity 'PGjsonb)
985+ -> Expression schema relations grouping params (nullity 'PGjsonb)
986+ -> Condition schema relations grouping params
987+(.<@) = unsafeBinaryOp "<@"
988+
989+-- | Does the string exist as a top-level key within the JSON value?
990+(.?)
991+ :: Expression schema relations grouping params (nullity 'PGjsonb)
992+ -> Expression schema relations grouping params (nullity 'PGtext)
993+ -> Condition schema relations grouping params
994+(.?) = unsafeBinaryOp "?"
995+
996+-- | Do any of these array strings exist as top-level keys?
997+(.?|)
998+ :: Expression schema relations grouping params (nullity 'PGjsonb)
999+ -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))
1000+ -> Condition schema relations grouping params
1001+(.?|) = unsafeBinaryOp "?|"
1002+
1003+-- | Do all of these array strings exist as top-level keys?
1004+(.?&)
1005+ :: Expression schema relations grouping params (nullity 'PGjsonb)
1006+ -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))
1007+ -> Condition schema relations grouping params
1008+(.?&) = unsafeBinaryOp "?&"
1009+
1010+-- | Concatenate two jsonb values into a new jsonb value.
1011+instance
1012+ Semigroup (Expression schema relations grouping param (nullity 'PGjsonb)) where
1013+ (<>) = unsafeBinaryOp "||"
1014+
1015+-- | Delete a key or keys from a JSON object, or remove an array element.
1016+--
1017+-- If the right operand is..
1018+--
1019+-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs
1020+-- are matched based on their key value.
1021+--
1022+-- @ text[] @: Delete multiple key/value pairs or string elements
1023+-- from left operand. Key/value pairs are matched based on their key value.
1024+--
1025+-- @ integer @: Delete the array element with specified index (Negative integers
1026+-- count from the end). Throws an error if top level container is not an array.
1027+(.-.)
1028+ :: (key `In` '[ 'PGtext, 'PGvararray 'PGtext, 'PGint4, 'PGint2 ]) -- hlint error without parens here
1029+ => Expression schema relations grouping params (nullity 'PGjsonb)
1030+ -> Expression schema relations grouping params (nullity key)
1031+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1032+(.-.) = unsafeBinaryOp "-"
1033+
1034+-- | Delete the field or element with specified path (for JSON arrays, negative
1035+-- integers count from the end)
1036+(#-.)
1037+ :: PGtextArray "(#-.)" arrayty
1038+ => Expression schema relations grouping params (nullity 'PGjsonb)
1039+ -> Expression schema relations grouping params (nullity arrayty)
1040+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1041+(#-.) = unsafeBinaryOp "#-"
1042+
1043+{-----------------------------------------
1044+Table 9.45: JSON creation functions
1045+-----------------------------------------}
1046+
1047+-- | Literal binary JSON
1048+jsonbLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjsonb)
1049+jsonbLit = cast jsonb . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode
1050+
1051+-- | Literal JSON
1052+jsonLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjson)
1053+jsonLit = cast json . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode
1054+
1055+-- | Returns the value as json. Arrays and composites are converted
1056+-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1057+-- type to json, the cast function will be used to perform the conversion;
1058+-- otherwise, a scalar value is produced. For any scalar type other than a
1059+-- number, a Boolean, or a null value, the text representation will be used, in
1060+-- such a fashion that it is a valid json value.
1061+toJson
1062+ :: Expression schema relations grouping params (nullity ty)
1063+ -> Expression schema relations grouping params (nullity 'PGjson)
1064+toJson = unsafeFunction "to_json"
1065+
1066+-- | Returns the value as jsonb. Arrays and composites are converted
1067+-- (recursively) to arrays and objects; otherwise, if there is a cast from the
1068+-- type to json, the cast function will be used to perform the conversion;
1069+-- otherwise, a scalar value is produced. For any scalar type other than a
1070+-- number, a Boolean, or a null value, the text representation will be used, in
1071+-- such a fashion that it is a valid jsonb value.
1072+toJsonb
1073+ :: Expression schema relations grouping params (nullity ty)
1074+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1075+toJsonb = unsafeFunction "to_jsonb"
1076+
1077+-- | Returns the array as a JSON array. A PostgreSQL multidimensional array
1078+-- becomes a JSON array of arrays.
1079+arrayToJson
1080+ :: PGarray "arrayToJson" arr
1081+ => Expression schema relations grouping params (nullity arr)
1082+ -> Expression schema relations grouping params (nullity 'PGjson)
1083+arrayToJson = unsafeFunction "array_to_json"
1084+
1085+-- | Returns the row as a JSON object.
1086+rowToJson
1087+ :: Expression schema relations grouping params (nullity ('PGcomposite ty))
1088+ -> Expression schema relations grouping params (nullity 'PGjson)
1089+rowToJson = unsafeFunction "row_to_json"
1090+
1091+-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic
1092+-- argument list.
1093+jsonBuildArray
1094+ :: SListI elems
1095+ => NP (Expression schema relations grouping params) elems
1096+ -> Expression schema relations grouping params (nullity 'PGjson)
1097+jsonBuildArray = unsafeVariadicFunction "json_build_array"
1098+
1099+-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a
1100+-- variadic argument list.
1101+jsonbBuildArray
1102+ :: SListI elems
1103+ => NP (Expression schema relations grouping params) elems
1104+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1105+jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"
1106+
1107+unsafeRowFunction
1108+ :: All Top elems
1109+ => NP (Aliased (Expression schema relations grouping params)) elems
1110+ -> [ByteString]
1111+unsafeRowFunction =
1112+ (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)
1113+ (\(col `As` name) -> Endo $ \xs ->
1114+ renderAliasString name : renderExpression col : xs)
1115+
1116+-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic
1117+-- argument list. The elements of the argument list must alternate between text
1118+-- and values.
1119+jsonBuildObject
1120+ :: All Top elems
1121+ => NP (Aliased (Expression schema relations grouping params)) elems
1122+ -> Expression schema relations grouping params (nullity 'PGjson)
1123+jsonBuildObject
1124+ = unsafeFunction "json_build_object"
1125+ . UnsafeExpression
1126+ . commaSeparated
1127+ . unsafeRowFunction
1128+
1129+-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a
1130+-- variadic argument list. The elements of the argument list must alternate
1131+-- between text and values.
1132+jsonbBuildObject
1133+ :: All Top elems
1134+ => NP (Aliased (Expression schema relations grouping params)) elems
1135+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1136+jsonbBuildObject
1137+ = unsafeFunction "jsonb_build_object"
1138+ . UnsafeExpression
1139+ . commaSeparated
1140+ . unsafeRowFunction
1141+
1142+-- | Builds a JSON object out of a text array. The array must have either
1143+-- exactly one dimension with an even number of members, in which case they are
1144+-- taken as alternating key/value pairs, or two dimensions such that each inner
1145+-- array has exactly two elements, which are taken as a key/value pair.
1146+jsonObject
1147+ :: PGarrayOf "jsonObject" arr 'PGtext
1148+ => Expression schema relations grouping params (nullity arr)
1149+ -> Expression schema relations grouping params (nullity 'PGjson)
1150+jsonObject = unsafeFunction "json_object"
1151+
1152+-- | Builds a binary JSON object out of a text array. The array must have either
1153+-- exactly one dimension with an even number of members, in which case they are
1154+-- taken as alternating key/value pairs, or two dimensions such that each inner
1155+-- array has exactly two elements, which are taken as a key/value pair.
1156+jsonbObject
1157+ :: PGarrayOf "jsonbObject" arr 'PGtext
1158+ => Expression schema relations grouping params (nullity arr)
1159+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1160+jsonbObject = unsafeFunction "jsonb_object"
1161+
1162+-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1163+-- keys and one for values, that are zipped pairwise to create a JSON object.
1164+jsonZipObject
1165+ :: ( PGarrayOf "jsonZipObject" keysArray 'PGtext
1166+ , PGarrayOf "jsonZipObject" valuesArray 'PGtext)
1167+ => Expression schema relations grouping params (nullity keysArray)
1168+ -> Expression schema relations grouping params (nullity valuesArray)
1169+ -> Expression schema relations grouping params (nullity 'PGjson)
1170+jsonZipObject ks vs =
1171+ unsafeVariadicFunction "json_object" (ks :* vs :* Nil)
1172+
1173+-- | This is an alternate form of 'jsonObject' that takes two arrays; one for
1174+-- keys and one for values, that are zipped pairwise to create a binary JSON
1175+-- object.
1176+jsonbZipObject
1177+ :: ( PGarrayOf "jsonbZipObject" keysArray 'PGtext
1178+ , PGarrayOf "jsonbZipObject" valuesArray 'PGtext)
1179+ => Expression schema relations grouping params (nullity keysArray)
1180+ -> Expression schema relations grouping params (nullity valuesArray)
1181+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1182+jsonbZipObject ks vs =
1183+ unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)
1184+
1185+{-----------------------------------------
1186+Table 9.46: JSON processing functions
1187+-----------------------------------------}
1188+
1189+-- | Returns the number of elements in the outermost JSON array.
1190+jsonArrayLength
1191+ :: Expression schema relations grouping params (nullity 'PGjson)
1192+ -> Expression schema relations grouping params (nullity 'PGint4)
1193+jsonArrayLength = unsafeFunction "json_array_length"
1194+
1195+-- | Returns the number of elements in the outermost binary JSON array.
1196+jsonbArrayLength
1197+ :: Expression schema relations grouping params (nullity 'PGjsonb)
1198+ -> Expression schema relations grouping params (nullity 'PGint4)
1199+jsonbArrayLength = unsafeFunction "jsonb_array_length"
1200+
1201+-- | Returns JSON value pointed to by the given path (equivalent to #>
1202+-- operator).
1203+jsonExtractPath
1204+ :: SListI elems
1205+ => Expression schema relations grouping params (nullity 'PGjson)
1206+ -> NP (Expression schema relations grouping params) elems
1207+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1208+jsonExtractPath x xs =
1209+ unsafeVariadicFunction "json_extract_path" (x :* xs)
1210+
1211+-- | Returns JSON value pointed to by the given path (equivalent to #>
1212+-- operator).
1213+jsonbExtractPath
1214+ :: SListI elems
1215+ => Expression schema relations grouping params (nullity 'PGjsonb)
1216+ -> NP (Expression schema relations grouping params) elems
1217+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1218+jsonbExtractPath x xs =
1219+ unsafeVariadicFunction "jsonb_extract_path" (x :* xs)
1220+
1221+-- | Returns JSON value pointed to by the given path (equivalent to #>
1222+-- operator), as text.
1223+jsonExtractPathAsText
1224+ :: SListI elems
1225+ => Expression schema relations grouping params (nullity 'PGjson)
1226+ -> NP (Expression schema relations grouping params) elems
1227+ -> Expression schema relations grouping params (nullity 'PGjson)
1228+jsonExtractPathAsText x xs =
1229+ unsafeVariadicFunction "json_extract_path_text" (x :* xs)
1230+
1231+-- | Returns JSON value pointed to by the given path (equivalent to #>
1232+-- operator), as text.
1233+jsonbExtractPathAsText
1234+ :: SListI elems
1235+ => Expression schema relations grouping params (nullity 'PGjsonb)
1236+ -> NP (Expression schema relations grouping params) elems
1237+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1238+jsonbExtractPathAsText x xs =
1239+ unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)
1240+
1241+-- | Returns set of keys in the outermost JSON object.
1242+jsonObjectKeys
1243+ :: Expression schema relations grouping params (nullity 'PGjson)
1244+ -> Expression schema relations grouping params (nullity 'PGtext)
1245+jsonObjectKeys = unsafeFunction "json_object_keys"
1246+
1247+-- | Returns set of keys in the outermost JSON object.
1248+jsonbObjectKeys
1249+ :: Expression schema relations grouping params (nullity 'PGjsonb)
1250+ -> Expression schema relations grouping params (nullity 'PGtext)
1251+jsonbObjectKeys = unsafeFunction "jsonb_object_keys"
1252+
1253+-- | Returns the type of the outermost JSON value as a text string. Possible
1254+-- types are object, array, string, number, boolean, and null.
1255+jsonTypeof
1256+ :: Expression schema relations grouping params (nullity 'PGjson)
1257+ -> Expression schema relations grouping params (nullity 'PGtext)
1258+jsonTypeof = unsafeFunction "json_typeof"
1259+
1260+-- | Returns the type of the outermost binary JSON value as a text string.
1261+-- Possible types are object, array, string, number, boolean, and null.
1262+jsonbTypeof
1263+ :: Expression schema relations grouping params (nullity 'PGjsonb)
1264+ -> Expression schema relations grouping params (nullity 'PGtext)
1265+jsonbTypeof = unsafeFunction "jsonb_typeof"
1266+
1267+-- | Returns its argument with all object fields that have null values omitted.
1268+-- Other null values are untouched.
1269+jsonStripNulls
1270+ :: Expression schema relations grouping params (nullity 'PGjson)
1271+ -> Expression schema relations grouping params (nullity 'PGjson)
1272+jsonStripNulls = unsafeFunction "json_strip_nulls"
1273+
1274+-- | Returns its argument with all object fields that have null values omitted.
1275+-- Other null values are untouched.
1276+jsonbStripNulls
1277+ :: Expression schema relations grouping params (nullity 'PGjsonb)
1278+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1279+jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"
1280+
1281+-- | @ jsonbSet target path new_value create_missing @
1282+--
1283+-- Returns target with the section designated by path replaced by new_value,
1284+-- or with new_value added if create_missing is true ( default is true) and the
1285+-- item designated by path does not exist. As with the path orientated
1286+-- operators, negative integers that appear in path count from the end of JSON
1287+-- arrays.
1288+jsonbSet
1289+ :: PGtextArray "jsonbSet" arr
1290+ => Expression schema relations grouping params (nullity 'PGjsonb)
1291+ -> Expression schema relations grouping params (nullity arr)
1292+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1293+ -> Maybe (Expression schema relations grouping params (nullity 'PGbool))
1294+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1295+jsonbSet tgt path val createMissing = case createMissing of
1296+ Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)
1297+ Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)
1298+
1299+-- | @ jsonbInsert target path new_value insert_after @
1300+--
1301+-- Returns target with new_value inserted. If target section designated by
1302+-- path is in a JSONB array, new_value will be inserted before target or after
1303+-- if insert_after is true (default is false). If target section designated by
1304+-- path is in JSONB object, new_value will be inserted only if target does not
1305+-- exist. As with the path orientated operators, negative integers that appear
1306+-- in path count from the end of JSON arrays.
1307+jsonbInsert
1308+ :: PGtextArray "jsonbInsert" arr
1309+ => Expression schema relations grouping params (nullity 'PGjsonb)
1310+ -> Expression schema relations grouping params (nullity arr)
1311+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1312+ -> Maybe (Expression schema relations grouping params (nullity 'PGbool))
1313+ -> Expression schema relations grouping params (nullity 'PGjsonb)
1314+jsonbInsert tgt path val insertAfter = case insertAfter of
1315+ Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)
1316+ Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)
1317+
1318+-- | Returns its argument as indented JSON text.
1319+jsonbPretty
1320+ :: Expression schema relations grouping params (nullity 'PGjsonb)
1321+ -> Expression schema relations grouping params (nullity 'PGtext)
1322+jsonbPretty = unsafeFunction "jsonb_pretty"
1323+
8681324{-----------------------------------------
8691325aggregation
8701326-----------------------------------------}