5073948 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Add few more ToJSON1/FromJSON1 instances

5073948Oleg Grenrus11 years ago

Data/Aeson/Encode/Functions.hs+6

compare with master

unifiedsplit

@@ -7,6 +7,7 @@ module Data.Aeson.Encode.Functions

7 , char7

8 , encode

9 , foldable

10+ , foldable'

10 , list

11 , list

11 , list'

12 , list'

12 , pairs

13 , pairs

@@ -42,6 +43,11 @@ foldable :: (Foldable t, ToJSON a) => t a -> Encoding

42foldable = brackets '[' ']' . foldMap (Value . toEncoding)

43foldable = brackets '[' ']' . foldMap (Value . toEncoding)

43{-# INLINE foldable #-}

44{-# INLINE foldable #-}

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+

45list :: (ToJSON a) => [a] -> Encoding

51list :: (ToJSON a) => [a] -> Encoding

46list [] = emptyArray_

52list [] = emptyArray_

47list (x:xs) = Encoding $

53list (x:xs) = Encoding $

Data/Aeson/Types/Instances.hs+67−22

@@ -77,8 +77,8 @@ module Data.Aeson.Types.Instances

77 ) where

79import Control.Applicative (Const(..))

80−import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, list')

80+import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, foldable', list')

81−import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)

81+import Data.Aeson.Functions (hashMapKey, mapHashKeyVal, mapKey, mapKeyVal)

82import Data.Aeson.Types.Class

83import Data.Aeson.Types.Internal

84import Data.Attoparsec.Number (Number(..))

@@ -150,7 +150,10 @@ import System.Locale (defaultTimeLocale)

150#endif

151

152parseIndexedJSON :: 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

154

157

155parseIndexedJSONPair :: FromJSON b => (Value -> Parser a) -> Int -> Value -> Parser (a, b)

158parseIndexedJSONPair :: FromJSON b => (Value -> Parser a) -> Int -> Value -> Parser (a, b)

156parseIndexedJSONPair keyParser idx value = p value <?> Index idx

159parseIndexedJSONPair keyParser idx value = p value <?> Index idx

@@ -581,45 +584,76 @@ instance FromJSON LT.Text where

581 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict

584 parseJSON = withText "Lazy Text" $ pure . LT.fromStrict

