84f57ee · squeal · git.iko.soy

git.iko.soy/squeal

on dev help sign in

various improvements

84f57eeMike Ledger8 years ago

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

compare with dev

unifiedsplit

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

91 , PGarrayOf

92 , PGjsonKey

93 , PGjson_

94− , PGobjectpairs

95 , (.->)

94 , (.->)

96 , (.->>)

95 , (.->>)

97 , (.#>)

96 , (.#>)

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

102 , (.?)

101 , (.?)

103 , (.?|)

102 , (.?|)

104 , (.?&)

103 , (.?&)

105− , (.||.)

106 , (.-.)

104 , (.-.)

107 , (#-.)

105 , (#-.)

108 -- *** Functions

106 -- *** Functions

107+ , jsonLit

108+ , jsonbLit

109 , toJson

110 , toJsonb

111 , arrayToJson

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

185import Control.Category

186import Control.DeepSeq

187import Data.ByteString (ByteString)

188+import Data.ByteString.Lazy (toStrict)

188import Data.Function ((&))

189import Data.Function ((&))

189−import Data.Semigroup

190+import Data.Semigroup hiding (All)

191+import qualified Data.Aeson as JSON

190import Data.Ratio

192import Data.Ratio

191import Data.String

193import Data.String

192import Generics.SOP hiding (from)

194import Generics.SOP hiding (from)

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

972(.@>)

974(.@>)

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

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

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

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

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

977+ -> Condition schema relations grouping params

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

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

977

979

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

980-- | 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

980(.<@)

982(.<@)

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

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

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

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

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

985+ -> Condition schema relations grouping params

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

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

985

987

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

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

987(.?)

989(.?)

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

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

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

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

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

992+ -> Condition schema relations grouping params

991(.?) = unsafeBinaryOp "?"

993(.?) = unsafeBinaryOp "?"

992

994

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

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

994(.?|)

996(.?|)

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

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

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

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

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

999+ -> Condition schema relations grouping params

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

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

999

1001

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

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

1001(.?&)

1003(.?&)

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

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

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

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

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

1006+ -> Condition schema relations grouping params

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

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

1006

1008

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

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

1008−(.||.)

1010+instance

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

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

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

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

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

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

1013

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

1015--

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

1043Table 9.45: JSON creation functions

1044-----------------------------------------}

1045

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+

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

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

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

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

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

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

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

1066toJsonb = unsafeUnaryOp "to_jsonb"

1074toJsonb = unsafeUnaryOp "to_jsonb"

1067

1075

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

1076-- | 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

1077+-- becomes a JSON array of arrays.

1070−-- elements if pretty_bool is true.

1071arrayToJson

1078arrayToJson

1072 :: PGarray "arrayToJson" arr

1079 :: PGarray "arrayToJson" arr

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

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

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

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

1075arrayToJson = unsafeFunction "array_to_json"

1082arrayToJson = unsafeFunction "array_to_json"

1076

1083

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

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

1078−-- elements if pretty_bool is true.

1079rowToJson

1085rowToJson

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

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

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

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

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

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

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

1098jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"

1104jsonbBuildArray = unsafeVariadicFunction "jsonb_build_array"

1099

1105

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+

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

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

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

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

1102-- and values.

1117-- and values.

1103jsonBuildObject

1118jsonBuildObject

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

1119+ :: All Top elems

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

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

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

1121 -> 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

1108

1127

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

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

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

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

1111-- between text and values.

1130-- between text and values.

1112jsonbBuildObject

1131jsonbBuildObject

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

1132+ :: All Top elems

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

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

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

1134 -> 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

1117

1140

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

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

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

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

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

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

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

1175jsonbArrayLength = unsafeFunction "jsonb_array_length"

1198jsonbArrayLength = unsafeFunction "jsonb_array_length"

1176

1199

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).

1178jsonExtractPath

1202jsonExtractPath

1179 :: SListI elems

1203 :: SListI elems

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

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

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

1183jsonExtractPath x xs =

1207jsonExtractPath x xs =

1184 unsafeVariadicFunction "json_extract_path" (x :* xs)

1208 unsafeVariadicFunction "json_extract_path" (x :* xs)

1185

1209

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).

1187jsonbExtractPath

1212jsonbExtractPath

1188 :: SListI elems

1213 :: SListI elems

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

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

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

1192jsonbExtractPath x xs =

1217jsonbExtractPath x xs =

1193 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)

