packages feed

squeal-postgresql 0.3.1.0 → 0.3.2.0

raw patch · 6 files changed

+758/−7 lines, 6 files

Files

squeal-postgresql.cabal view
@@ -1,5 +1,5 @@ name: squeal-postgresql-version: 0.3.1.0+version: 0.3.2.0 synopsis: Squeal PostgreSQL Library description: Squeal is a type-safe embedding of PostgreSQL in Haskell homepage: https://github.com/morphismtech/squeal
src/Squeal/PostgreSQL/Expression.hs view
@@ -11,6 +11,7 @@ {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} {-# LANGUAGE     AllowAmbiguousTypes+  , ConstraintKinds   , DeriveGeneric   , FlexibleContexts   , FlexibleInstances@@ -25,6 +26,7 @@   , TypeInType   , TypeOperators   , UndecidableInstances+  , RankNTypes #-}  module Squeal.PostgreSQL.Expression@@ -48,6 +50,7 @@   , unsafeBinaryOp   , unsafeUnaryOp   , unsafeFunction+  , unsafeVariadicFunction   , atan2_   , cast   , quot_@@ -83,6 +86,53 @@   , upper   , charLength   , like+    -- ** json or jsonb operators+  , PGarray+  , PGarrayOf+  , PGjsonKey+  , PGjson_+  , (.->)+  , (.->>)+  , (.#>)+  , (.#>>)+    -- *** jsonb only operators+  , (.@>)+  , (.<@)+  , (.?)+  , (.?|)+  , (.?&)+  , (.-.)+  , (#-.)+    -- *** Functions+  , jsonLit+  , jsonbLit+  , toJson+  , toJsonb+  , arrayToJson+  , rowToJson+  , jsonBuildArray+  , jsonbBuildArray+  , jsonBuildObject+  , jsonbBuildObject+  , jsonObject+  , jsonbObject+  , jsonZipObject+  , jsonbZipObject+  , jsonArrayLength+  , jsonbArrayLength+  , jsonExtractPath+  , jsonbExtractPath+  , jsonExtractPathAsText+  , jsonbExtractPathAsText+  , jsonObjectKeys+  , jsonbObjectKeys+  , jsonTypeof+  , jsonbTypeof+  , jsonStripNulls+  , jsonbStripNulls+  , jsonbSet+  , jsonbInsert+  , jsonbPretty     -- ** Aggregation   , unsafeAggregate, unsafeAggregateDistinct   , sum_, sumDistinct@@ -135,8 +185,10 @@ import Control.Category import Control.DeepSeq import Data.ByteString (ByteString)+import Data.ByteString.Lazy (toStrict) import Data.Function ((&))-import Data.Semigroup+import Data.Semigroup hiding (All)+import qualified Data.Aeson as JSON import Data.Ratio import Data.String import Generics.SOP hiding (from)@@ -477,6 +529,16 @@ unsafeFunction fun x = UnsafeExpression $   fun <> parenthesized (renderExpression x) +-- | Helper for defining variadic functions.+unsafeVariadicFunction+  :: SListI elems+  => ByteString+  -- ^ function+  -> NP (Expression schema relations grouping params) elems+  -> Expression schema relations grouping params ret+unsafeVariadicFunction fun x = UnsafeExpression $+  fun <> parenthesized (commaSeparated (hcollapse (hmap (K . renderExpression) x)))+ instance PGNum ty   => Num (Expression schema relations grouping params (nullity ty)) where     (+) = unsafeBinaryOp "+"@@ -864,6 +926,400 @@   -- ^ pattern   -> Expression schema relations grouping params (nullity 'PGbool) like = unsafeBinaryOp "LIKE"++{-----------------------------------------+ -- json and jsonb support++See https://www.postgresql.org/docs/10/static/functions-json.html -- most+comments lifted directly from this page.++Table 9.44: json and jsonb operators+-----------------------------------------}++-- | Get JSON value (object field or array element) at a key.+(.->)+  :: (PGjson_ json, PGjsonKey key)+  => Expression schema relations grouping params (nullity json)+  -> Expression schema relations grouping params (nullity key)+  -> Expression schema relations grouping params ('Null json)+(.->) = unsafeBinaryOp "->"++-- | Get JSON value (object field or array element) at a key, as text.+(.->>)+  :: (PGjson_ json, PGjsonKey key)+  => Expression schema relations grouping params (nullity json)+  -> Expression schema relations grouping params (nullity key)+  -> Expression schema relations grouping params ('Null 'PGtext)+(.->>) = unsafeBinaryOp "->>"++-- | Get JSON value at a specified path.+(.#>)+  :: (PGjson_ json, PGtextArray "(.#>)" path)+  => Expression schema relations grouping params (nullity json)+  -> Expression schema relations grouping params (nullity path)+  -> Expression schema relations grouping params ('Null json)+(.#>) = unsafeBinaryOp "#>"++-- | Get JSON value at a specified path as text.+(.#>>)+  :: (PGjson_ json, PGtextArray "(.#>>)" path)+  => Expression schema relations grouping params (nullity json)+  -> Expression schema relations grouping params (nullity path)+  -> Expression schema relations grouping params ('Null 'PGtext)+(.#>>) = unsafeBinaryOp "#>>"++-- Additional jsonb operators++-- | Does the left JSON value contain the right JSON path/value entries at the+-- top level?+(.@>)+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+  -> Condition schema relations grouping params+(.@>) = unsafeBinaryOp "@>"++-- | Are the left JSON path/value entries contained at the top level within the+-- right JSON value?+(.<@)+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+  -> Condition schema relations grouping params+(.<@) = unsafeBinaryOp "<@"++-- | Does the string exist as a top-level key within the JSON value?+(.?)+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGtext)+  -> Condition schema relations grouping params+(.?) = unsafeBinaryOp "?"++-- | Do any of these array strings exist as top-level keys?+(.?|)+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))+  -> Condition schema relations grouping params+(.?|) = unsafeBinaryOp "?|"++-- | Do all of these array strings exist as top-level keys?+(.?&)+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))+  -> Condition schema relations grouping params+(.?&) = unsafeBinaryOp "?&"++-- | Concatenate two jsonb values into a new jsonb value.+instance+  Semigroup (Expression schema relations grouping param (nullity 'PGjsonb)) where+  (<>) = unsafeBinaryOp "||"++-- | Delete a key or keys from a JSON object, or remove an array element.+--+-- If the right operand is..+--+-- @ text @: Delete key/value pair or string element from left operand. Key/value pairs+-- are matched based on their key value.+--+-- @ text[] @: Delete multiple key/value pairs or string elements+-- from left operand. Key/value pairs are matched based on their key value.+--+-- @ integer @: Delete the array element with specified index (Negative integers+-- count from the end). Throws an error if top level container is not an array.+(.-.)+  :: (key `In` '[ 'PGtext, 'PGvararray 'PGtext, 'PGint4, 'PGint2 ]) -- hlint error without parens here+  => Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity key)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+(.-.) = unsafeBinaryOp "-"++-- | Delete the field or element with specified path (for JSON arrays, negative+-- integers count from the end)+(#-.)+  :: PGtextArray "(#-.)" arrayty+  => Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity arrayty)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+(#-.) = unsafeBinaryOp "#-"++{-----------------------------------------+Table 9.45: JSON creation functions+-----------------------------------------}++-- | Literal binary JSON+jsonbLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbLit = cast jsonb . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode++-- | Literal JSON+jsonLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjson)+jsonLit = cast json . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode++-- | Returns the value as json. Arrays and composites are converted+-- (recursively) to arrays and objects; otherwise, if there is a cast from the+-- type to json, the cast function will be used to perform the conversion;+-- otherwise, a scalar value is produced. For any scalar type other than a+-- number, a Boolean, or a null value, the text representation will be used, in+-- such a fashion that it is a valid json value.+toJson+  :: Expression schema relations grouping params (nullity ty)+  -> Expression schema relations grouping params (nullity 'PGjson)+toJson = unsafeFunction "to_json"++-- | Returns the value as jsonb. Arrays and composites are converted+-- (recursively) to arrays and objects; otherwise, if there is a cast from the+-- type to json, the cast function will be used to perform the conversion;+-- otherwise, a scalar value is produced. For any scalar type other than a+-- number, a Boolean, or a null value, the text representation will be used, in+-- such a fashion that it is a valid jsonb value.+toJsonb+  :: Expression schema relations grouping params (nullity ty)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+toJsonb = unsafeFunction "to_jsonb"++-- | Returns the array as a JSON array. A PostgreSQL multidimensional array+-- becomes a JSON array of arrays.+arrayToJson+  :: PGarray "arrayToJson" arr+  => Expression schema relations grouping params (nullity arr)+  -> Expression schema relations grouping params (nullity 'PGjson)+arrayToJson = unsafeFunction "array_to_json"++-- | Returns the row as a JSON object.+rowToJson+  :: Expression schema relations grouping params (nullity ('PGcomposite ty))+  -> Expression schema relations grouping params (nullity 'PGjson)+rowToJson = unsafeFunction "row_to_json"++-- | Builds a possibly-heterogeneously-typed JSON array out of a variadic+-- argument list.+jsonBuildArray+  :: SListI elems+  => NP (Expression schema relations grouping params) elems+  -> Expression schema relations grouping params (nullity 'PGjson)+jsonBuildArray = unsafeVariadicFunction "json_build_array"++-- | Builds a possibly-heterogeneously-typed (binary) JSON array out of a+-- variadic argument list.+jsonbBuildArray+  :: SListI elems+  => NP (Expression schema relations grouping params) elems+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"++unsafeRowFunction+  :: All Top elems+  => NP (Aliased (Expression schema relations grouping params)) elems+  -> [ByteString]+unsafeRowFunction =+  (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)+  (\(col `As` name) -> Endo $ \xs ->+      renderAliasString name : renderExpression col : xs)++-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic+-- argument list. The elements of the argument list must alternate between text+-- and values.+jsonBuildObject+  :: All Top elems+  => NP (Aliased (Expression schema relations grouping params)) elems+  -> Expression schema relations grouping params (nullity 'PGjson)+jsonBuildObject+  = unsafeFunction "json_build_object"+  . UnsafeExpression+  . commaSeparated+  . unsafeRowFunction++-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a+-- variadic argument list. The elements of the argument list must alternate+-- between text and values.+jsonbBuildObject+  :: All Top elems+  => NP (Aliased (Expression schema relations grouping params)) elems+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbBuildObject+  = unsafeFunction "jsonb_build_object"+  . UnsafeExpression+  . commaSeparated+  . unsafeRowFunction++-- | Builds a JSON object out of a text array. The array must have either+-- exactly one dimension with an even number of members, in which case they are+-- taken as alternating key/value pairs, or two dimensions such that each inner+-- array has exactly two elements, which are taken as a key/value pair.+jsonObject+  :: PGarrayOf "jsonObject" arr 'PGtext+  => Expression schema relations grouping params (nullity arr)+  -> Expression schema relations grouping params (nullity 'PGjson)+jsonObject = unsafeFunction "json_object"++-- | Builds a binary JSON object out of a text array. The array must have either+-- exactly one dimension with an even number of members, in which case they are+-- taken as alternating key/value pairs, or two dimensions such that each inner+-- array has exactly two elements, which are taken as a key/value pair.+jsonbObject+  :: PGarrayOf "jsonbObject" arr 'PGtext+  => Expression schema relations grouping params (nullity arr)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbObject = unsafeFunction "jsonb_object"++-- | This is an alternate form of 'jsonObject' that takes two arrays; one for+-- keys and one for values, that are zipped pairwise to create a JSON object.+jsonZipObject+  :: ( PGarrayOf "jsonZipObject" keysArray 'PGtext+     , PGarrayOf "jsonZipObject" valuesArray 'PGtext)+  => Expression schema relations grouping params (nullity keysArray)+  -> Expression schema relations grouping params (nullity valuesArray)+  -> Expression schema relations grouping params (nullity 'PGjson)+jsonZipObject ks vs =+  unsafeVariadicFunction "json_object" (ks :* vs :* Nil)++-- | This is an alternate form of 'jsonObject' that takes two arrays; one for+-- keys and one for values, that are zipped pairwise to create a binary JSON+-- object.+jsonbZipObject+  :: ( PGarrayOf "jsonbZipObject" keysArray 'PGtext+     , PGarrayOf "jsonbZipObject" valuesArray 'PGtext)+  => Expression schema relations grouping params (nullity keysArray)+  -> Expression schema relations grouping params (nullity valuesArray)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbZipObject ks vs =+  unsafeVariadicFunction "jsonb_object" (ks :* vs :* Nil)++{-----------------------------------------+Table 9.46: JSON processing functions+-----------------------------------------}++-- | Returns the number of elements in the outermost JSON array.+jsonArrayLength+  :: Expression schema relations grouping params (nullity 'PGjson)+  -> Expression schema relations grouping params (nullity 'PGint4)+jsonArrayLength = unsafeFunction "json_array_length"++-- | Returns the number of elements in the outermost binary JSON array.+jsonbArrayLength+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGint4)+jsonbArrayLength = unsafeFunction "jsonb_array_length"++-- | Returns JSON value pointed to by the given path (equivalent to #>+-- operator).+jsonExtractPath+  :: SListI elems+  => Expression schema relations grouping params (nullity 'PGjson)+  -> NP (Expression schema relations grouping params) elems+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonExtractPath x xs =+  unsafeVariadicFunction "json_extract_path" (x :* xs)++-- | Returns JSON value pointed to by the given path (equivalent to #>+-- operator).+jsonbExtractPath+  :: SListI elems+  => Expression schema relations grouping params (nullity 'PGjsonb)+  -> NP (Expression schema relations grouping params) elems+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbExtractPath x xs =+  unsafeVariadicFunction "jsonb_extract_path" (x :* xs)++-- | Returns JSON value pointed to by the given path (equivalent to #>+-- operator), as text.+jsonExtractPathAsText+  :: SListI elems+  => Expression schema relations grouping params (nullity 'PGjson)+  -> NP (Expression schema relations grouping params) elems+  -> Expression schema relations grouping params (nullity 'PGjson)+jsonExtractPathAsText x xs =+  unsafeVariadicFunction "json_extract_path_text" (x :* xs)++-- | Returns JSON value pointed to by the given path (equivalent to #>+-- operator), as text.+jsonbExtractPathAsText+  :: SListI elems+  => Expression schema relations grouping params (nullity 'PGjsonb)+  -> NP (Expression schema relations grouping params) elems+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbExtractPathAsText x xs =+  unsafeVariadicFunction "jsonb_extract_path_text" (x :* xs)++-- | Returns set of keys in the outermost JSON object.+jsonObjectKeys+  :: Expression schema relations grouping params (nullity 'PGjson)+  -> Expression schema relations grouping params (nullity 'PGtext)+jsonObjectKeys = unsafeFunction "json_object_keys"++-- | Returns set of keys in the outermost JSON object.+jsonbObjectKeys+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGtext)+jsonbObjectKeys = unsafeFunction "jsonb_object_keys"++-- | Returns the type of the outermost JSON value as a text string. Possible+-- types are object, array, string, number, boolean, and null.+jsonTypeof+  :: Expression schema relations grouping params (nullity 'PGjson)+  -> Expression schema relations grouping params (nullity 'PGtext)+jsonTypeof = unsafeFunction "json_typeof"++-- | Returns the type of the outermost binary JSON value as a text string.+-- Possible types are object, array, string, number, boolean, and null.+jsonbTypeof+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGtext)+jsonbTypeof = unsafeFunction "jsonb_typeof"++-- | Returns its argument with all object fields that have null values omitted.+-- Other null values are untouched.+jsonStripNulls+  :: Expression schema relations grouping params (nullity 'PGjson)+  -> Expression schema relations grouping params (nullity 'PGjson)+jsonStripNulls = unsafeFunction "json_strip_nulls"++-- | Returns its argument with all object fields that have null values omitted.+-- Other null values are untouched.+jsonbStripNulls+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbStripNulls = unsafeFunction "jsonb_strip_nulls"++-- | @ jsonbSet target path new_value create_missing @+--+-- Returns target with the section designated by path replaced by new_value,+-- or with new_value added if create_missing is true ( default is true) and the+-- item designated by path does not exist. As with the path orientated+-- operators, negative integers that appear in path count from the end of JSON+-- arrays.+jsonbSet+  :: PGtextArray "jsonbSet" arr+  => Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity arr)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+  -> Maybe (Expression schema relations grouping params (nullity 'PGbool))+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbSet tgt path val createMissing = case createMissing of+  Just m -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* m :* Nil)+  Nothing -> unsafeVariadicFunction "jsonb_set" (tgt :* path :* val :* Nil)++-- | @ jsonbInsert target path new_value insert_after @+--+-- Returns target with new_value inserted. If target section designated by+-- path is in a JSONB array, new_value will be inserted before target or after+-- if insert_after is true (default is false). If target section designated by+-- path is in JSONB object, new_value will be inserted only if target does not+-- exist. As with the path orientated operators, negative integers that appear+-- in path count from the end of JSON arrays.+jsonbInsert+  :: PGtextArray "jsonbInsert" arr+  => Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity arr)+  -> Expression schema relations grouping params (nullity 'PGjsonb)+  -> Maybe (Expression schema relations grouping params (nullity 'PGbool))+  -> Expression schema relations grouping params (nullity 'PGjsonb)+jsonbInsert tgt path val insertAfter = case insertAfter of+  Just i -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* i :* Nil)+  Nothing -> unsafeVariadicFunction "jsonb_insert" (tgt :* path :* val :* Nil)++-- | Returns its argument as indented JSON text.+jsonbPretty+  :: Expression schema relations grouping params (nullity 'PGjsonb)+  -> Expression schema relations grouping params (nullity 'PGtext)+jsonbPretty = unsafeFunction "jsonb_pretty"  {----------------------------------------- aggregation
src/Squeal/PostgreSQL/Pool.hs view
@@ -41,7 +41,28 @@ import Squeal.PostgreSQL.PQ import Squeal.PostgreSQL.Schema --- | `PoolPQ` @schema@ should be a drop-in replacement for `PQ` @schema schema@.+{- | `PoolPQ` @schema@ should be a drop-in replacement for `PQ` @schema schema@.++Typical use case would be to create your pool using `createConnectionPool` and run anything that requires the pool connection with it.++Here's a simplified example:++> type Schema = '[ "tab" ::: 'Table ('[] :=> '["col" ::: 'NoDef :=> 'NotNull 'PGint2])]+>+> someQuery :: Manipulation Schema '[ 'NotNull 'PGint2] '[]+> someQuery = insertRow #tab+>  (Set (param @1) `As` #col :* Nil)+> OnConflictDoNothing (Returning Nil)+>+> insertOne :: (MonadBaseControl IO m, MonadPQ Schema m) => m ()+> insertOne = void $ manipulateParams someQuery . Only $ (1 :: Int16)+>+> insertOneInPool :: ByteString -> IO ()+> insertOneInPool connectionString = do+>   pool <- createConnectionPool connectionString 1 0.5 10+>   liftIO $ runPoolPQ (insertOne) pool++-} newtype PoolPQ (schema :: SchemaType) m x =   PoolPQ { runPoolPQ :: Pool (K Connection schema) -> m x }   deriving Functor
src/Squeal/PostgreSQL/Query.hs view
@@ -9,7 +9,8 @@ -}  {-# LANGUAGE-    DeriveGeneric+    ConstraintKinds+  , DeriveGeneric   , FlexibleContexts   , FlexibleInstances   , GADTs@@ -21,8 +22,9 @@   , TypeFamilies   , TypeInType   , TypeOperators+  , RankNTypes   , UndecidableInstances-#-}+  #-}  module Squeal.PostgreSQL.Query   ( -- * Queries@@ -52,6 +54,21 @@   , orderBy   , limit   , offset+    -- ** JSON table expressions+  , PGjson_each+  , PGjsonb_each+  , jsonEach+  , jsonbEach+  , jsonEachAsText+  , jsonbEachAsText+  , jsonPopulateRecordAs+  , jsonbPopulateRecordAs+  , jsonPopulateRecordSetAs+  , jsonbPopulateRecordSetAs+  , jsonToRecordAs+  , jsonbToRecordAs+  , jsonToRecordSetAs+  , jsonbToRecordSetAs     -- * From   , FromClause (..)   , table@@ -626,6 +643,189 @@   -> TableExpression schema params relations grouping   -> TableExpression schema params relations grouping offset off rels = rels {offsetClause = off : offsetClause rels}++{-----------------------------------------+JSON stuff+-----------------------------------------}++type PGjson_each_variant val tab =+  '[ tab ::: '[ "key" ::: 'NotNull 'PGtext, "value" ::: 'NotNull val ] ]++-- | The type of a `json_each` `FromClause`.+type PGjson_each tab = PGjson_each_variant 'PGjson tab+-- | The type of a `jsonb_each` `FromClause`.+type PGjsonb_each tab = PGjson_each_variant 'PGjsonb tab+-- | The type of a `json_each_text` `FromClause`.+type PGjson_each_text tab = PGjson_each_variant 'PGtext tab+-- | The type of a `jsonb_each_text` `FromClause`.+type PGjsonb_each_text tab = PGjson_each_variant 'PGtext tab++unsafeAliasedFromClauseExpression+  :: Aliased (Expression schema' relations' grouping' params') ty'+  -> FromClause schema params relations+unsafeAliasedFromClauseExpression aliasedExpr = UnsafeFromClause+  (renderAliasedAs renderExpression aliasedExpr)++-- | Expands the outermost JSON object into a set of key/value pairs.+jsonEach+  :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)+  -> FromClause schema params (PGjson_each tab)+jsonEach (As jexpr jname) = unsafeAliasedFromClauseExpression+  (As (unsafeFunction "json_each" jexpr) jname)++-- | Expands the outermost binary JSON object into a set of key/value pairs.+jsonbEach+  :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)+  -> FromClause schema params (PGjsonb_each tab)+jsonbEach (As jexpr jname) = unsafeAliasedFromClauseExpression+  (As (unsafeFunction "jsonb_each" jexpr) jname)++-- | Expands the outermost JSON object into a set of key/value pairs.+jsonEachAsText+  :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjson)+  -> FromClause schema params (PGjson_each_text tab)+jsonEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression+  (As (unsafeFunction "json_each" jexpr) jname)++-- | Expands the outermost binary JSON object into a set of key/value pairs.+jsonbEachAsText+  :: Aliased (Expression schema '[] 'Ungrouped params) '(tab, nullity 'PGjsonb)+  -> FromClause schema params (PGjsonb_each_text tab)+jsonbEachAsText (As jexpr jname) = unsafeAliasedFromClauseExpression+  (As (unsafeFunction "jsonb_each" jexpr) jname)++nullRow+  :: Has tab schema ('Table table)+  => Alias tab+  -> Expression schema relations grouping params+     (nullity ('PGcomposite (RelationToRowType (TableToRelation table))))+nullRow tab = UnsafeExpression ("null::"<+>renderAlias tab)++-- | Expands the JSON expression to a row whose columns match the record+-- type defined by the given table.+jsonPopulateRecordAs+  :: (KnownSymbol alias, Has tab schema ('Table table))+  => Alias tab+  -> Expression schema '[] 'Ungrouped params (nullity 'PGjson)+  -> Alias alias+  -> FromClause schema params '[alias ::: TableToRelation table]+jsonPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression+  (unsafeVariadicFunction "json_populate_record"+   (nullRow tableName :* expr :* Nil) `As` alias)++-- | Expands the binary JSON expression to a row whose columns match the record+-- type defined by the given table.+jsonbPopulateRecordAs+  :: (KnownSymbol alias, Has tab schema ('Table table))+  => Alias tab+  -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)+  -> Alias alias+  -> FromClause schema params '[alias ::: TableToRelation table]+jsonbPopulateRecordAs tableName expr alias = unsafeAliasedFromClauseExpression+  (unsafeVariadicFunction "jsonb_populate_record"+   (nullRow tableName :* expr :* Nil) `As` alias)++-- | Expands the outermost array of objects in the given JSON expression to a+-- set of rows whose columns match the record type defined by the given table.+jsonPopulateRecordSetAs+  :: (KnownSymbol alias, Has tab schema ('Table table))+  => Alias tab+  -> Expression schema '[] 'Ungrouped params (nullity 'PGjson)+  -> Alias alias+  -> FromClause schema params '[alias ::: TableToRelation table]+jsonPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression+  (unsafeVariadicFunction "json_populate_record_set"+   (nullRow tableName :* expr :* Nil) `As` alias)++-- | Expands the outermost array of objects in the given binary JSON expression+-- to a set of rows whose columns match the record type defined by the given+-- table.+jsonbPopulateRecordSetAs+  :: (KnownSymbol alias, Has tab schema ('Table table))+  => Alias tab+  -> Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)+  -> Alias alias+  -> FromClause schema params '[alias ::: TableToRelation table]+jsonbPopulateRecordSetAs tableName expr alias = unsafeAliasedFromClauseExpression+  (unsafeVariadicFunction "jsonb_populate_record_set"+   (nullRow tableName :* expr :* Nil) `As` alias)++renderTableTypeExpression+  :: All Top types+  => Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)+  -> ByteString+renderTableTypeExpression (hc `As` tab)+  = (renderAlias tab <>)+  . parenthesized+  . commaSeparated+  . flip appEndo []+  . hcfoldMap+    (Proxy :: Proxy Top)+    (\(ty `As` name) -> Endo+      ((renderAlias name <+> renderTypeExpression ty):))+  $ hc++unsafeTableAliasedFromClauseExpression+  :: All Top types+  => Expression schema' relations' grouping' params' ty'+  -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)+  -> FromClause schema params '[alias ::: types]+unsafeTableAliasedFromClauseExpression expr types = UnsafeFromClause+  (renderExpression expr+   <+> "AS"+   <+> renderTableTypeExpression types)++-- | Builds an arbitrary record from a JSON object. As with all functions+-- returning record, the caller must explicitly define the structure of the+-- record with an AS clause.+jsonToRecordAs+  :: All Top types+  => Expression schema '[] 'Ungrouped params (nullity 'PGjson)+  -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)+  -> FromClause schema params '[tab ::: types]+jsonToRecordAs expr types =+  unsafeTableAliasedFromClauseExpression+  (unsafeFunction "json_to_record" expr)+  types++-- | Builds an arbitrary record from a binary JSON object. As with all functions+-- returning record, the caller must explicitly define the structure of the+-- record with an AS clause.+jsonbToRecordAs+  :: All Top types+  => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)+  -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)+  -> FromClause schema params '[tab ::: types]+jsonbToRecordAs expr types =+  unsafeTableAliasedFromClauseExpression+  (unsafeFunction "jsonb_to_record" expr)+  types++-- | Builds an arbitrary set of records from a JSON array of objects (see note+-- below). As with all functions returning record, the caller must explicitly+-- define the structure of the record with an AS clause.+jsonToRecordSetAs+  :: All Top types+  => Expression schema '[] 'Ungrouped params (nullity 'PGjson)+  -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)+  -> FromClause schema params '[tab ::: types]+jsonToRecordSetAs expr types =+  unsafeTableAliasedFromClauseExpression+  (unsafeFunction "json_to_recordset" expr)+  types++-- | Builds an arbitrary set of records from a binary JSON array of objects (see+-- note below). As with all functions returning record, the caller must+-- explicitly define the structure of the record with an AS clause.+jsonbToRecordSetAs+  :: All Top types+  => Expression schema '[] 'Ungrouped params (nullity 'PGjsonb)+  -> Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)+  -> FromClause schema params '[tab ::: types]+jsonbToRecordSetAs expr types =+  unsafeTableAliasedFromClauseExpression+  (unsafeFunction "jsonb_to_recordset" expr)+  types  {----------------------------------------- FROM clauses
src/Squeal/PostgreSQL/Render.hs view
@@ -23,6 +23,8 @@   , (<+>)   , commaSeparated   , doubleQuoted+  , singleQuotedText+  , singleQuotedUtf8   , renderCommaSeparated   , renderCommaSeparatedMaybe   , renderNat@@ -34,10 +36,12 @@ import Data.ByteString (ByteString) import Data.Maybe import Data.Monoid ((<>))+import Data.Text (Text) import Generics.SOP import GHC.Exts import GHC.TypeLits-+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Data.ByteString as ByteString import qualified Data.ByteString.Char8 as Char8 @@ -56,6 +60,14 @@ -- | Add double quotes around a `ByteString`. doubleQuoted :: ByteString -> ByteString doubleQuoted str = "\"" <> str <> "\""++-- | Add single quotes around a `Text` and escape single quotes within it.+singleQuotedText :: Text -> ByteString+singleQuotedText str = "'" <> T.encodeUtf8 (T.replace "'" "''" str) <> "'"++-- | Add single quotes around a `ByteString` and escape single quotes within it.+singleQuotedUtf8 :: ByteString -> ByteString+singleQuotedUtf8 = singleQuotedText . T.decodeUtf8  -- | Comma separate the renderings of a heterogeneous list. renderCommaSeparated
src/Squeal/PostgreSQL/Schema.hs view
@@ -10,7 +10,7 @@ It also defines useful type families to operate on these. Finally, it defines an embedding of Haskell types into Postgres types. -}-+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} {-# LANGUAGE     AllowAmbiguousTypes   , ConstraintKinds@@ -69,6 +69,7 @@   , HasAll   , IsLabel (..)   , IsQualified (..)+  , renderAliasString     -- * Enumerated Labels   , IsPGlabel (..)   , PGlabel (..)@@ -90,6 +91,9 @@   , PGIntegral   , PGFloating   , PGTypeOf+  , PGarrayOf+  , PGarray+  , PGtextArray   , SameTypes   , SamePGType   , AllNotNull@@ -100,8 +104,13 @@   , ColumnsToRelation   , TableToColumns   , TableToRelation+  , RelationToRowType+  , RelationToNullityTypes   , ConstraintInvolves   , DropIfConstraintsInvolve+    -- ** JSON support+  , PGjson_+  , PGjsonKey     -- * Embedding   , PG   , EnumFrom@@ -371,6 +380,11 @@ renderAlias :: KnownSymbol alias => Alias alias -> ByteString renderAlias = doubleQuoted . fromString . symbolVal +-- | >>> renderAliasString #ohmahgerd+-- "'ohmahgerd'"+renderAliasString :: KnownSymbol alias => Alias alias -> ByteString+renderAliasString = singleQuotedText . fromString . symbolVal+ -- | >>> import Generics.SOP (NP(..)) -- >>> renderAliases (#jimbob :* #kandi) -- ["\"jimbob\"","\"kandi\""]@@ -524,6 +538,37 @@ -- `Squeal.PostgreSQL.Expression.mod_` functions. type PGIntegral ty = In ty '[ 'PGint2, 'PGint4, 'PGint8] +-- | Error message helper for displaying unavailable\/unknown\/placeholder type+-- variables whose kind is known.+type Placeholder k = 'Text "(_::" :<>: 'ShowType k :<>: 'Text ")"++type ErrArrayOf arr ty = arr :<>: 'Text " " :<>: ty+type ErrPGfixarrayOf t = ErrArrayOf ('ShowType 'PGfixarray :<>: 'Text " " :<>: Placeholder Nat) t+type ErrPGvararrayOf t = ErrArrayOf ('ShowType 'PGvararray) t++-- | Ensure a type is a valid array type.+type family PGarray name arr :: Constraint where+  PGarray name ('PGvararray x) = ()+  PGarray name ('PGfixarray n x) = ()+  PGarray name val = TypeError+    ('Text name :<>: 'Text ": Unsatisfied PGarray constraint. Expected either: "+     :$$: 'Text " • " :<>: ErrPGvararrayOf (Placeholder PGType)+     :$$: 'Text " • " :<>: ErrPGfixarrayOf (Placeholder PGType)+     :$$: 'Text "But got: " :<>: 'ShowType val)++-- | Ensure a type is a valid array type with a specific element type.+type family PGarrayOf name arr ty :: Constraint where+  PGarrayOf name ('PGvararray x) ty = x ~ ty+  PGarrayOf name ('PGfixarray n x) ty = x ~ ty+  PGarrayOf name val ty = TypeError+    ( 'Text name :<>: 'Text "Unsatisfied PGarrayOf constraint. Expected either: "+      :$$: 'Text " • " :<>: ErrPGvararrayOf ( 'ShowType ty )+      :$$: 'Text " • " :<>: ErrPGfixarrayOf ( 'ShowType ty )+      :$$: 'Text "But got: " :<>: 'ShowType val)++-- | Ensure a type is a valid array type whose elements are text.+type PGtextArray name arr = PGarrayOf name arr 'PGtext+ -- | `PGTypeOf` forgets about @NULL@ and any column constraints. type family PGTypeOf (ty :: NullityType) :: PGType where   PGTypeOf (nullity pg) = pg@@ -573,6 +618,16 @@   NullifyRelations (table ::: columns ': tables) =     table ::: NullifyRelation columns ': NullifyRelations tables +-- | `RelationToRowType` drops the nullity constraints of its argument relations.+type family RelationToRowType (tables :: RelationType) :: [(Symbol, PGType)] where+  RelationToRowType (nullity x : xs) = x : RelationToRowType xs+  RelationToRowType '[] = '[]++-- | `RelationToNullityTypes` drops the column constraints.+type family RelationToNullityTypes (rel :: RelationType) :: [NullityType] where+  RelationToNullityTypes ('(k, x) : xs) = x : RelationToNullityTypes xs+  RelationToNullityTypes '[]            = '[]+ -- | `Join` is simply promoted `++` and is used in @JOIN@s in -- `Squeal.PostgreSQL.Query.FromClause`s. type family Join xs ys where@@ -857,3 +912,10 @@   RecordCodeOf _hask '[tys] = tys   RecordCodeOf hask _tys = TypeError     ('Text "RecordCodeOf error: non-Record type " ':<>: 'ShowType hask)++-- | Is a type a valid JSON key?+type PGjsonKey key = key `In` '[ 'PGint2, 'PGint4, 'PGtext ]++-- | Is a type a valid JSON type?+type PGjson_ json = json `In` '[ 'PGjson, 'PGjsonb ]+