on dev help sign in
remove some boilerplate with overlapping instances
commit0833082df30eb3942a2664d7868304253e7dec85 authorEitan Chatav <eitan.chatav@gmail.com> dateThu 23 Aug 2018, 17:31 (8 years ago) parent1c19863
1 file changed+19−208
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+19−208
squeal-postgresql/src/Squeal/PostgreSQL/Binary.hs+19−208
@@ -371,121 +371,19 @@ class ToArray (x :: Type) (array :: NullityType) where
371371 baseOid :: Word32
372372 default baseOid :: HasOid (PGTypeOf array) => Word32
373373 baseOid = oid @(PGTypeOf array)
374−toArrayLeaf
375− :: forall x pg. ToParam x pg
376− => x -> K Encoding.Array ('NotNull pg)
377−toArrayLeaf = K . Encoding.encodingArray . unK . toParam @x @pg
378−toNullableArrayLeaf
379− :: forall x pg. ToParam x pg
380− => Maybe x -> K Encoding.Array ('Null pg)
381−toNullableArrayLeaf = K . maybe Encoding.nullArray
382− (Encoding.encodingArray . unK . toParam @x @pg)
383−instance ToArray Bool ('NotNull 'PGbool) where
384− toArray = toArrayLeaf @Bool @'PGbool
385−instance ToArray (Maybe Bool) ('Null 'PGbool) where
386− toArray = toNullableArrayLeaf @Bool @'PGbool
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
483−instance ToArray x array
374+instance {-# OVERLAPPABLE #-} (HasOid pg, ToParam x pg)
375+ => ToArray x ('NotNull pg) where
376+ toArray = K . Encoding.encodingArray . unK . toParam @x @pg
377+instance {-# OVERLAPPABLE #-} (HasOid pg, ToParam x pg)
378+ => ToArray (Maybe x) ('Null pg) where
379+ toArray = K . maybe Encoding.nullArray
380+ (Encoding.encodingArray . unK . toParam @x @pg)
381+instance {-# OVERLAPPING #-} ToArray x array
484382 => ToArray (Vector x) ('NotNull ('PGvararray array)) where
485383 toArray = K . Encoding.dimensionArray Vector.foldl'
486384 (unK . toArray @x @array)
487385 baseOid = baseOid @x @array
488−instance
386+instance {-# OVERLAPPING #-}
489387 ( IsProductType product xs
490388 , Length xs ~ n
491389 , All ((~) x) xs
@@ -628,109 +526,22 @@ instance FromValue pg y
628526
629527class FromArray (ty :: NullityType) (y :: Type) where
630528 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)
636−instance FromArray ('NotNull 'PGbool) Bool where
637− fromArray = fromArrayLeaf @'PGbool @Bool
638−instance FromArray ('Null 'PGbool) (Maybe Bool) where
639− fromArray = fromNullableArrayLeaf @'PGbool @Bool
640−instance FromArray ('NotNull 'PGint2) Int16 where
641− fromArray = fromArrayLeaf @'PGint2 @Int16
642−instance FromArray ('Null 'PGint2) (Maybe Int16) where
643− fromArray = fromNullableArrayLeaf @'PGint2 @Int16
644−instance FromArray ('NotNull 'PGint4) Int32 where
645− fromArray = fromArrayLeaf @'PGint4 @Int32
646−instance FromArray ('Null 'PGint4) (Maybe Int32) where
647− fromArray = fromNullableArrayLeaf @'PGint4 @Int32
648−instance FromArray ('NotNull 'PGint8) Int64 where
649− fromArray = fromArrayLeaf @'PGint8 @Int64
650−instance FromArray ('Null 'PGint8) (Maybe Int64) where
651− fromArray = fromNullableArrayLeaf @'PGint8 @Int64
652−instance FromArray ('NotNull 'PGfloat4) Float where
653− fromArray = fromArrayLeaf @'PGfloat4 @Float
654−instance FromArray ('Null 'PGfloat4) (Maybe Float) where
655− fromArray = fromNullableArrayLeaf @'PGfloat4 @Float
656−instance FromArray ('NotNull 'PGfloat8) Double where
657− fromArray = fromArrayLeaf @'PGfloat8 @Double
658−instance FromArray ('Null 'PGfloat8) (Maybe Double) where
659− fromArray = fromNullableArrayLeaf @'PGfloat8 @Double
660−instance FromArray ('NotNull 'PGnumeric) Scientific where
661− fromArray = fromArrayLeaf @'PGnumeric @Scientific
662−instance FromArray ('Null 'PGnumeric) (Maybe Scientific) where
663− fromArray = fromNullableArrayLeaf @'PGnumeric @Scientific
664−instance FromArray ('NotNull 'PGuuid) UUID where
665− fromArray = fromArrayLeaf @'PGuuid @UUID
666−instance FromArray ('Null 'PGuuid) (Maybe UUID) where
667− fromArray = fromNullableArrayLeaf @'PGuuid @UUID
668−instance FromArray ('NotNull 'PGinet) (NetAddr IP) where
669− fromArray = fromArrayLeaf @'PGinet @(NetAddr IP)
670−instance FromArray ('Null 'PGinet) (Maybe (NetAddr IP)) where
671− fromArray = fromNullableArrayLeaf @'PGinet @(NetAddr IP)
672−instance FromArray ('NotNull ('PGchar 1)) Char where
673− fromArray = fromArrayLeaf @('PGchar 1) @Char
674−instance FromArray ('Null ('PGchar 1)) (Maybe Char) where
675− fromArray = fromNullableArrayLeaf @('PGchar 1) @Char
676−instance FromArray ('NotNull 'PGtext) Strict.Text where
677− fromArray = fromArrayLeaf @'PGtext @Strict.Text
678−instance FromArray ('Null 'PGtext) (Maybe Strict.Text) where
679− fromArray = fromNullableArrayLeaf @'PGtext @Strict.Text
680−instance FromArray ('NotNull 'PGtext) Lazy.Text where
681− fromArray = fromArrayLeaf @'PGtext @Lazy.Text
682−instance FromArray ('Null 'PGtext) (Maybe Lazy.Text) where
683− fromArray = fromNullableArrayLeaf @'PGtext @Lazy.Text
684−instance FromArray ('NotNull 'PGbytea) Strict.ByteString where
685− fromArray = fromArrayLeaf @'PGbytea @Strict.ByteString
686−instance FromArray ('Null 'PGbytea) (Maybe Strict.ByteString) where
687− fromArray = fromNullableArrayLeaf @'PGbytea @Strict.ByteString
688−instance FromArray ('NotNull 'PGbytea) Lazy.ByteString where
689− fromArray = fromArrayLeaf @'PGbytea @Lazy.ByteString
690−instance FromArray ('Null 'PGbytea) (Maybe Lazy.ByteString) where
691− fromArray = fromNullableArrayLeaf @'PGbytea @Lazy.ByteString
692−instance FromArray ('NotNull 'PGdate) Day where
693− fromArray = fromArrayLeaf @'PGdate @Day
694−instance FromArray ('Null 'PGdate) (Maybe Day) where
695− fromArray = fromNullableArrayLeaf @'PGdate @Day
696−instance FromArray ('NotNull 'PGtime) TimeOfDay where
697− fromArray = fromArrayLeaf @'PGtime @TimeOfDay
698−instance FromArray ('Null 'PGtime) (Maybe TimeOfDay) where
699− fromArray = fromNullableArrayLeaf @'PGtime @TimeOfDay
700−instance FromArray ('NotNull 'PGtimetz) (TimeOfDay, TimeZone) where
701− fromArray = fromArrayLeaf @'PGtimetz @(TimeOfDay, TimeZone)
702−instance FromArray ('Null 'PGtimetz) (Maybe (TimeOfDay, TimeZone)) where
703− fromArray = fromNullableArrayLeaf @'PGtimetz @(TimeOfDay, TimeZone)
704−instance FromArray ('NotNull 'PGtimestamp) LocalTime where
705− fromArray = fromArrayLeaf @'PGtimestamp @LocalTime
706−instance FromArray ('Null 'PGtimestamp) (Maybe LocalTime) where
707− fromArray = fromNullableArrayLeaf @'PGtimestamp @LocalTime
708−instance FromArray ('NotNull 'PGtimestamptz) UTCTime where
709− fromArray = fromArrayLeaf @'PGtimestamptz @UTCTime
710−instance FromArray ('Null 'PGtimestamptz) (Maybe UTCTime) where
711− fromArray = fromNullableArrayLeaf @'PGtimestamptz @UTCTime
712−instance FromArray ('NotNull 'PGinterval) DiffTime where
713− fromArray = fromArrayLeaf @'PGinterval @DiffTime
714−instance FromArray ('Null 'PGinterval) (Maybe DiffTime) where
715− fromArray = fromNullableArrayLeaf @'PGinterval @DiffTime
716−instance FromArray ('NotNull 'PGjson) Value where
717− fromArray = fromArrayLeaf @'PGjson @Value
718−instance FromArray ('Null 'PGjson) (Maybe Value) where
719− fromArray = fromNullableArrayLeaf @'PGjson @Value
720−instance FromArray ('NotNull 'PGjsonb) Value where
721− fromArray = fromArrayLeaf @'PGjsonb @Value
722−instance FromArray ('Null 'PGjsonb) (Maybe Value) where
723− fromArray = fromNullableArrayLeaf @'PGjsonb @Value
724−instance FromArray array y
725− => FromArray (nullity ('PGvararray array)) (Vector y) where
529+instance {-# OVERLAPPABLE #-} FromValue pg y
530+ => FromArray ('NotNull pg) y where
531+ fromArray = Decoding.valueArray (fromValue @pg @y)
532+instance {-# OVERLAPPABLE #-} FromValue pg y
533+ => FromArray ('Null pg) (Maybe y) where
534+ fromArray = Decoding.nullableValueArray (fromValue @pg @y)
535+instance {-# OVERLAPPING #-} FromArray array y
536+ => FromArray ('NotNull ('PGvararray array)) (Vector y) where
726537 fromArray =
727538 Decoding.dimensionArray Vector.replicateM (fromArray @array @y)
728−instance
539+instance {-# OVERLAPPING #-}
729540 ( FromArray array y
730541 , All ((~) y) ys
731542 , SListI ys
732543 , IsProductType product ys )
733− => FromArray (nullity ('PGfixarray n array)) product where
544+ => FromArray ('NotNull ('PGfixarray n array)) product where
734545 fromArray =
735546 let
736547 rep _ = fmap (to . SOP . Z) . replicateMN