on master help sign in
Add few more ToJSON1/FromJSON1 instances
commit5073948e18884497cdab9e96cad2573e13f7707c authorOleg Grenrus <oleg.grenrus@iki.fi> dateMon 28 Mar 2016, 01:04 (11 years ago) parent79fcb38
2 files changed+73−22
Data/Aeson/Encode/Functions.hs+6 Data/Aeson/Types/Instances.hs+67−22
Data/Aeson/Encode/Functions.hs+6
@@ -7,6 +7,7 @@ module Data.Aeson.Encode.Functions
77 , char7
88 , encode
99 , foldable
10+ , foldable'
1011 , list
1112 , list'
1213 , pairs
@@ -42,6 +43,11 @@ foldable :: (Foldable t, ToJSON a) => t a -> Encoding
4243foldable = brackets '[' ']' . foldMap (Value . toEncoding)
4344{-# INLINE foldable #-}
4445
46+-- | Encode a 'Foldable' as a JSON array.
47+foldable' :: (Foldable t) => (a -> Encoding) -> t a -> Encoding
48+foldable' to = brackets '[' ']' . foldMap (Value . to)
49+{-# INLINE foldable' #-}
50+
4551list :: (ToJSON a) => [a] -> Encoding
4652list [] = emptyArray_
4753list (x:xs) = Encoding $
Data/Aeson/Types/Instances.hs+67−22
@@ -77,8 +77,8 @@ module Data.Aeson.Types.Instances
7777 ) where
7878
7979import Control.Applicative (Const(..))
80−import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, list')
81−import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)
80+import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, foldable', list')
81+import Data.Aeson.Functions (hashMapKey, mapHashKeyVal, mapKey, mapKeyVal)
8282import Data.Aeson.Types.Class
8383import Data.Aeson.Types.Internal
8484import Data.Attoparsec.Number (Number(..))
@@ -150,7 +150,10 @@ import System.Locale (defaultTimeLocale)
150150#endif
151151
152152parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
153−parseIndexedJSON idx value = parseJSON value <?> Index idx
153+parseIndexedJSON = parseIndexedJSON' parseJSON
154+
155+parseIndexedJSON' :: (Value -> Parser a) -> Int -> Value -> Parser a
156+parseIndexedJSON' p idx value = p value <?> Index idx
154157
155158parseIndexedJSONPair :: FromJSON b => (Value -> Parser a) -> Int -> Value -> Parser (a, b)
156159parseIndexedJSONPair keyParser idx value = p value <?> Index idx
@@ -581,45 +584,76 @@ instance FromJSON LT.Text where
581584 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict
582585 {-# INLINE parseJSON #-}
583586
587+instance ToJSON1 NonEmpty where
588+ liftToJSON to = liftToJSON to . toList
589+ {-# INLINE liftToJSON #-}
590+
591+ liftToEncoding = foldable'
592+ {-# INLINE liftToEncoding #-}
593+
584594instance (ToJSON a) => ToJSON (NonEmpty a) where
585− toJSON = Array . V.fromList . map toJSON . toList
595+ toJSON = toJSON1
586596 {-# INLINE toJSON #-}
587597
588− toEncoding (x :| xs) = Encoding $
589− B.char7 '[' <> builder x <> commas xs <> B.char7 ']'
590− where
591− commas = Prelude.foldr (\v vs -> B.char7 ',' <> builder v <> vs) mempty
598+ toEncoding = toEncoding1
592599 {-# INLINE toEncoding #-}
593600
594−instance (FromJSON a) => FromJSON (NonEmpty a) where
595− parseJSON = withArray "NonEmpty a" $
596− (>>= ne) . Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList
601+instance FromJSON1 NonEmpty where
602+ liftParseJSON p = withArray "NonEmpty a" $
603+ (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON' p) [0..] . V.toList
597604 where
598605 ne [] = fail "Expected a NonEmpty but got an empty list"
599606 ne (x:xs) = pure (x :| xs)
607+ {-# INLINE liftParseJSON #-}
608+
609+instance (FromJSON a) => FromJSON (NonEmpty a) where
610+ parseJSON = parseJSON1
611+
612+instance ToJSON1 [] where
613+ liftToJSON to = Array . V.fromList . map to
614+ {-# INLINE liftToJSON #-}
615+
616+ liftToEncoding = list'
617+ {-# INLINE liftToEncoding #-}
600618
601619instance (ToJSON a) => ToJSON [a] where
602− toJSON = toJSONList
620+ toJSON = toJSON1
603621 {-# INLINE toJSON #-}
604622
605− toEncoding = toEncodingList
623+ toEncoding = toEncoding1
606624 {-# INLINE toEncoding #-}
607625
626+instance FromJSON1 [] where
627+ liftParseJSON p = withArray "[a]" $
628+ Tr.sequence . zipWith (parseIndexedJSON' p) [0..] . V.toList
629+ {-# INLINE liftParseJSON #-}
630+
608631instance (FromJSON a) => FromJSON [a] where
609− parseJSON = parseJSONList
632+ parseJSON = parseJSON1
610633 {-# INLINE parseJSON #-}
611634
635+instance ToJSON1 Seq.Seq where
636+ liftToJSON to = liftToJSON to . toList
637+ {-# INLINE liftToJSON #-}
638+
639+ liftToEncoding = foldable'
640+ {-# INLINE liftToEncoding #-}
641+
612642instance (ToJSON a) => ToJSON (Seq.Seq a) where
613− toJSON = toJSON . toList
643+ toJSON = toJSON1
614644 {-# INLINE toJSON #-}
615645
616− toEncoding = foldable
646+ toEncoding = toEncoding1
617647 {-# INLINE toEncoding #-}
618648
619−instance (FromJSON a) => FromJSON (Seq.Seq a) where
620− parseJSON = withArray "Seq a" $
649+instance FromJSON1 Seq.Seq where
650+ liftParseJSON p = withArray "Seq a" $
621651 fmap Seq.fromList .
622− Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList
652+ Tr.sequence . zipWith (parseIndexedJSON' p) [0..] . V.toList
653+ {-# INLINE liftParseJSON #-}
654+
655+instance (FromJSON a) => FromJSON (Seq.Seq a) where
656+ parseJSON = parseJSON1
623657 {-# INLINE parseJSON #-}
624658
625659instance (ToJSON a) => ToJSON (Vector a) where
@@ -1642,16 +1676,27 @@ instance FromJSON (Proxy a) where
16421676 parseJSON Null = pure Proxy
16431677 parseJSON v = typeMismatch "Proxy" v
16441678
1679+instance ToJSON1 (Tagged a) where
1680+ liftToJSON to (Tagged x) = to x
1681+ {-# INLINE liftToJSON #-}
1682+
1683+ liftToEncoding to (Tagged x) = to x
1684+ {-# INLINE liftToEncoding #-}
1685+
16451686instance ToJSON b => ToJSON (Tagged a b) where
1646− toJSON (Tagged x) = toJSON x
1687+ toJSON = toJSON1
16471688 {-# INLINE toJSON #-}
16481689
1649− toEncoding (Tagged x) = toEncoding x
1690+ toEncoding = toEncoding1
16501691 {-# INLINE toEncoding #-}
16511692
1693+instance FromJSON1 (Tagged a) where
1694+ liftParseJSON p = fmap Tagged . p
1695+ {-# INLINE liftParseJSON #-}
1696+
16521697instance FromJSON b => FromJSON (Tagged a b) where
1698+ parseJSON = parseJSON1
16531699 {-# INLINE parseJSON #-}
1654− parseJSON = fmap Tagged . parseJSON
16551700
16561701instance ToJSON a => ToJSON (Const a b) where
16571702 toJSON (Const x) = toJSON x