@@ -276,14 +276,14 @@ 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 ('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)
287287instance
288288 ( IsEnumType x
289289 , HasDatatypeInfo x
@@ -364,57 +364,57 @@ class ToField (x :: (Symbol, Type)) (field :: (Symbol, NullityType)) where
364364instance ToNullityParam x ty => ToField (alias ::: x) (alias ::: ty) where
365365 toField (P x) = K . unK $ toNullityParam @x @ty x
366366
367−class ToArray (x :: Type) (array :: PGType) where
367+class ToArray (x :: Type) (array :: NullityType) where
368368 toArray :: x -> K Encoding.Array array
369− default toArray :: ToParam x array => x -> K Encoding.Array array
370− toArray = K . Encoding.encodingArray . unK . toParam @x @array
371369 baseOid :: Word32
372− default baseOid :: HasOid array => Word32
373− baseOid = oid @array
374−instance ToArray Bool 'PGbool
375−instance ToArray Int16 'PGint2
376−instance ToArray Word16 'PGint2
377−instance ToArray Int32 'PGint4
378−instance ToArray Word32 'PGint4
379−instance ToArray Int64 'PGint8
380−instance ToArray Word64 'PGint8
381−instance ToArray Float 'PGfloat4
382−instance ToArray Double 'PGfloat8
383−instance ToArray Scientific 'PGnumeric
384−instance ToArray UUID 'PGuuid
385−instance ToArray (NetAddr IP) 'PGinet
386−instance ToArray Char ('PGchar 1)
387−instance ToArray Strict.Text 'PGtext
388−instance ToArray Lazy.Text 'PGtext
389−instance ToArray Strict.ByteString 'PGbytea
390−instance ToArray Lazy.ByteString 'PGbytea
391−instance ToArray Day 'PGdate
392−instance ToArray TimeOfDay 'PGtime
393−instance ToArray (TimeOfDay, TimeZone) 'PGtimetz
394−instance ToArray LocalTime 'PGtimestamp
395−instance ToArray UTCTime 'PGtimestamptz
396−instance ToArray DiffTime 'PGinterval
397−instance ToArray Value 'PGjson
398−instance ToArray Value 'PGjsonb
370+ default baseOid :: HasOid (PGTypeOf array) => Word32
371+ baseOid = oid @(PGTypeOf array)
372+toArrayLeaf
373+ :: forall x pg. ToParam x pg
374+ => x -> K Encoding.Array ('NotNull pg)
375+toArrayLeaf = K . Encoding.encodingArray . unK . toParam @x @pg
376+toNullableArrayLeaf
377+ :: forall x pg. ToParam x pg
378+ => Maybe x -> K Encoding.Array ('Null pg)
379+toNullableArrayLeaf = K . maybe Encoding.nullArray
380+ (Encoding.encodingArray . unK . toParam @x @pg)
381+instance ToArray Bool ('NotNull 'PGbool) where
382+ toArray = toArrayLeaf @Bool @'PGbool
383+instance ToArray (Maybe Bool) ('Null 'PGbool) where
384+ 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
399409instance ToArray x array
400− => ToArray (Vector x) ('PGvararray ('NotNull array)) where
410+ => ToArray (Vector x) ('NotNull ('PGvararray array)) where
401411 toArray = K . Encoding.dimensionArray Vector.foldl'
402412 (unK . toArray @x @array)
403413 baseOid = baseOid @x @array
404−instance ToArray x array
405− => ToArray (Vector (Maybe x)) ('PGvararray ('Null array)) where
406− toArray = K . Encoding.dimensionArray Vector.foldl'
407− (maybe Encoding.nullArray (unK . toArray @x @array))
408− baseOid = baseOid @x @array
409−instance (HomogeneousProduct n x product, ToArray x array)
410− => ToArray product ('PGfixarray n ('NotNull array)) where
414+instance (IsProductType product xs, HomogeneousList n x xs, ToArray x array)
415+ => ToArray product ('NotNull ('PGfixarray n array)) where
411416 toArray = K . Encoding.dimensionArray foldlN
412− (unK . toArray @x @array)
413− baseOid = baseOid @x @array
414−instance (HomogeneousProduct n (Maybe x) product, ToArray x array)
415− => ToArray product ('PGfixarray n ('Null array)) where
416− toArray = K . Encoding.dimensionArray foldlN
417− (maybe Encoding.nullArray (unK . toArray @x @array))
417+ (unK . toArray @x @array) . unZ . unSOP . from
418418 baseOid = baseOid @x @array
419419
420420-- | A `ToParams` constraint generically sequences the encodings of `Type`s
@@ -642,7 +642,7 @@ instance FromArray array y
642642 => FromArray (nullity ('PGvararray array)) (Vector y) where
643643 fromArray =
644644 Decoding.dimensionArray Vector.replicateM (fromArray @array @y)
645−instance (FromArray array y, HomogeneousProduct n y product)
645+instance (FromArray array y, HomogeneousList n y ys, IsProductType product ys)
646646 => FromArray (nullity ('PGfixarray n array)) product where
647647 fromArray =
648648 Decoding.dimensionArray (pure replicateMN) (fromArray @array @y)
@@ -688,33 +688,27 @@ newtype Only x = Only { fromOnly :: x }
688688instance Generic (Only x)
689689instance HasDatatypeInfo (Only x)
690690
691−class HomogeneousProduct
692− (n :: Nat) (x :: Type) (product :: Type)
693− | product -> n where
694− foldlN :: (b -> x -> b) -> b -> product -> b
695− replicateMN :: Monad m => m x -> m product
696−instance
697− ( IsProductType product xs
698− , All ((~) x) xs
699− , SListI xs
700− , Length xs ~ n )
701− => HomogeneousProduct n x product where
702−
703− foldlN f z =
704− let
705− foldlNP
706− :: All ((~) x') xs'
707− => (z -> x' -> z) -> z -> NP I xs' -> z
708− foldlNP f' z' = \case
709− Nil -> z'
710− I x' :* xs' -> let z'' = f' z' x' in seq z'' $ foldlNP f' z'' xs'
711− in
712− foldlNP f z . unZ . unSOP . from
713−
714− replicateMN mx =
715− let
716− replicateMNP :: Monad m => m x -> m (NP I xs)
717− replicateMNP mx' = hsequence' $
718− hcpure (Proxy :: Proxy ((~) x)) (Comp (I <$> mx'))
719− in
720− to . SOP . Z <$> replicateMNP mx
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))