array nullability

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)

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

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)

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