@@ -71,6 +71,7 @@ import qualified Data.Vector.Generic as VG
7171import qualified Data.Vector.Primitive as VP
7272import qualified Data.Vector.Storable as VS
7373import qualified Data.Vector.Unboxed as VU
74+import qualified Data.Vector.Mutable as VM ( unsafeNew, unsafeWrite )
7475
7576#ifdef GENERICS
7677import GHC.Generics
@@ -622,45 +623,66 @@ instance FromJSON UTCTime where
622623 {-# INLINE parseJSON #-}
623624
624625instance (ToJSON a, ToJSON b) => ToJSON (a,b) where
625− toJSON (a,b) = toJSON [toJSON a, toJSON b]
626+ toJSON (a,b) = Array $ V.create $ do
627+ mv <- VM.unsafeNew 2
628+ VM.unsafeWrite mv 0 (toJSON a)
629+ VM.unsafeWrite mv 1 (toJSON b)
630+ return mv
626631 {-# INLINE toJSON #-}
627632
628633instance (FromJSON a, FromJSON b) => FromJSON (a,b) where
629− parseJSON (Array ab) =
630− case V.toList ab of
631− [a,b] -> (,) <$> parseJSON a <*> parseJSON b
632− _ -> fail $ "cannot unpack array of length " ++
633− show (V.length ab) ++ " into a pair"
634− parseJSON v = typeMismatch "(a,b)" v
634+ parseJSON (Array ab)
635+ | n == 2 = (,) <$> parseJSON (V.unsafeIndex ab 0)
636+ <*> parseJSON (V.unsafeIndex ab 1)
637+ | otherwise = fail $ "cannot unpack array of length " ++
638+ show n ++ " into a pair"
639+ where
640+ n = V.length ab
641+ parseJSON v = typeMismatch "(a,b)" v
635642 {-# INLINE parseJSON #-}
636643
637644instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where
638− toJSON (a,b,c) = toJSON [toJSON a, toJSON b, toJSON c]
645+ toJSON (a,b,c) = Array $ V.create $ do
646+ mv <- VM.unsafeNew 3
647+ VM.unsafeWrite mv 0 (toJSON a)
648+ VM.unsafeWrite mv 1 (toJSON b)
649+ VM.unsafeWrite mv 2 (toJSON c)
650+ return mv
639651 {-# INLINE toJSON #-}
640652
641653instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where
642− parseJSON (Array abc) =
643− case V.toList abc of
644− [a,b,c] -> (,,) <$> parseJSON a <*> parseJSON b <*> parseJSON c
645− _ -> fail $ "cannot unpack array of length " ++
646− show (V.length abc) ++ " into a 3-tuple"
647− parseJSON v = typeMismatch "(a,b,c)" v
654+ parseJSON (Array abc)
655+ | n == 3 = (,,) <$> parseJSON (V.unsafeIndex abc 0)
656+ <*> parseJSON (V.unsafeIndex abc 1)
657+ <*> parseJSON (V.unsafeIndex abc 2)
658+ | otherwise = fail $ "cannot unpack array of length " ++
659+ show n ++ " into a 3-tuple"
660+ where
661+ n = V.length abc
662+ parseJSON v = typeMismatch "(a,b,c)" v
648663 {-# INLINE parseJSON #-}
649664
650665instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where
651− toJSON (a,b,c,d) = toJSON [toJSON a, toJSON b, toJSON c, toJSON d]
666+ toJSON (a,b,c,d) = Array $ V.create $ do
667+ mv <- VM.unsafeNew 4
668+ VM.unsafeWrite mv 0 (toJSON a)
669+ VM.unsafeWrite mv 1 (toJSON b)
670+ VM.unsafeWrite mv 2 (toJSON c)
671+ VM.unsafeWrite mv 3 (toJSON d)
672+ return mv
652673 {-# INLINE toJSON #-}
653674
654675instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where
655− parseJSON (Array abcd) =
656− case V.toList abcd of
657− [a,b,c,d] -> (,,,) <$> parseJSON a
658− <*> parseJSON b
659− <*> parseJSON c
660− <*> parseJSON d
661− _ -> fail $ "cannot unpack array of length " ++
662− show (V.length abcd) ++ " into a 4-tuple"
663− parseJSON v = typeMismatch "(a,b,c,d)" v
676+ parseJSON (Array abcd)
677+ | n == 4 = (,,,) <$> parseJSON (V.unsafeIndex abcd 0)
678+ <*> parseJSON (V.unsafeIndex abcd 1)
679+ <*> parseJSON (V.unsafeIndex abcd 2)
680+ <*> parseJSON (V.unsafeIndex abcd 3)
681+ | otherwise = fail $ "cannot unpack array of length " ++
682+ show n ++ " into a 4-tuple"
683+ where
684+ n = V.length abcd
685+ parseJSON v = typeMismatch "(a,b,c,d)" v
664686 {-# INLINE parseJSON #-}
665687
666688instance ToJSON a => ToJSON (Dual a) where