582 {-# INLINE parseJSON #-}

585 {-# INLINE parseJSON #-}

583

586

587+instance ToJSON1 NonEmpty where

588+ liftToJSON to = liftToJSON to . toList

589+ {-# INLINE liftToJSON #-}

590+

591+ liftToEncoding = foldable'

592+ {-# INLINE liftToEncoding #-}

593+

584instance (ToJSON a) => ToJSON (NonEmpty a) where

594instance (ToJSON a) => ToJSON (NonEmpty a) where

585− toJSON = Array . V.fromList . map toJSON . toList

595+ toJSON = toJSON1

586 {-# INLINE toJSON #-}

596 {-# INLINE toJSON #-}

587

597

588− toEncoding (x :| xs) = Encoding $

598+ toEncoding = toEncoding1

589− B.char7 '[' <> builder x <> commas xs <> B.char7 ']'

590− where

591− commas = Prelude.foldr (\v vs -> B.char7 ',' <> builder v <> vs) mempty

592 {-# INLINE toEncoding #-}

599 {-# INLINE toEncoding #-}

593

600

594−instance (FromJSON a) => FromJSON (NonEmpty a) where

601+instance FromJSON1 NonEmpty where

595− parseJSON = withArray "NonEmpty a" $

602+ liftParseJSON p = withArray "NonEmpty a" $

596− (>>= ne) . Tr.sequence . zipWith parseIndexedJSON [0..] . V.toList

603+ (>>= ne) . Tr.sequence . zipWith (parseIndexedJSON' p) [0..] . V.toList

597 where

604 where

598 ne [] = fail "Expected a NonEmpty but got an empty list"

605 ne [] = fail "Expected a NonEmpty but got an empty list"

599 ne (x:xs) = pure (x :| xs)

606 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 #-}

600

618

601instance (ToJSON a) => ToJSON [a] where

619instance (ToJSON a) => ToJSON [a] where

602− toJSON = toJSONList

620+ toJSON = toJSON1

603 {-# INLINE toJSON #-}

621 {-# INLINE toJSON #-}

604

622

605− toEncoding = toEncodingList

623+ toEncoding = toEncoding1

606 {-# INLINE toEncoding #-}

624 {-# INLINE toEncoding #-}

607

625

626+instance FromJSON1 [] where

627+ liftParseJSON p = withArray "[a]" $

628+ Tr.sequence . zipWith (parseIndexedJSON' p) [0..] . V.toList

629+ {-# INLINE liftParseJSON #-}

630+

608instance (FromJSON a) => FromJSON [a] where

631instance (FromJSON a) => FromJSON [a] where

609− parseJSON = parseJSONList

632+ parseJSON = parseJSON1

610 {-# INLINE parseJSON #-}

633 {-# INLINE parseJSON #-}

611

634

635+instance ToJSON1 Seq.Seq where

636+ liftToJSON to = liftToJSON to . toList

637+ {-# INLINE liftToJSON #-}

638+

639+ liftToEncoding = foldable'

640+ {-# INLINE liftToEncoding #-}

641+

612instance (ToJSON a) => ToJSON (Seq.Seq a) where

642instance (ToJSON a) => ToJSON (Seq.Seq a) where

613− toJSON = toJSON . toList

643+ toJSON = toJSON1

614 {-# INLINE toJSON #-}

644 {-# INLINE toJSON #-}

615

645

616− toEncoding = foldable

646+ toEncoding = toEncoding1

617 {-# INLINE toEncoding #-}

647 {-# INLINE toEncoding #-}

618

648

619−instance (FromJSON a) => FromJSON (Seq.Seq a) where

649+instance FromJSON1 Seq.Seq where

620− parseJSON = withArray "Seq a" $

650+ liftParseJSON p = withArray "Seq a" $

621 fmap Seq.fromList .

651 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

623 {-# INLINE parseJSON #-}

657 {-# INLINE parseJSON #-}

624

658

625instance (ToJSON a) => ToJSON (Vector a) where

659instance (ToJSON a) => ToJSON (Vector a) where

@@ -1642,16 +1676,27 @@ instance FromJSON (Proxy a) where

1642 parseJSON Null = pure Proxy

1676 parseJSON Null = pure Proxy

1643 parseJSON v = typeMismatch "Proxy" v

1677 parseJSON v = typeMismatch "Proxy" v

1644

1678

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+

1645instance ToJSON b => ToJSON (Tagged a b) where

1686instance ToJSON b => ToJSON (Tagged a b) where

1646− toJSON (Tagged x) = toJSON x

1687+ toJSON = toJSON1

1647 {-# INLINE toJSON #-}

1688 {-# INLINE toJSON #-}

1648

1689

1649− toEncoding (Tagged x) = toEncoding x

1690+ toEncoding = toEncoding1

1650 {-# INLINE toEncoding #-}

1691 {-# INLINE toEncoding #-}

1651

1692

1693+instance FromJSON1 (Tagged a) where

1694+ liftParseJSON p = fmap Tagged . p

1695+ {-# INLINE liftParseJSON #-}

1696+

1652instance FromJSON b => FromJSON (Tagged a b) where

1697instance FromJSON b => FromJSON (Tagged a b) where

1698+ parseJSON = parseJSON1

1653 {-# INLINE parseJSON #-}

1699 {-# INLINE parseJSON #-}

1654− parseJSON = fmap Tagged . parseJSON

1655

1700

1656instance ToJSON a => ToJSON (Const a b) where

1701instance ToJSON a => ToJSON (Const a b) where

1657 toJSON (Const x) = toJSON x

1702 toJSON (Const x) = toJSON x