84f57ee · squeal · git.iko.soy

git.iko.soy/squeal

various improvements

- add a function for inserting literal json - remove .||. in favour of semigroup instance - rephrase some comments from their original postgres docs form - have a idiomatic jsonbBuildObject/jsonBuildObject functions

commit84f57ee2da2e342f217a0407faa3f285e634dc34 authorMike Ledger <mike@quasimal.com> dateFri 13 Jul 2018, 14:48 (8 years ago) parent3033915

4 files changed+76−42

compare with dev

unifiedsplit

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+54−29 squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+2−2 squeal-postgresql/src/Squeal/PostgreSQL/Render.hs+11−1 squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+9−10

squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs+54−29

@@ -91,7 +91,6 @@ module Squeal.PostgreSQL.Expression

9191 , PGarrayOf

9292 , PGjsonKey

9393 , PGjson_

94− , PGobjectpairs

9594 , (.->)

9695 , (.->>)

9796 , (.#>)

@@ -102,10 +101,11 @@ module Squeal.PostgreSQL.Expression

102101 , (.?)

103102 , (.?|)

104103 , (.?&)

105− , (.||.)

106104 , (.-.)

107105 , (#-.)

108106 -- *** Functions

107+ , jsonLit

108+ , jsonbLit

109109 , toJson

110110 , toJsonb

111111 , arrayToJson

@@ -185,8 +185,10 @@ module Squeal.PostgreSQL.Expression

185185import Control.Category

186186import Control.DeepSeq

187187import Data.ByteString (ByteString)

188+import Data.ByteString.Lazy (toStrict)

188189import Data.Function ((&))

189−import Data.Semigroup

190+import Data.Semigroup hiding (All)

191+import qualified Data.Aeson as JSON

190192import Data.Ratio

191193import Data.String

192194import Generics.SOP hiding (from)

@@ -972,7 +974,7 @@ Table 9.44: json and jsonb operators

972974(.@>)

973975 :: Expression schema relations grouping params (nullity 'PGjsonb)

974976 -> Expression schema relations grouping params (nullity 'PGjsonb)

975− -> Expression schema relations grouping params ('NotNull 'PGbool)

977+ -> Condition schema relations grouping params

976978(.@>) = unsafeBinaryOp "@>"

977979

978980-- | Are the left JSON path/value entries contained at the top level within the

@@ -980,36 +982,34 @@ Table 9.44: json and jsonb operators

980982(.<@)

981983 :: Expression schema relations grouping params (nullity 'PGjsonb)

982984 -> Expression schema relations grouping params (nullity 'PGjsonb)

983− -> Expression schema relations grouping params ('NotNull 'PGbool)

985+ -> Condition schema relations grouping params

984986(.<@) = unsafeBinaryOp "<@"

985987

986988-- | Does the string exist as a top-level key within the JSON value?

987989(.?)

988990 :: Expression schema relations grouping params (nullity 'PGjsonb)

989991 -> Expression schema relations grouping params (nullity 'PGtext)

990− -> Expression schema relations grouping params ('NotNull 'PGbool)

992+ -> Condition schema relations grouping params

991993(.?) = unsafeBinaryOp "?"

992994

993995-- | Do any of these array strings exist as top-level keys?

994996(.?|)

995997 :: Expression schema relations grouping params (nullity 'PGjsonb)

996998 -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))

997− -> Expression schema relations grouping params ('NotNull 'PGbool)

999+ -> Condition schema relations grouping params

9981000(.?|) = unsafeBinaryOp "?|"

9991001

10001002-- | Do all of these array strings exist as top-level keys?

10011003(.?&)

10021004 :: Expression schema relations grouping params (nullity 'PGjsonb)

10031005 -> Expression schema relations grouping params (nullity ('PGvararray 'PGtext))

1004− -> Expression schema relations grouping params ('NotNull 'PGbool)

1006+ -> Condition schema relations grouping params

10051007(.?&) = unsafeBinaryOp "?&"

10061008

10071009-- | Concatenate two jsonb values into a new jsonb value.

1008−(.||.)

1009− :: Expression schema relations grouping params (nullity 'PGjsonb)

1010− -> Expression schema relations grouping params (nullity 'PGjsonb)

1011− -> Expression schema relations grouping params (nullity 'PGjsonb)

1012−(.||.) = unsafeBinaryOp "||"

1010+instance

1011+ Semigroup (Expression schema relations grouping param (nullity 'PGjsonb)) where

1012+ (<>) = unsafeBinaryOp "||"

10131013

10141014-- | Delete a key or keys from a JSON object, or remove an array element.

10151015--

@@ -1043,6 +1043,14 @@ Table 9.44: json and jsonb operators

10431043Table 9.45: JSON creation functions

10441044-----------------------------------------}

10451045

1046+-- | Literal binary JSON

1047+jsonbLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjsonb)

1048+jsonbLit = cast jsonb . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode

1049+

1050+-- | Literal JSON

1051+jsonLit :: JSON.Value -> Expression schema relations grouping params (nullity 'PGjson)

1052+jsonLit = cast json . UnsafeExpression . singleQuotedUtf8 . toStrict . JSON.encode

1053+

10461054-- | Returns the value as json. Arrays and composites are converted

10471055-- (recursively) to arrays and objects; otherwise, if there is a cast from the

10481056-- type to json, the cast function will be used to perform the conversion;

@@ -1066,16 +1074,14 @@ toJsonb

10661074toJsonb = unsafeUnaryOp "to_jsonb"

10671075

10681076-- | Returns the array as a JSON array. A PostgreSQL multidimensional array

1069−-- becomes a JSON array of arrays. Line feeds will be added between dimension-1

1070−-- elements if pretty_bool is true.

1077+-- becomes a JSON array of arrays.

10711078arrayToJson

10721079 :: PGarray "arrayToJson" arr

10731080 => Expression schema relations grouping params (nullity arr)

10741081 -> Expression schema relations grouping params (nullity 'PGjson)

10751082arrayToJson = unsafeFunction "array_to_json"

10761083

1077−-- | Returns the row as a JSON object. Line feeds will be added between level-1

1078−-- elements if pretty_bool is true.

1084+-- | Returns the row as a JSON object.

10791085rowToJson

10801086 :: Expression schema relations grouping params (nullity ('PGcomposite ty))

10811087 -> Expression schema relations grouping params (nullity 'PGjson)

@@ -1097,23 +1103,40 @@ jsonbBuildArray

10971103 -> Expression schema relations grouping params (nullity 'PGjsonb)

10981104jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"

10991105

1106+unsafeRowFunction

1107+ :: All Top elems

1108+ => NP (Aliased (Expression schema relations grouping params)) elems

1109+ -> [ByteString]

1110+unsafeRowFunction =

1111+ (`appEndo` []) . hcfoldMap (Proxy :: Proxy Top)

1112+ (\(col `As` name) -> Endo $ \xs ->

1113+ renderAliasString name : renderExpression col : xs)

1114+

11001115-- | Builds a possibly-heterogeneously-typed JSON object out of a variadic

11011116-- argument list. The elements of the argument list must alternate between text

11021117-- and values.

11031118jsonBuildObject

1104− :: (PGobjectpairs "jsonBuildObject" elems, SListI elems)

1105− => NP (Expression schema relations grouping params) elems

1119+ :: All Top elems

1120+ => NP (Aliased (Expression schema relations grouping params)) elems

11061121 -> Expression schema relations grouping params (nullity 'PGjson)

1107−jsonBuildObject = unsafeVariadicFunction "json_build_object"

1122+jsonBuildObject

1123+ = unsafeFunction "json_build_object"

1124+ . UnsafeExpression

1125+ . commaSeparated

1126+ . unsafeRowFunction

11081127

11091128-- | Builds a possibly-heterogeneously-typed (binary) JSON object out of a

11101129-- variadic argument list. The elements of the argument list must alternate

11111130-- between text and values.

11121131jsonbBuildObject

1113− :: (PGobjectpairs "jsonbBuildObject" elems, SListI elems)

1114− => NP (Expression schema relations grouping params) elems

1132+ :: All Top elems

1133+ => NP (Aliased (Expression schema relations grouping params)) elems

11151134 -> Expression schema relations grouping params (nullity 'PGjsonb)

1116−jsonbBuildObject = unsafeVariadicFunction "jsonb_build_object"

1135+jsonbBuildObject

1136+ = unsafeFunction "jsonb_build_object"

1137+ . UnsafeExpression

1138+ . commaSeparated

1139+ . unsafeRowFunction

11171140

11181141-- | Builds a JSON object out of a text array. The array must have either

11191142-- exactly one dimension with an even number of members, in which case they are

@@ -1174,7 +1197,8 @@ jsonbArrayLength

11741197 -> Expression schema relations grouping params (nullity 'PGint4)

11751198jsonbArrayLength = unsafeFunction "jsonb_array_length"

11761199

1177−-- | Returns JSON value pointed to by path_elems (equivalent to #> operator).

1200+-- | Returns JSON value pointed to by the given path (equivalent to #>

1201+-- operator).

11781202jsonExtractPath

11791203 :: SListI elems

11801204 => Expression schema relations grouping params (nullity 'PGjson)

@@ -1183,7 +1207,8 @@ jsonExtractPath

11831207jsonExtractPath x xs =

11841208 unsafeVariadicFunction "json_extract_path" (x :* xs)

11851209

1186−-- | Returns JSON value pointed to by path_elems (equivalent to #> operator).

1210+-- | Returns JSON value pointed to by the given path (equivalent to #>

1211+-- operator).

11871212jsonbExtractPath

11881213 :: SListI elems

11891214 => Expression schema relations grouping params (nullity 'PGjsonb)

@@ -1192,8 +1217,8 @@ jsonbExtractPath

11921217jsonbExtractPath x xs =

11931218 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)

11941219

1195−-- | Returns JSON value pointed to by path_elems (equivalent to #> operator),

1196−-- as text.

1220+-- | Returns JSON value pointed to by the given path (equivalent to #>

1221+-- operator), as text.

11971222jsonExtractPathAsText

11981223 :: SListI elems

11991224 => Expression schema relations grouping params (nullity 'PGjson)

@@ -1202,8 +1227,8 @@ jsonExtractPathAsText

12021227jsonExtractPathAsText x xs =

12031228 unsafeVariadicFunction "json_extract_path_text" (x :* xs)

12041229

1205−-- | Returns JSON value pointed to by path_elems (equivalent to #> operator),

1206−-- as text.

1230+-- | Returns JSON value pointed to by the given path (equivalent to #>

1231+-- operator), as text.

12071232jsonbExtractPathAsText

12081233 :: SListI elems

12091234 => Expression schema relations grouping params (nullity 'PGjsonb)

squeal-postgresql/src/Squeal/PostgreSQL/Query.hs+2−2

@@ -746,8 +746,8 @@ renderTableTypeExpression

746746 :: All Top types

747747 => Aliased (NP (Aliased (TypeExpression schema))) (tab ::: types)

748748 -> ByteString

749−renderTableTypeExpression (hc `As` tab) =

750− (renderAlias tab <>)

749+renderTableTypeExpression (hc `As` tab)

750+ = (renderAlias tab <>)

751751 . parenthesized

752752 . commaSeparated

753753 . flip appEndo []

squeal-postgresql/src/Squeal/PostgreSQL/Render.hs+11−1

@@ -23,6 +23,8 @@ module Squeal.PostgreSQL.Render

2323 , (<+>)

2424 , commaSeparated

2525 , doubleQuoted

26+ , singleQuotedText

27+ , singleQuotedUtf8

2628 , renderCommaSeparated

2729 , renderCommaSeparatedMaybe

2830 , renderNat

@@ -34,10 +36,12 @@ import Control.Monad.Base

3436import Data.ByteString (ByteString)

3537import Data.Maybe

3638import Data.Monoid ((<>))

39+import Data.Text (Text)

3740import Generics.SOP

3841import GHC.Exts

3942import GHC.TypeLits

40−

43+import qualified Data.Text as T

44+import qualified Data.Text.Encoding as T

4145import qualified Data.ByteString as ByteString

4246import qualified Data.ByteString.Char8 as Char8

4347

@@ -57,6 +61,12 @@ commaSeparated = ByteString.intercalate ", "

5761doubleQuoted :: ByteString -> ByteString

5862doubleQuoted str = "\"" <> str <> "\""

5963

64+singleQuotedText :: Text -> ByteString

65+singleQuotedText str = "'" <> T.encodeUtf8 (T.replace "'" "''" str) <> "'"

66+

67+singleQuotedUtf8 :: ByteString -> ByteString

68+singleQuotedUtf8 = singleQuotedText . T.decodeUtf8

69+

6070-- | Comma separate the renderings of a heterogeneous list.

6171renderCommaSeparated

6272 :: SListI xs

squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs+9−10

@@ -68,6 +68,7 @@ module Squeal.PostgreSQL.Schema

6868 , HasAll

6969 , IsLabel (..)

7070 , IsQualified (..)

71+ , renderAliasString

7172 -- * Enumerated Labels

7273 , IsPGlabel (..)

7374 , PGlabel (..)

@@ -92,7 +93,6 @@ module Squeal.PostgreSQL.Schema

9293 , PGarrayOf

9394 , PGarray

9495 , PGtextArray

95− , PGobjectpairs

9696 , SameTypes

9797 , SamePGType

9898 , AllNotNull

@@ -104,6 +104,7 @@ module Squeal.PostgreSQL.Schema

104104 , TableToColumns

105105 , TableToRelation

106106 , RelationToRowType

107+ , RelationToNullityTypes

107108 , ConstraintInvolves

108109 , DropIfConstraintsInvolve

109110 -- ** JSON support

@@ -378,6 +379,9 @@ instance KnownSymbol alias => RenderSQL (Alias alias) where renderSQL = renderAl

378379renderAlias :: KnownSymbol alias => Alias alias -> ByteString

379380renderAlias = doubleQuoted . fromString . symbolVal

380381

382+renderAliasString :: KnownSymbol alias => Alias alias -> ByteString

383+renderAliasString = singleQuotedText . fromString . symbolVal

384+

381385-- | >>> import Generics.SOP (NP(..))

382386-- >>> renderAliases (#jimbob :* #kandi :* Nil)

383387-- ["\"jimbob\"","\"kandi\""]

@@ -545,15 +549,6 @@ type family PGarrayOf name arr ty :: Constraint where

545549-- | Ensure a type is a valid array type whose elements are text.

546550type PGtextArray name arr = PGarrayOf name arr 'PGtext

547551

548−-- | Ensure a list of arguments is an alternating list of text and value pairs.

549−type family PGobjectpairs name x :: Constraint where

550− PGobjectpairs name ('NotNull 'PGtext : arg : xs) = PGobjectpairs name xs

551− PGobjectpairs name '[] = ()

552− PGobjectpairs name (x:xs) = TypeError

553− ( 'Text name :<>: 'Text ": Incorrect argument list:"

554− :$$: 'Text "Expected alternating list of keys and values."

555− :$$: 'Text "But got " :<>: 'ShowType (x:xs))

556−

557552-- | `PGTypeOf` forgets about @NULL@ and any column constraints.

558553type family PGTypeOf (ty :: NullityType) :: PGType where

559554 PGTypeOf (nullity pg) = pg

@@ -608,6 +603,10 @@ type family RelationToRowType (tables :: RelationType) :: [(Symbol, PGType)] whe

608603 RelationToRowType (nullity x : xs) = x : RelationToRowType xs

609604 RelationToRowType '[] = '[]

610605

606+type family RelationToNullityTypes (rel :: RelationType) :: [NullityType] where

607+ RelationToNullityTypes ('(k, x) : xs) = x : RelationToNullityTypes xs

608+ RelationToNullityTypes '[] = '[]

609+

611610-- | `Join` is simply promoted `++` and is used in @JOIN@s in

612611-- `Squeal.PostgreSQL.Query.FromClause`s.

613612type family Join xs ys where