@@ -276,14 +276,16 @@ instance ToParam UTCTime 'PGtimestamptz where
276276instance ToParam DiffTime 'PGinterval where toParam = K . Encoding.interval_int
277277instance ToParam Value 'PGjson where toParam = K . Encoding.json_ast
278278instance ToParam Value 'PGjsonb where toParam = K . Encoding.jsonb_ast
279−-- instance ToArray x ('PGvararray ty) => ToParam x ('PGvararray ty) where
280−-- toParam
281−-- = K . Encoding.array (baseOid @x @('PGvararray ty))
282−-- . unK . toArray @x @('PGvararray ty)
283−-- instance ToArray x ('PGfixarray n ty) => ToParam x ('PGfixarray n ty) where
284−-- toParam
285−-- = K . Encoding.array (baseOid @x @('PGfixarray n ty))
286−-- . unK . toArray @x @('PGfixarray n ty)
279+instance ToArray x ('NotNull ('PGvararray ty))
280+ => ToParam x ('PGvararray ty) where
281+ toParam
282+ = K . Encoding.array (baseOid @x @('NotNull ('PGvararray ty)))
283+ . unK . toArray @x @('NotNull ('PGvararray ty))
284+instance ToArray x ('NotNull ('PGfixarray n ty))
285+ => ToParam x ('PGfixarray n ty) where
286+ toParam
287+ = K . Encoding.array (baseOid @x @('NotNull ('PGfixarray n ty)))
288+ . unK . toArray @x @('NotNull ('PGfixarray n ty))
287289instance
288290 ( IsEnumType x
289291 , HasDatatypeInfo x
@@ -382,36 +384,112 @@ instance ToArray Bool ('NotNull 'PGbool) where
382384 toArray = toArrayLeaf @Bool @'PGbool
383385instance ToArray (Maybe Bool) ('Null 'PGbool) where
384386 toArray = toNullableArrayLeaf @Bool @'PGbool
385−-- instance ToArray Int16 'PGint2
386−-- instance ToArray Word16 'PGint2
387−-- instance ToArray Int32 'PGint4
388−-- instance ToArray Word32 'PGint4
389−-- instance ToArray Int64 'PGint8
390−-- instance ToArray Word64 'PGint8
391−-- instance ToArray Float 'PGfloat4
392−-- instance ToArray Double 'PGfloat8
393−-- instance ToArray Scientific 'PGnumeric
394−-- instance ToArray UUID 'PGuuid
395−-- instance ToArray (NetAddr IP) 'PGinet
396−-- instance ToArray Char ('PGchar 1)
397−-- instance ToArray Strict.Text 'PGtext
398−-- instance ToArray Lazy.Text 'PGtext
399−-- instance ToArray Strict.ByteString 'PGbytea
400−-- instance ToArray Lazy.ByteString 'PGbytea
401−-- instance ToArray Day 'PGdate
402−-- instance ToArray TimeOfDay 'PGtime
403−-- instance ToArray (TimeOfDay, TimeZone) 'PGtimetz
404−-- instance ToArray LocalTime 'PGtimestamp
405−-- instance ToArray UTCTime 'PGtimestamptz
406−-- instance ToArray DiffTime 'PGinterval
407−-- instance ToArray Value 'PGjson
408−-- instance ToArray Value 'PGjsonb
387+instance ToArray Int16 ('NotNull 'PGint2) where
388+ toArray = toArrayLeaf @Int16 @'PGint2
389+instance ToArray (Maybe Int16) ('Null 'PGint2) where
390+ toArray = toNullableArrayLeaf @Int16 @'PGint2
391+instance ToArray Word16 ('NotNull 'PGint2) where
392+ toArray = toArrayLeaf @Word16 @'PGint2
393+instance ToArray (Maybe Word16) ('Null 'PGint2) where
394+ toArray = toNullableArrayLeaf @Word16 @'PGint2
395+instance ToArray Int32 ('NotNull 'PGint4) where
396+ toArray = toArrayLeaf @Int32 @'PGint4
397+instance ToArray (Maybe Int32) ('Null 'PGint4) where
398+ toArray = toNullableArrayLeaf @Int32 @'PGint4
399+instance ToArray Word32 ('NotNull 'PGint4) where
400+ toArray = toArrayLeaf @Word32 @'PGint4
401+instance ToArray (Maybe Word32) ('Null 'PGint4) where
402+ toArray = toNullableArrayLeaf @Word32 @'PGint4
403+instance ToArray Int64 ('NotNull 'PGint8) where
404+ toArray = toArrayLeaf @Int64 @'PGint8
405+instance ToArray (Maybe Int64) ('Null 'PGint8) where
406+ toArray = toNullableArrayLeaf @Int64 @'PGint8
407+instance ToArray Word64 ('NotNull 'PGint8) where
408+ toArray = toArrayLeaf @Word64 @'PGint8
409+instance ToArray (Maybe Word64) ('Null 'PGint8) where
410+ toArray = toNullableArrayLeaf @Word64 @'PGint8
411+instance ToArray Float ('NotNull 'PGfloat4) where
412+ toArray = toArrayLeaf @Float @'PGfloat4
413+instance ToArray (Maybe Float) ('Null 'PGfloat4) where
414+ toArray = toNullableArrayLeaf @Float @'PGfloat4
415+instance ToArray Double ('NotNull 'PGfloat8) where
416+ toArray = toArrayLeaf @Double @'PGfloat8
417+instance ToArray (Maybe Double) ('Null 'PGfloat8) where
418+ toArray = toNullableArrayLeaf @Double @'PGfloat8
419+instance ToArray Scientific ('NotNull 'PGnumeric) where
420+ toArray = toArrayLeaf @Scientific @'PGnumeric
421+instance ToArray (Maybe Scientific) ('Null 'PGnumeric) where
422+ toArray = toNullableArrayLeaf @Scientific @'PGnumeric
423+instance ToArray UUID ('NotNull 'PGuuid) where
424+ toArray = toArrayLeaf @UUID @'PGuuid
425+instance ToArray (Maybe UUID) ('Null 'PGuuid) where
426+ toArray = toNullableArrayLeaf @UUID @'PGuuid
427+instance ToArray (NetAddr IP) ('NotNull 'PGinet) where
428+ toArray = toArrayLeaf @(NetAddr IP) @'PGinet
429+instance ToArray (Maybe (NetAddr IP)) ('Null 'PGinet) where
430+ toArray = toNullableArrayLeaf @(NetAddr IP) @'PGinet
431+instance ToArray Char ('NotNull ('PGchar 1)) where
432+ toArray = toArrayLeaf @Char @('PGchar 1)
433+instance ToArray (Maybe Char) ('Null ('PGchar 1)) where
434+ toArray = toNullableArrayLeaf @Char @('PGchar 1)
435+instance ToArray Strict.Text ('NotNull 'PGtext) where
436+ toArray = toArrayLeaf @Strict.Text @'PGtext
437+instance ToArray (Maybe Strict.Text) ('Null 'PGtext) where
438+ toArray = toNullableArrayLeaf @Strict.Text @'PGtext
439+instance ToArray Lazy.Text ('NotNull 'PGtext) where
440+ toArray = toArrayLeaf @Lazy.Text @'PGtext
441+instance ToArray (Maybe Lazy.Text) ('Null 'PGtext) where
442+ toArray = toNullableArrayLeaf @Lazy.Text @'PGtext
443+instance ToArray Strict.ByteString ('NotNull 'PGbytea) where
444+ toArray = toArrayLeaf @Strict.ByteString @'PGbytea
445+instance ToArray (Maybe Strict.ByteString) ('Null 'PGbytea) where
446+ toArray = toNullableArrayLeaf @Strict.ByteString @'PGbytea
447+instance ToArray Lazy.ByteString ('NotNull 'PGbytea) where
448+ toArray = toArrayLeaf @Lazy.ByteString @'PGbytea
449+instance ToArray (Maybe Lazy.ByteString) ('Null 'PGbytea) where
450+ toArray = toNullableArrayLeaf @Lazy.ByteString @'PGbytea
451+instance ToArray Day ('NotNull 'PGdate) where
452+ toArray = toArrayLeaf @Day @'PGdate
453+instance ToArray (Maybe Day) ('Null 'PGdate) where
454+ toArray = toNullableArrayLeaf @Day @'PGdate
455+instance ToArray TimeOfDay ('NotNull 'PGtime) where
456+ toArray = toArrayLeaf @TimeOfDay @'PGtime
457+instance ToArray (Maybe TimeOfDay) ('Null 'PGtime) where
458+ toArray = toNullableArrayLeaf @TimeOfDay @'PGtime
459+instance ToArray (TimeOfDay, TimeZone) ('NotNull 'PGtimetz) where
460+ toArray = toArrayLeaf @(TimeOfDay, TimeZone) @'PGtimetz
461+instance ToArray (Maybe (TimeOfDay, TimeZone)) ('Null 'PGtimetz) where
462+ toArray = toNullableArrayLeaf @(TimeOfDay, TimeZone) @'PGtimetz
463+instance ToArray LocalTime ('NotNull 'PGtimestamp) where
464+ toArray = toArrayLeaf @LocalTime @'PGtimestamp
465+instance ToArray (Maybe LocalTime) ('Null 'PGtimestamp) where
466+ toArray = toNullableArrayLeaf @LocalTime @'PGtimestamp
467+instance ToArray UTCTime ('NotNull 'PGtimestamptz) where
468+ toArray = toArrayLeaf @UTCTime @'PGtimestamptz
469+instance ToArray (Maybe UTCTime) ('Null 'PGtimestamptz) where
470+ toArray = toNullableArrayLeaf @UTCTime @'PGtimestamptz
471+instance ToArray DiffTime ('NotNull 'PGinterval) where
472+ toArray = toArrayLeaf @DiffTime @'PGinterval
473+instance ToArray (Maybe DiffTime) ('Null 'PGinterval) where
474+ toArray = toNullableArrayLeaf @DiffTime @'PGinterval
475+instance ToArray Value ('NotNull 'PGjson) where
476+ toArray = toArrayLeaf @Value @'PGjson
477+instance ToArray (Maybe Value) ('Null 'PGjson) where
478+ toArray = toNullableArrayLeaf @Value @'PGjson
479+instance ToArray Value ('NotNull 'PGjsonb) where
480+ toArray = toArrayLeaf @Value @'PGjsonb
481+instance ToArray (Maybe Value) ('Null 'PGjsonb) where
482+ toArray = toNullableArrayLeaf @Value @'PGjsonb
409483instance ToArray x array
410484 => ToArray (Vector x) ('NotNull ('PGvararray array)) where
411485 toArray = K . Encoding.dimensionArray Vector.foldl'
412486 (unK . toArray @x @array)
413487 baseOid = baseOid @x @array
414−instance (IsProductType product xs, HomogeneousList n x xs, ToArray x array)
488+instance
489+ ( IsProductType product xs
490+ , Length xs ~ n
491+ , All ((~) x) xs
492+ , ToArray x array )
415493 => ToArray product ('NotNull ('PGfixarray n array)) where
416494 toArray = K . Encoding.dimensionArray foldlN
417495 (unK . toArray @x @array) . unZ . unSOP . from
@@ -550,102 +628,114 @@ instance FromValue pg y
550628
551629class FromArray (ty :: NullityType) (y :: Type) where
552630 fromArray :: Decoding.Array y
631+fromArrayLeaf :: forall pg y. FromValue pg y => Decoding.Array y
632+fromArrayLeaf = Decoding.valueArray (fromValue @pg @y)
633+fromNullableArrayLeaf
634+ :: forall pg y. FromValue pg y => Decoding.Array (Maybe y)
635+fromNullableArrayLeaf = Decoding.nullableValueArray (fromValue @pg @y)
553636instance FromArray ('NotNull 'PGbool) Bool where
554− fromArray = Decoding.valueArray (fromValue @'PGbool)
637+ fromArray = fromArrayLeaf @'PGbool @Bool
555638instance FromArray ('Null 'PGbool) (Maybe Bool) where
556− fromArray = Decoding.nullableValueArray (fromValue @'PGbool)
639+ fromArray = fromNullableArrayLeaf @'PGbool @Bool
557640instance FromArray ('NotNull 'PGint2) Int16 where
558− fromArray = Decoding.valueArray (fromValue @'PGint2)
641+ fromArray = fromArrayLeaf @'PGint2 @Int16
559642instance FromArray ('Null 'PGint2) (Maybe Int16) where
560− fromArray = Decoding.nullableValueArray (fromValue @'PGint2)
643+ fromArray = fromNullableArrayLeaf @'PGint2 @Int16
561644instance FromArray ('NotNull 'PGint4) Int32 where
562− fromArray = Decoding.valueArray (fromValue @'PGint4)
645+ fromArray = fromArrayLeaf @'PGint4 @Int32
563646instance FromArray ('Null 'PGint4) (Maybe Int32) where
564− fromArray = Decoding.nullableValueArray (fromValue @'PGint4)
647+ fromArray = fromNullableArrayLeaf @'PGint4 @Int32
565648instance FromArray ('NotNull 'PGint8) Int64 where
566− fromArray = Decoding.valueArray (fromValue @'PGint8)
649+ fromArray = fromArrayLeaf @'PGint8 @Int64
567650instance FromArray ('Null 'PGint8) (Maybe Int64) where
568− fromArray = Decoding.nullableValueArray (fromValue @'PGint8)
651+ fromArray = fromNullableArrayLeaf @'PGint8 @Int64
569652instance FromArray ('NotNull 'PGfloat4) Float where
570− fromArray = Decoding.valueArray (fromValue @'PGfloat4)
653+ fromArray = fromArrayLeaf @'PGfloat4 @Float
571654instance FromArray ('Null 'PGfloat4) (Maybe Float) where
572− fromArray = Decoding.nullableValueArray (fromValue @'PGfloat4)
655+ fromArray = fromNullableArrayLeaf @'PGfloat4 @Float
573656instance FromArray ('NotNull 'PGfloat8) Double where
574− fromArray = Decoding.valueArray (fromValue @'PGfloat8)
657+ fromArray = fromArrayLeaf @'PGfloat8 @Double
575658instance FromArray ('Null 'PGfloat8) (Maybe Double) where
576− fromArray = Decoding.nullableValueArray (fromValue @'PGfloat8)
659+ fromArray = fromNullableArrayLeaf @'PGfloat8 @Double
577660instance FromArray ('NotNull 'PGnumeric) Scientific where
578− fromArray = Decoding.valueArray (fromValue @'PGnumeric)
661+ fromArray = fromArrayLeaf @'PGnumeric @Scientific
579662instance FromArray ('Null 'PGnumeric) (Maybe Scientific) where
580− fromArray = Decoding.nullableValueArray (fromValue @'PGnumeric)
663+ fromArray = fromNullableArrayLeaf @'PGnumeric @Scientific
581664instance FromArray ('NotNull 'PGuuid) UUID where
582− fromArray = Decoding.valueArray (fromValue @'PGuuid)
665+ fromArray = fromArrayLeaf @'PGuuid @UUID
583666instance FromArray ('Null 'PGuuid) (Maybe UUID) where
584− fromArray = Decoding.nullableValueArray (fromValue @'PGuuid)
667+ fromArray = fromNullableArrayLeaf @'PGuuid @UUID
585668instance FromArray ('NotNull 'PGinet) (NetAddr IP) where
586− fromArray = Decoding.valueArray (fromValue @'PGinet)
669+ fromArray = fromArrayLeaf @'PGinet @(NetAddr IP)
587670instance FromArray ('Null 'PGinet) (Maybe (NetAddr IP)) where
588− fromArray = Decoding.nullableValueArray (fromValue @'PGinet)
671+ fromArray = fromNullableArrayLeaf @'PGinet @(NetAddr IP)
589672instance FromArray ('NotNull ('PGchar 1)) Char where
590− fromArray = Decoding.valueArray (fromValue @('PGchar 1))
673+ fromArray = fromArrayLeaf @('PGchar 1) @Char
591674instance FromArray ('Null ('PGchar 1)) (Maybe Char) where
592− fromArray = Decoding.nullableValueArray (fromValue @('PGchar 1))
675+ fromArray = fromNullableArrayLeaf @('PGchar 1) @Char
593676instance FromArray ('NotNull 'PGtext) Strict.Text where
594− fromArray = Decoding.valueArray (fromValue @'PGtext)
677+ fromArray = fromArrayLeaf @'PGtext @Strict.Text
595678instance FromArray ('Null 'PGtext) (Maybe Strict.Text) where
596− fromArray = Decoding.nullableValueArray (fromValue @'PGtext)
679+ fromArray = fromNullableArrayLeaf @'PGtext @Strict.Text
597680instance FromArray ('NotNull 'PGtext) Lazy.Text where
598− fromArray = Decoding.valueArray (fromValue @'PGtext)
681+ fromArray = fromArrayLeaf @'PGtext @Lazy.Text
599682instance FromArray ('Null 'PGtext) (Maybe Lazy.Text) where
600− fromArray = Decoding.nullableValueArray (fromValue @'PGtext)
683+ fromArray = fromNullableArrayLeaf @'PGtext @Lazy.Text
601684instance FromArray ('NotNull 'PGbytea) Strict.ByteString where
602− fromArray = Decoding.valueArray (fromValue @'PGbytea)
685+ fromArray = fromArrayLeaf @'PGbytea @Strict.ByteString
603686instance FromArray ('Null 'PGbytea) (Maybe Strict.ByteString) where
604− fromArray = Decoding.nullableValueArray (fromValue @'PGbytea)
687+ fromArray = fromNullableArrayLeaf @'PGbytea @Strict.ByteString
605688instance FromArray ('NotNull 'PGbytea) Lazy.ByteString where
606− fromArray = Decoding.valueArray (fromValue @'PGbytea)
689+ fromArray = fromArrayLeaf @'PGbytea @Lazy.ByteString
607690instance FromArray ('Null 'PGbytea) (Maybe Lazy.ByteString) where
608− fromArray = Decoding.nullableValueArray (fromValue @'PGbytea)
691+ fromArray = fromNullableArrayLeaf @'PGbytea @Lazy.ByteString
609692instance FromArray ('NotNull 'PGdate) Day where
610− fromArray = Decoding.valueArray (fromValue @'PGdate)
693+ fromArray = fromArrayLeaf @'PGdate @Day
611694instance FromArray ('Null 'PGdate) (Maybe Day) where
612− fromArray = Decoding.nullableValueArray (fromValue @'PGdate)
695+ fromArray = fromNullableArrayLeaf @'PGdate @Day
613696instance FromArray ('NotNull 'PGtime) TimeOfDay where
614− fromArray = Decoding.valueArray (fromValue @'PGtime)
697+ fromArray = fromArrayLeaf @'PGtime @TimeOfDay
615698instance FromArray ('Null 'PGtime) (Maybe TimeOfDay) where
616− fromArray = Decoding.nullableValueArray (fromValue @'PGtime)
699+ fromArray = fromNullableArrayLeaf @'PGtime @TimeOfDay
617700instance FromArray ('NotNull 'PGtimetz) (TimeOfDay, TimeZone) where
618− fromArray = Decoding.valueArray (fromValue @'PGtimetz)
701+ fromArray = fromArrayLeaf @'PGtimetz @(TimeOfDay, TimeZone)
619702instance FromArray ('Null 'PGtimetz) (Maybe (TimeOfDay, TimeZone)) where
620− fromArray = Decoding.nullableValueArray (fromValue @'PGtimetz)
703+ fromArray = fromNullableArrayLeaf @'PGtimetz @(TimeOfDay, TimeZone)
621704instance FromArray ('NotNull 'PGtimestamp) LocalTime where
622− fromArray = Decoding.valueArray (fromValue @'PGtimestamp)
705+ fromArray = fromArrayLeaf @'PGtimestamp @LocalTime
623706instance FromArray ('Null 'PGtimestamp) (Maybe LocalTime) where
624− fromArray = Decoding.nullableValueArray (fromValue @'PGtimestamp)
707+ fromArray = fromNullableArrayLeaf @'PGtimestamp @LocalTime
625708instance FromArray ('NotNull 'PGtimestamptz) UTCTime where
626− fromArray = Decoding.valueArray (fromValue @'PGtimestamptz)
709+ fromArray = fromArrayLeaf @'PGtimestamptz @UTCTime
627710instance FromArray ('Null 'PGtimestamptz) (Maybe UTCTime) where
628− fromArray = Decoding.nullableValueArray (fromValue @'PGtimestamptz)
711+ fromArray = fromNullableArrayLeaf @'PGtimestamptz @UTCTime
629712instance FromArray ('NotNull 'PGinterval) DiffTime where
630− fromArray = Decoding.valueArray (fromValue @'PGinterval)
713+ fromArray = fromArrayLeaf @'PGinterval @DiffTime
631714instance FromArray ('Null 'PGinterval) (Maybe DiffTime) where
632− fromArray = Decoding.nullableValueArray (fromValue @'PGinterval)
715+ fromArray = fromNullableArrayLeaf @'PGinterval @DiffTime
633716instance FromArray ('NotNull 'PGjson) Value where
634− fromArray = Decoding.valueArray (fromValue @'PGjson)
717+ fromArray = fromArrayLeaf @'PGjson @Value
635718instance FromArray ('Null 'PGjson) (Maybe Value) where
636− fromArray = Decoding.nullableValueArray (fromValue @'PGjson)
719+ fromArray = fromNullableArrayLeaf @'PGjson @Value
637720instance FromArray ('NotNull 'PGjsonb) Value where
638− fromArray = Decoding.valueArray (fromValue @'PGjsonb)
721+ fromArray = fromArrayLeaf @'PGjsonb @Value
639722instance FromArray ('Null 'PGjsonb) (Maybe Value) where
640− fromArray = Decoding.nullableValueArray (fromValue @'PGjsonb)
723+ fromArray = fromNullableArrayLeaf @'PGjsonb @Value
641724instance FromArray array y
642725 => FromArray (nullity ('PGvararray array)) (Vector y) where
643726 fromArray =
644727 Decoding.dimensionArray Vector.replicateM (fromArray @array @y)
645−instance (FromArray array y, HomogeneousList n y ys, IsProductType product ys)
728+instance
729+ ( FromArray array y
730+ , All ((~) y) ys
731+ , SListI ys
732+ , IsProductType product ys )
646733 => FromArray (nullity ('PGfixarray n array)) product where
647734 fromArray =
648− Decoding.dimensionArray (pure replicateMN) (fromArray @array @y)
735+ let
736+ rep _ = fmap (to . SOP . Z) . replicateMN
737+ in
738+ Decoding.dimensionArray rep (fromArray @array @y)
649739
650740-- | A `FromRow` constraint generically sequences the parsings of the columns
651741-- of a `RowType` into the fields of a record `Type` provided they have
@@ -688,27 +778,15 @@ newtype Only x = Only { fromOnly :: x }
688778instance Generic (Only x)
689779instance HasDatatypeInfo (Only x)
690780
691−class HomogeneousList
692− (n :: Nat) (x :: Type) (list :: [Type])
693− | list -> n, n x -> list where
694− foldlN :: (b -> x -> b) -> b -> NP I xs -> b
695− replicateMN :: Monad m => m x -> m (NP I xs)
696−instance HomogeneousList 0 x '[] where
697− foldlN _ z _ = z
698− replicateMN _ = return Nil
699−instance (1 <= n, HomogeneousList (n-1) x xs) => HomogeneousList n x (x ': xs) where
700− foldlN f z (I x :* xs) = let z' = f z x in seq z' $ foldlN f z' xs
701− replicateMN mx = do
702− x <- mx
703− xs <- replicateMN mx
704− return (I x :* xs)
705−-- instance
706−-- ( All ((~) x) xs
707−-- , SListI xs
708−-- , Length xs ~ n )
709−-- => HomogeneousList n x xs where
710−-- foldlN f z = \case
711−-- Nil -> z
712−-- I x :* xs -> let z' = f z x in seq z' $ foldlN f z' xs
713−-- replicateMN mx = hsequence' $
714−-- hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))
781+foldlN
782+ :: All ((~) x) xs
783+ => (z -> x -> z) -> z -> NP I xs -> z
784+foldlN f z = \case
785+ Nil -> z
786+ I x :* xs -> let z' = f z x in seq z' $ foldlN f z' xs
787+
788+replicateMN
789+ :: forall x xs m. (All ((~) x) xs, Monad m, SListI xs)
790+ => m x -> m (NP I xs)
791+replicateMN mx = hsequence' $
792+ hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx))