From 739a943cea446a8b22b54a22954f229cdbec15c5 Mon Sep 17 00:00:00 2001 From: Eitan Chatav Date: Tue, 10 Jul 2018 10:05:39 -0700 Subject: [PATCH] array nullability --- squeal-postgresql/exe/Example.hs | 6 ++-- .../src/Squeal/PostgreSQL/Binary.hs | 34 ++++++++++++++----- .../src/Squeal/PostgreSQL/Expression.hs | 25 +++++++------- .../src/Squeal/PostgreSQL/Schema.hs | 4 +-- 4 files changed, 43 insertions(+), 26 deletions(-) diff --git a/squeal-postgresql/exe/Example.hs b/squeal-postgresql/exe/Example.hs index a0fb868..4c43b70 100644 --- a/squeal-postgresql/exe/Example.hs +++ b/squeal-postgresql/exe/Example.hs @@ -29,7 +29,7 @@ type Schema = '[ "pk_users" ::: 'PrimaryKey '["id"] ] :=> '[ "id" ::: 'Def :=> 'NotNull 'PGint4 , "name" ::: 'NoDef :=> 'NotNull 'PGtext - , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray 'PGint2) + , "vec" ::: 'NoDef :=> 'NotNull ('PGvararray ('Null 'PGint2)) ]) , "emails" ::: 'Table ( '[ "pk_emails" ::: 'PrimaryKey '["id"] @@ -60,7 +60,7 @@ setup = teardown :: Definition Schema '[] teardown = dropTable #emails >>> dropTable #users -insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray 'PGint2)] +insertUser :: Manipulation Schema '[ 'NotNull 'PGtext, 'NotNull ('PGvararray ('Null 'PGint2))] '[ "fromOnly" ::: 'NotNull 'PGint4 ] insertUser = insertRows #users (Default `as` #id :* Set (param @1) `as` #name :* Set (param @2) `as` #vec) [] @@ -76,7 +76,7 @@ insertEmail = insertRows #emails getUsers :: Query Schema '[] '[ "userName" ::: 'NotNull 'PGtext , "userEmail" ::: 'Null 'PGtext - , "userVec" ::: 'NotNull ('PGvararray 'PGint2)] + , "userVec" ::: 'NotNull ('PGvararray ('Null 'PGint2))] getUsers = select (#u ! #name `as` #userName :* #e ! #email `as` #userEmail :* #u ! #vec `as` #userVec) ( from (table (#users `as` #u) diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs index 0c90fd4..2bbf70a 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs @@ -235,9 +235,13 @@ instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast instance (HasOid pg, ToParam x pg) - => ToParam (Vector (Maybe x)) ('PGvararray pg) where + => ToParam (Vector (Maybe x)) ('PGvararray ('Null pg)) where toParam = K . Encoding.nullableArray_vector (oid @pg) (unK . toParam @x @pg) +instance (HasOid pg, ToParam x pg) + => ToParam (Vector x) ('PGvararray ('NotNull pg)) where + toParam = K . Encoding.array_vector + (oid @pg) (unK . toParam @x @pg) instance ( IsEnumType x , HasDatatypeInfo x @@ -386,14 +390,26 @@ instance FromValue 'PGinterval DiffTime where fromValue _ = Decoding.interval_int instance FromValue 'PGjson Value where fromValue _ = Decoding.json_ast instance FromValue 'PGjsonb Value where fromValue _ = Decoding.jsonb_ast -instance FromValue pg y => FromValue ('PGvararray pg) (Vector (Maybe y)) where - fromValue _ = Decoding.array - (Decoding.dimensionArray Vector.replicateM - (Decoding.nullableValueArray (fromValue (Proxy @pg)))) -instance FromValue pg y => FromValue ('PGfixarray n pg) (Vector (Maybe y)) where - fromValue _ = Decoding.array - (Decoding.dimensionArray Vector.replicateM - (Decoding.nullableValueArray (fromValue (Proxy @pg)))) +instance FromValue pg y + => FromValue ('PGvararray ('Null pg)) (Vector (Maybe y)) where + fromValue _ = Decoding.array + (Decoding.dimensionArray Vector.replicateM + (Decoding.nullableValueArray (fromValue (Proxy @pg)))) +instance FromValue pg y + => FromValue ('PGvararray ('NotNull pg)) (Vector y) where + fromValue _ = Decoding.array + (Decoding.dimensionArray Vector.replicateM + (Decoding.valueArray (fromValue (Proxy @pg)))) +instance FromValue pg y + => FromValue ('PGfixarray n ('Null pg)) (Vector (Maybe y)) where + fromValue _ = Decoding.array + (Decoding.dimensionArray Vector.replicateM + (Decoding.nullableValueArray (fromValue (Proxy @pg)))) +instance FromValue pg y + => FromValue ('PGfixarray n ('NotNull pg)) (Vector y) where + fromValue _ = Decoding.array + (Decoding.dimensionArray Vector.replicateM + (Decoding.valueArray (fromValue (Proxy @pg)))) instance ( IsEnumType y , HasDatatypeInfo y diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs index 2b40ccc..8e3d9d2 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Expression.hs @@ -382,7 +382,7 @@ nullIf x y = UnsafeExpression $ "NULL IF" <+> parenthesized -- | >>> printSQL $ array [null_, notNull false, notNull true] -- ARRAY[NULL, FALSE, TRUE] array - :: [Expression schema relations grouping params ('Null ty)] + :: [Expression schema relations grouping params ty] -- ^ array elements -> Expression schema relations grouping params (nullity ('PGvararray ty)) array xs = UnsafeExpression $ @@ -1206,19 +1206,18 @@ jsonb = UnsafeTypeExpression "jsonb" -- | variable length array vararray :: TypeExpression schema pg - -> TypeExpression schema ('PGvararray pg) + -> TypeExpression schema ('PGvararray (nullity pg)) vararray ty = UnsafeTypeExpression $ renderTypeExpression ty <> "[]" -- | fixed length array -- -- >>> renderTypeExpression (fixarray (Proxy @2) json) -- "json[2]" fixarray - :: KnownNat n - => proxy n - -> TypeExpression schema pg - -> TypeExpression schema ('PGfixarray n pg) -fixarray p ty = UnsafeTypeExpression $ - renderTypeExpression ty <> "[" <> renderNat p <> "]" + :: forall n schema nullity pg. KnownNat n + => TypeExpression schema pg + -> TypeExpression schema ('PGfixarray n (nullity pg)) +fixarray ty = UnsafeTypeExpression $ + renderTypeExpression ty <> "[" <> renderNat (Proxy @n) <> "]" -- | `pgtype` is a demoted version of a `PGType` class PGTyped schema (ty :: PGType) where pgtype :: TypeExpression schema ty @@ -1244,7 +1243,9 @@ instance PGTyped schema 'PGinterval where pgtype = interval instance PGTyped schema 'PGuuid where pgtype = uuid instance PGTyped schema 'PGjson where pgtype = json instance PGTyped schema 'PGjsonb where pgtype = jsonb -instance PGTyped schema ty => PGTyped schema ('PGvararray ty) where - pgtype = vararray (pgtype @schema @ty) -instance (KnownNat n, PGTyped schema ty) => PGTyped schema ('PGfixarray n ty) where - pgtype = fixarray (Proxy @n) (pgtype @schema @ty) +instance PGTyped schema ty + => PGTyped schema ('PGvararray (nullity ty)) where + pgtype = vararray (pgtype @schema @ty) +instance (KnownNat n, PGTyped schema ty) + => PGTyped schema ('PGfixarray n (nullity ty)) where + pgtype = fixarray @n (pgtype @schema @ty) diff --git a/squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs b/squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs index 31d0b2b..95da328 100644 --- a/squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs +++ b/squeal-postgresql/src/Squeal/PostgreSQL/Schema.hs @@ -174,8 +174,8 @@ data PGType | PGinet -- ^ IPv4 or IPv6 host address | PGjson -- ^ textual JSON data | PGjsonb -- ^ binary JSON data, decomposed - | PGvararray PGType -- ^ variable length array - | PGfixarray Nat PGType -- ^ fixed length array + | PGvararray NullityType -- ^ variable length array + | PGfixarray Nat NullityType -- ^ fixed length array | PGenum [Symbol] -- ^ enumerated (enum) types are data types that comprise a static, ordered set of values. | PGcomposite [(Symbol, PGType)] -- ^ a composite type represents the structure of a row or record; it is essentially just a list of field names and their data types. | UnsafePGType Symbol -- ^ an escape hatch for unsupported PostgreSQL types