1218 unsafeVariadicFunction "jsonb_extract_path" (x :* xs)

1194

1219

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

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

1196−-- as text.

1221+-- operator), as text.

1197jsonExtractPathAsText

1222jsonExtractPathAsText

1198 :: SListI elems

1223 :: SListI elems

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

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

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

1202jsonExtractPathAsText x xs =

1227jsonExtractPathAsText x xs =

1203 unsafeVariadicFunction "json_extract_path_text" (x :* xs)

1228 unsafeVariadicFunction "json_extract_path_text" (x :* xs)

1204

1229

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

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

1206−-- as text.

1231+-- operator), as text.

1207jsonbExtractPathAsText

1232jsonbExtractPathAsText

1208 :: SListI elems

1233 :: SListI elems

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

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

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

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

746 :: All Top types

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

748 -> ByteString

749−renderTableTypeExpression (hc `As` tab) =

749+renderTableTypeExpression (hc `As` tab)

750− (renderAlias tab <>)

750+ = (renderAlias tab <>)

751 . parenthesized

752 . commaSeparated

753 . flip appEndo []

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

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

23 , (<+>)

24 , commaSeparated

25 , doubleQuoted

26+ , singleQuotedText

27+ , singleQuotedUtf8

26 , renderCommaSeparated

28 , renderCommaSeparated

27 , renderCommaSeparatedMaybe

29 , renderCommaSeparatedMaybe

28 , renderNat

30 , renderNat

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

34import Data.ByteString (ByteString)

36import Data.ByteString (ByteString)

35import Data.Maybe

37import Data.Maybe

36import Data.Monoid ((<>))

38import Data.Monoid ((<>))

39+import Data.Text (Text)

37import Generics.SOP

40import Generics.SOP

38import GHC.Exts

41import GHC.Exts

39import GHC.TypeLits

42import GHC.TypeLits

40−

43+import qualified Data.Text as T

44+import qualified Data.Text.Encoding as T

41import qualified Data.ByteString as ByteString

45import qualified Data.ByteString as ByteString

42import qualified Data.ByteString.Char8 as Char8

46import qualified Data.ByteString.Char8 as Char8

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

57doubleQuoted :: ByteString -> ByteString

61doubleQuoted :: ByteString -> ByteString

58doubleQuoted str = "\"" <> str <> "\""

62doubleQuoted str = "\"" <> str <> "\""

64+singleQuotedText :: Text -> ByteString

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

66+

67+singleQuotedUtf8 :: ByteString -> ByteString

68+singleQuotedUtf8 = singleQuotedText . T.decodeUtf8

69+

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

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

61renderCommaSeparated

71renderCommaSeparated

62 :: SListI xs

72 :: SListI xs

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

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

68 , HasAll

69 , IsLabel (..)

70 , IsQualified (..)

71+ , renderAliasString

71 -- * Enumerated Labels

72 -- * Enumerated Labels

72 , IsPGlabel (..)

73 , IsPGlabel (..)

73 , PGlabel (..)

74 , PGlabel (..)

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

92 , PGarrayOf

93 , PGarrayOf

93 , PGarray

94 , PGarray

94 , PGtextArray

95 , PGtextArray

95− , PGobjectpairs

96 , SameTypes

97 , SamePGType

98 , AllNotNull

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

104 , TableToColumns

105 , TableToRelation

106 , RelationToRowType

107+ , RelationToNullityTypes

107 , ConstraintInvolves

108 , ConstraintInvolves

108 , DropIfConstraintsInvolve

109 , DropIfConstraintsInvolve

109 -- ** JSON support

110 -- ** JSON support

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

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

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

379renderAlias = doubleQuoted . fromString . symbolVal

380renderAlias = doubleQuoted . fromString . symbolVal

380

381

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

383+renderAliasString = singleQuotedText . fromString . symbolVal

384+

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

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

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

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

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

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

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

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

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

546type PGtextArray name arr = PGarrayOf name arr 'PGtext

550type PGtextArray name arr = PGarrayOf name arr 'PGtext

547

551

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−

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

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

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

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

559 PGTypeOf (nullity pg) = pg

554 PGTypeOf (nullity pg) = pg

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

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

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

609 RelationToRowType '[] = '[]

604 RelationToRowType '[] = '[]

610

605

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

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

608+ RelationToNullityTypes '[] = '[]

609+

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

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

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

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

613type family Join xs ys where

612type family Join xs ys where