@@ -134,8 +134,10 @@ Person {name = Just "Faisal", age = Just 24}
134134 , DeriveFunctor
135135 , DeriveGeneric
136136 , DeriveTraversable
137+ , DefaultSignatures
137138 , FlexibleContexts
138139 , FlexibleInstances
140+ , FunctionalDependencies
139141 , GADTs
140142 , LambdaCase
141143 , OverloadedStrings
@@ -235,36 +237,14 @@ instance ToParam UTCTime 'PGtimestamptz where
235237instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int
236238instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast
237239instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast
238−instance (HasOid pg, ToParam x pg)
239− => ToParam (Vector (Maybe x)) ('PGvararray ('Null pg)) where
240− toParam = K . Encoding.nullableArray_vector
241− (oid @pg) (unK . toParam @x @pg)
242−instance (HasOid pg, ToParam x pg)
243− => ToParam (Vector x) ('PGvararray ('NotNull pg)) where
244− toParam = K . Encoding.array_vector
245− (oid @pg) (unK . toParam @x @pg)
246−toVector :: (All ((~) x) xs) => NP I xs -> Vector x
247−toVector = \case
248− Nil -> Vector.empty
249− I x :* xs -> Vector.singleton x <> toVector xs
250−instance
251− ( HasOid pg
252− , ToParam x pg
253− , IsProductType hask xs
254− , All ((~) x) xs
255− , len ~ Length xs
256− ) => ToParam hask ('PGfixarray len ('NotNull pg)) where
257− toParam = K . Encoding.array_vector
258− (oid @pg) (unK . toParam @x @pg) . toVector . unZ . unSOP . from
259−instance
260− ( HasOid pg
261− , ToParam x pg
262− , IsProductType hask xs
263− , All ((~) (Maybe x)) xs
264− , len ~ Length xs
265− ) => ToParam hask ('PGfixarray len ('Null pg)) where
266− toParam = K . Encoding.nullableArray_vector
267− (oid @pg) (unK . toParam @x @pg) . toVector . unZ . unSOP . from
240+instance ToArray x ('PGvararray ty) => ToParam x ('PGvararray ty) where
241+ toParam
242+ = K . Encoding.array (baseOid @x @('PGvararray ty))
243+ . unK . toArray @x @('PGvararray ty)
244+instance ToArray x ('PGfixarray n ty) => ToParam x ('PGfixarray n ty) where
245+ toParam
246+ = K . Encoding.array (baseOid @x @('PGfixarray n ty))
247+ . unK . toArray @x @('PGfixarray n ty)
268248instance
269249 ( IsEnumType x
270250 , HasDatatypeInfo x
@@ -345,6 +325,59 @@ class ToField (x :: (Symbol, Type)) (field :: (Symbol, NullityType)) where
345325instance ToNullityParam x ty => ToField (alias ::: x) (alias ::: ty) where
346326 toField (P x) = K . unK $ toNullityParam @x @ty x
347327
328+class ToArray (x :: Type) (array :: PGType) where
329+ toArray :: x -> K Encoding.Array array
330+ default toArray :: ToParam x array => x -> K Encoding.Array array
331+ toArray = K . Encoding.encodingArray . unK . toParam @x @array
332+ baseOid :: Word32
333+ default baseOid :: HasOid array => Word32
334+ baseOid = oid @array
335+instance ToArray Bool 'PGbool
336+instance ToArray Int16 'PGint2
337+instance ToArray Word16 'PGint2
338+instance ToArray Int32 'PGint4
339+instance ToArray Word32 'PGint4
340+instance ToArray Int64 'PGint8
341+instance ToArray Word64 'PGint8
342+instance ToArray Float 'PGfloat4
343+instance ToArray Double 'PGfloat8
344+instance ToArray Scientific 'PGnumeric
345+instance ToArray UUID 'PGuuid
346+instance ToArray (NetAddr IP) 'PGinet
347+instance ToArray Char ('PGchar 1)
348+instance ToArray Strict.Text 'PGtext
349+instance ToArray Lazy.Text 'PGtext
350+instance ToArray Strict.ByteString 'PGbytea
351+instance ToArray Lazy.ByteString 'PGbytea
352+instance ToArray Day 'PGdate
353+instance ToArray TimeOfDay 'PGtime
354+instance ToArray (TimeOfDay, TimeZone) 'PGtimetz
355+instance ToArray LocalTime 'PGtimestamp
356+instance ToArray UTCTime 'PGtimestamptz
357+instance ToArray DiffTime 'PGinterval
358+instance ToArray Value 'PGjson
359+instance ToArray Value 'PGjsonb
360+instance ToArray x array
361+ => ToArray (Vector x) ('PGvararray ('NotNull array)) where
362+ toArray = K . Encoding.dimensionArray Vector.foldl'
363+ (unK . toArray @x @array)
364+ baseOid = baseOid @x @array
365+instance ToArray x array
366+ => ToArray (Vector (Maybe x)) ('PGvararray ('Null array)) where
367+ toArray = K . Encoding.dimensionArray Vector.foldl'
368+ (maybe Encoding.nullArray (unK . toArray @x @array))
369+ baseOid = baseOid @x @array
370+instance (HomogeneousProduct n x product, ToArray x array)
371+ => ToArray product ('PGfixarray n ('NotNull array)) where
372+ toArray = K . Encoding.dimensionArray foldlN
373+ (unK . toArray @x @array)
374+ baseOid = baseOid @x @array
375+instance (HomogeneousProduct n (Maybe x) product, ToArray x array)
376+ => ToArray product ('PGfixarray n ('Null array)) where
377+ toArray = K . Encoding.dimensionArray foldlN
378+ (maybe Encoding.nullArray (unK . toArray @x @array))
379+ baseOid = baseOid @x @array
380+
348381-- | A `ToParams` constraint generically sequences the encodings of `Type`s
349382-- of the fields of a tuple or record to a row of `ColumnType`s. You should
350383-- not define instances of `ToParams`. Instead define `Generic` instances
@@ -410,39 +443,6 @@ instance FromValue pg y
410443 fromValue = Decoding.array
411444 (Decoding.dimensionArray Vector.replicateM
412445 (Decoding.valueArray (fromValue @pg)))
413−fromVector
414− :: forall x xs. (All ((~) x) xs, SListI xs)
415− => Vector x
416− -> Decoding.Value (NP I xs)
417−fromVector vec = case fromList (Vector.toList vec) of
418− Nothing -> failure "fromVector: unexpected length"
419− Just xs -> return $ hcmap (Proxy :: Proxy ((~) x)) (I . unK) xs
420−instance
421− ( IsProductType hask ys
422− , All ((~) y) ys
423− , len ~ Length ys
424− , FromValue pg y
425− ) => FromValue ('PGfixarray len ('NotNull pg)) hask where
426− fromValue =
427− let
428− vectorValue = Decoding.array
429− (Decoding.dimensionArray Vector.replicateM
430− (Decoding.valueArray (fromValue @pg)))
431− in
432− fmap (to . SOP . Z) (fromVector @y =<< vectorValue)
433−instance
434− ( IsProductType hask ys
435− , All ((~) (Maybe y)) ys
436− , len ~ Length ys
437− , FromValue pg y
438− ) => FromValue ('PGfixarray len ('Null pg)) hask where
439− fromValue =
440− let
441− vectorValue = Decoding.array
442− (Decoding.dimensionArray Vector.replicateM
443− (Decoding.nullableValueArray (fromValue @pg)))
444− in
445− fmap (to . SOP . Z) (fromVector @(Maybe y) =<< vectorValue)
446446instance
447447 ( IsEnumType y
448448 , HasDatatypeInfo y
@@ -513,6 +513,105 @@ instance FromValue pg y
513513 K (Just bytestring) -> P . Just <$>
514514 Decoding.valueParser (fromValue @pg) bytestring
515515
516+class FromArray (ty :: NullityType) (y :: Type) where
517+ fromArray :: Decoding.Array y
518+instance FromArray ('NotNull 'PGbool) Bool where
519+ fromArray = Decoding.valueArray (fromValue @'PGbool)
520+instance FromArray ('Null 'PGbool) (Maybe Bool) where
521+ fromArray = Decoding.nullableValueArray (fromValue @'PGbool)
522+instance FromArray ('NotNull 'PGint2) Int16 where
523+ fromArray = Decoding.valueArray (fromValue @'PGint2)
524+instance FromArray ('Null 'PGint2) (Maybe Int16) where
525+ fromArray = Decoding.nullableValueArray (fromValue @'PGint2)
526+instance FromArray ('NotNull 'PGint4) Int32 where
527+ fromArray = Decoding.valueArray (fromValue @'PGint4)
528+instance FromArray ('Null 'PGint4) (Maybe Int32) where
529+ fromArray = Decoding.nullableValueArray (fromValue @'PGint4)
530+instance FromArray ('NotNull 'PGint8) Int64 where
531+ fromArray = Decoding.valueArray (fromValue @'PGint8)
532+instance FromArray ('Null 'PGint8) (Maybe Int64) where
533+ fromArray = Decoding.nullableValueArray (fromValue @'PGint8)
534+instance FromArray ('NotNull 'PGfloat4) Float where
535+ fromArray = Decoding.valueArray (fromValue @'PGfloat4)
536+instance FromArray ('Null 'PGfloat4) (Maybe Float) where
537+ fromArray = Decoding.nullableValueArray (fromValue @'PGfloat4)
538+instance FromArray ('NotNull 'PGfloat8) Double where
539+ fromArray = Decoding.valueArray (fromValue @'PGfloat8)
540+instance FromArray ('Null 'PGfloat8) (Maybe Double) where
541+ fromArray = Decoding.nullableValueArray (fromValue @'PGfloat8)
542+instance FromArray ('NotNull 'PGnumeric) Scientific where
543+ fromArray = Decoding.valueArray (fromValue @'PGnumeric)
544+instance FromArray ('Null 'PGnumeric) (Maybe Scientific) where
545+ fromArray = Decoding.nullableValueArray (fromValue @'PGnumeric)
546+instance FromArray ('NotNull 'PGuuid) UUID where
547+ fromArray = Decoding.valueArray (fromValue @'PGuuid)
548+instance FromArray ('Null 'PGuuid) (Maybe UUID) where
549+ fromArray = Decoding.nullableValueArray (fromValue @'PGuuid)
550+instance FromArray ('NotNull 'PGinet) (NetAddr IP) where
551+ fromArray = Decoding.valueArray (fromValue @'PGinet)
552+instance FromArray ('Null 'PGinet) (Maybe (NetAddr IP)) where
553+ fromArray = Decoding.nullableValueArray (fromValue @'PGinet)
554+instance FromArray ('NotNull ('PGchar 1)) Char where
555+ fromArray = Decoding.valueArray (fromValue @('PGchar 1))
556+instance FromArray ('Null ('PGchar 1)) (Maybe Char) where
557+ fromArray = Decoding.nullableValueArray (fromValue @('PGchar 1))
558+instance FromArray ('NotNull 'PGtext) Strict.Text where
559+ fromArray = Decoding.valueArray (fromValue @'PGtext)
560+instance FromArray ('Null 'PGtext) (Maybe Strict.Text) where
561+ fromArray = Decoding.nullableValueArray (fromValue @'PGtext)
562+instance FromArray ('NotNull 'PGtext) Lazy.Text where
563+ fromArray = Decoding.valueArray (fromValue @'PGtext)
564+instance FromArray ('Null 'PGtext) (Maybe Lazy.Text) where
565+ fromArray = Decoding.nullableValueArray (fromValue @'PGtext)
566+instance FromArray ('NotNull 'PGbytea) Strict.ByteString where
567+ fromArray = Decoding.valueArray (fromValue @'PGbytea)
568+instance FromArray ('Null 'PGbytea) (Maybe Strict.ByteString) where
569+ fromArray = Decoding.nullableValueArray (fromValue @'PGbytea)
570+instance FromArray ('NotNull 'PGbytea) Lazy.ByteString where
571+ fromArray = Decoding.valueArray (fromValue @'PGbytea)
572+instance FromArray ('Null 'PGbytea) (Maybe Lazy.ByteString) where
573+ fromArray = Decoding.nullableValueArray (fromValue @'PGbytea)
574+instance FromArray ('NotNull 'PGdate) Day where
575+ fromArray = Decoding.valueArray (fromValue @'PGdate)
576+instance FromArray ('Null 'PGdate) (Maybe Day) where
577+ fromArray = Decoding.nullableValueArray (fromValue @'PGdate)
578+instance FromArray ('NotNull 'PGtime) TimeOfDay where
579+ fromArray = Decoding.valueArray (fromValue @'PGtime)
580+instance FromArray ('Null 'PGtime) (Maybe TimeOfDay) where
581+ fromArray = Decoding.nullableValueArray (fromValue @'PGtime)
582+instance FromArray ('NotNull 'PGtimetz) (TimeOfDay, TimeZone) where
583+ fromArray = Decoding.valueArray (fromValue @'PGtimetz)
584+instance FromArray ('Null 'PGtimetz) (Maybe (TimeOfDay, TimeZone)) where
585+ fromArray = Decoding.nullableValueArray (fromValue @'PGtimetz)
586+instance FromArray ('NotNull 'PGtimestamp) LocalTime where
587+ fromArray = Decoding.valueArray (fromValue @'PGtimestamp)
588+instance FromArray ('Null 'PGtimestamp) (Maybe LocalTime) where
589+ fromArray = Decoding.nullableValueArray (fromValue @'PGtimestamp)
590+instance FromArray ('NotNull 'PGtimestamptz) UTCTime where
591+ fromArray = Decoding.valueArray (fromValue @'PGtimestamptz)
592+instance FromArray ('Null 'PGtimestamptz) (Maybe UTCTime) where
593+ fromArray = Decoding.nullableValueArray (fromValue @'PGtimestamptz)
594+instance FromArray ('NotNull 'PGinterval) DiffTime where
595+ fromArray = Decoding.valueArray (fromValue @'PGinterval)
596+instance FromArray ('Null 'PGinterval) (Maybe DiffTime) where
597+ fromArray = Decoding.nullableValueArray (fromValue @'PGinterval)
598+instance FromArray ('NotNull 'PGjson) Value where
599+ fromArray = Decoding.valueArray (fromValue @'PGjson)
600+instance FromArray ('Null 'PGjson) (Maybe Value) where
601+ fromArray = Decoding.nullableValueArray (fromValue @'PGjson)
602+instance FromArray ('NotNull 'PGjsonb) Value where
603+ fromArray = Decoding.valueArray (fromValue @'PGjsonb)
604+instance FromArray ('Null 'PGjsonb) (Maybe Value) where
605+ fromArray = Decoding.nullableValueArray (fromValue @'PGjsonb)
606+instance FromArray array y
607+ => FromArray (nullity ('PGvararray array)) (Vector y) where
608+ fromArray =
609+ Decoding.dimensionArray Vector.replicateM (fromArray @array @y)
610+instance (FromArray array y, HomogeneousProduct n y product)
611+ => FromArray (nullity ('PGfixarray n array)) product where
612+ fromArray =
613+ Decoding.dimensionArray (pure replicateMN) (fromArray @array @y)
614+
516615-- | A `FromRow` constraint generically sequences the parsings of the columns
517616-- of a `RowType` into the fields of a record `Type` provided they have
518617-- the same field names. You should not define instances of `FromRow`.
@@ -553,3 +652,34 @@ newtype Only x = Only { fromOnly :: x }
553652 deriving (Functor,Foldable,Traversable,Eq,Ord,Read,Show,GHC.Generic)
554653instance Generic (Only x)
555654instance HasDatatypeInfo (Only x)
655+
656+class HomogeneousProduct
657+ (n :: Nat) (x :: Type) (product :: Type)
658+ | product -> n where
659+ foldlN :: (b -> x -> b) -> b -> product -> b
660+ replicateMN :: Monad m => m x -> m product
661+instance
662+ ( IsProductType product xs
663+ , All ((~) x) xs
664+ , SListI xs
665+ , Length xs ~ n )
666+ => HomogeneousProduct n x product where
667+
668+ foldlN f z =
669+ let
670+ foldlNP
671+ :: All ((~) x') xs'
672+ => (z -> x' -> z) -> z -> NP I xs' -> z
673+ foldlNP f' z' = \case
674+ Nil -> z'
675+ I x' :* xs' -> let z'' = f' z' x' in seq z'' $ foldlNP f' z'' xs'
676+ in
677+ foldlNP f z . unZ . unSOP . from
678+
679+ replicateMN mx =
680+ let
681+ replicateMNP :: Monad m => m x -> m (NP I xs)
682+ replicateMNP mx' = hsequence' $
683+ hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx'))
684+ in
685+ to . SOP . Z <$> replicateMNP mx