6ff3395 · typeable/aeson

git.iko.soy/typeable/aeson

Add instances for Sum and Product, resolves #408

commit6ff33958e26533a6a02ad2690beaea357df4a222 authorOleg Grenrus <oleg.grenrus@iki.fi> dateTue 14 Jun 2016, 09:58 (10 years ago) parent599aa8f

4 files changed+115−31

compare with master

unifiedsplit

Data/Aeson/Types/FromJSON.hs+40−3 Data/Aeson/Types/ToJSON.hs+62−27 aeson.cabal+3−1 tests/UnitTests.hs+10

Data/Aeson/Types/FromJSON.hs+40−3

@@ -84,6 +84,8 @@ import Data.Bits (unsafeShiftR)

8484import Data.Fixed (Fixed, HasResolution)

8585import Data.Functor.Compose (Compose (..))

8686import Data.Functor.Identity (Identity (..))

87+import Data.Functor.Product (Product (..))

88+import Data.Functor.Sum (Sum (..))

8789import Data.Hashable (Hashable (..))

8890import Data.Int (Int16, Int32, Int64, Int8)

8991import Data.List.NonEmpty (NonEmpty (..))

@@ -991,6 +993,10 @@ instance FromJSON2 Either where

991993 liftParseJSON2 pA _ pB _ (Object (H.toList -> [(key, value)]))

992994 | key == left = Left <$> pA value <?> Key left

993995 | key == right = Right <$> pB value <?> Key right

996+ where

997+ left, right :: Text

998+ left = "Left"

999+ right = "Right"

9941000

9951001 liftParseJSON2 _ _ _ _ _ = fail $

9961002 "expected an object with a single property " ++

@@ -1006,9 +1012,6 @@ instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where

10061012 parseJSON = parseJSON2

10071013 {-# INLINE parseJSON #-}

10081014

1009−left, right :: Text

1010−left = "Left"

1011−right = "Right"

10121015

10131016

10141017instance FromJSON Bool where

@@ -1293,6 +1296,40 @@ instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Compose f g a) wher

12931296 parseJSONList = liftParseJSONList parseJSON parseJSONList

12941297 {-# INLINE parseJSONList #-}

12951298

1299+

1300+instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Product f g) where

1301+ liftParseJSON p pl a = uncurry Pair <$> liftParseJSON2 px pxl py pyl a

1302+ where

1303+ px = liftParseJSON p pl

1304+ pxl = liftParseJSONList p pl

1305+ py = liftParseJSON p pl

1306+ pyl = liftParseJSONList p pl

1307+ {-# INLINE liftParseJSON #-}

1308+

1309+instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Product f g a) where

1310+ parseJSON = parseJSON1

1311+ {-# INLINE parseJSON #-}

1312+

1313+

1314+instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (Sum f g) where

1315+ liftParseJSON p pl (Object (H.toList -> [(key, value)]))

1316+ | key == inl = InL <$> liftParseJSON p pl value <?> Key inl

1317+ | key == inr = InR <$> liftParseJSON p pl value <?> Key inl

1318+ where

1319+ inl, inr :: Text

1320+ inl = "InL"

1321+ inr = "InR"

1322+

1323+ liftParseJSON _ _ _ = fail $

1324+ "expected an object with a single property " ++

1325+ "where the property key should be either " ++

1326+ "\"InL\" or \"InR\""

1327+ {-# INLINE liftParseJSON #-}

1328+

1329+instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (Sum f g a) where

1330+ parseJSON = parseJSON1

1331+ {-# INLINE parseJSON #-}

1332+

12961333-------------------------------------------------------------------------------

12971334-- containers

12981335-------------------------------------------------------------------------------

Data/Aeson/Types/ToJSON.hs+62−27

@@ -74,6 +74,8 @@ import Data.Fixed (Fixed, HasResolution)

7474import Data.Foldable (toList)

7575import Data.Functor.Compose (Compose (..))

7676import Data.Functor.Identity (Identity (..))

77+import Data.Functor.Product (Product (..))

78+import Data.Functor.Sum (Sum (..))

7779import Data.Int (Int16, Int32, Int64, Int8)

7880import Data.List (intersperse)

7981import Data.List.NonEmpty (NonEmpty (..))

@@ -94,27 +96,27 @@ import Foreign.Storable (Storable)

9496import GHC.Generics

9597import Numeric.Natural (Natural)

9698

97−import qualified Data.ByteString.Lazy as L

98−import qualified Data.DList as DList

99−import qualified Data.HashMap.Strict as H

100−import qualified Data.HashSet as HashSet

101−import qualified Data.IntMap as IntMap

102−import qualified Data.IntSet as IntSet

103−import qualified Data.List.NonEmpty as NE

104−import qualified Data.Map as M

105−import qualified Data.Scientific as Scientific

106−import qualified Data.Sequence as Seq

107−import qualified Data.Set as Set

108−import qualified Data.Text as T

109−import qualified Data.Text.Encoding as T

110−import qualified Data.Text.Lazy as LT

111−import qualified Data.Tree as Tree

112−import qualified Data.Vector as V

113−import qualified Data.Vector.Generic as VG

114−import qualified Data.Vector.Mutable as VM

115−import qualified Data.Vector.Primitive as VP

116−import qualified Data.Vector.Storable as VS

117−import qualified Data.Vector.Unboxed as VU

99+import qualified Data.ByteString.Lazy as L

100+import qualified Data.DList as DList

101+import qualified Data.HashMap.Strict as H

102+import qualified Data.HashSet as HashSet

103+import qualified Data.IntMap as IntMap

104+import qualified Data.IntSet as IntSet

105+import qualified Data.List.NonEmpty as NE

106+import qualified Data.Map as M

107+import qualified Data.Scientific as Scientific

108+import qualified Data.Sequence as Seq

109+import qualified Data.Set as Set

110+import qualified Data.Text as T

111+import qualified Data.Text.Encoding as T

112+import qualified Data.Text.Lazy as LT

113+import qualified Data.Tree as Tree

114+import qualified Data.Vector as V

115+import qualified Data.Vector.Generic as VG

116+import qualified Data.Vector.Mutable as VM

117+import qualified Data.Vector.Primitive as VP

118+import qualified Data.Vector.Storable as VS

119+import qualified Data.Vector.Unboxed as VU

118120

119121toJSONPair :: (a -> Value) -> (b -> Value) -> (a, b) -> Value

120122toJSONPair a b = liftToJSON2 a (listValue a) b (listValue b)

@@ -1204,8 +1206,8 @@ instance (ToJSON a) => ToJSON (Maybe a) where

12041206

12051207

12061208instance ToJSON2 Either where

1207− liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton left (toA a)

1208− liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton right (toB b)

1209+ liftToJSON2 toA _ _toB _ (Left a) = Object $ H.singleton "Left" (toA a)

1210+ liftToJSON2 _toA _ toB _ (Right b) = Object $ H.singleton "Right" (toB b)

12091211 {-# INLINE liftToJSON2 #-}

12101212

12111213 liftToEncoding2 toA _ _toB _ (Left a) = E.pairs $ E.pair "Left" $ toA a

@@ -1227,10 +1229,6 @@ instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where

12271229 toEncoding = toEncoding2

12281230 {-# INLINE toEncoding #-}

12291231

1230−left, right :: Text

1231−left = "Left"

1232−right = "Right"

1233−

12341232

12351233instance ToJSON Bool where

12361234 toJSON = Bool

@@ -1633,6 +1631,43 @@ instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Compose f g a) where

16331631 toEncodingList = liftToEncodingList toEncoding toEncodingList

16341632 {-# INLINE toEncodingList #-}

16351633

1634+

1635+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Product f g) where

1636+ liftToJSON tv tvl (Pair x y) = liftToJSON2 tx txl ty tyl (x, y)

1637+ where

1638+ tx = liftToJSON tv tvl

1639+ txl = liftToJSONList tv tvl

1640+ ty = liftToJSON tv tvl

1641+ tyl = liftToJSONList tv tvl

1642+

1643+ liftToEncoding te tel (Pair x y) = liftToEncoding2 tx txl ty tyl (x, y)

1644+ where

1645+ tx = liftToEncoding te tel

1646+ txl = liftToEncodingList te tel

1647+ ty = liftToEncoding te tel

1648+ tyl = liftToEncodingList te tel

1649+

1650+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Product f g a) where

1651+ toJSON = toJSON1

1652+ {-# INLINE toJSON #-}

1653+

1654+ toEncoding = toEncoding1

1655+ {-# INLINE toEncoding #-}

1656+

1657+instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (Sum f g) where

1658+ liftToJSON tv tvl (InL x) = Object $ H.singleton "InL" (liftToJSON tv tvl x)

1659+ liftToJSON tv tvl (InR y) = Object $ H.singleton "InR" (liftToJSON tv tvl y)

1660+

1661+ liftToEncoding te tel (InL x) = E.pairs $ E.pair "InL" $ liftToEncoding te tel x

1662+ liftToEncoding te tel (InR y) = E.pairs $ E.pair "InR" $ liftToEncoding te tel y

1663+

1664+instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (Sum f g a) where

1665+ toJSON = toJSON1

1666+ {-# INLINE toJSON #-}

1667+

1668+ toEncoding = toEncoding1

1669+ {-# INLINE toEncoding #-}

1670+

16361671-------------------------------------------------------------------------------

16371672-- containers

16381673-------------------------------------------------------------------------------

aeson.cabal+3−1

@@ -112,6 +112,7 @@ library

112112 build-depends:

113113 semigroups >= 0.16.1 && < 0.19,

114114 transformers >= 0.2.2.0,

115+ transformers-compat >= 0.3,

115116 fail == 4.9.*

116117

117118 if !impl(ghc >= 7.10)

@@ -176,7 +177,8 @@ test-suite tests

176177 if !impl(ghc >= 8.0)

177178 build-depends:

178179 semigroups >= 0.16.1 && < 0.19,

179− transformers >= 0.2.2.0

180+ transformers >= 0.2.2.0,

181+ transformers-compat >= 0.3

180182

181183 if !impl(ghc >= 7.10)

182184 build-depends: nats >=1 && <1.2

tests/UnitTests.hs+10

@@ -24,6 +24,8 @@ import Data.Char (toUpper)

2424import Data.Hashable (hash)

2525import Data.List.NonEmpty (NonEmpty(..))

2626import Data.Functor.Compose (Compose (..))

27+import Data.Functor.Product (Product(..))

28+import Data.Functor.Sum (Sum(..))

2729import Data.Functor.Identity (Identity (..))

2830import Data.Maybe (fromMaybe)

2931import Data.Proxy (Proxy(..))

@@ -304,6 +306,14 @@ jsonExamples =

304306 , Example "Maybe String" "\"foo\"" (pure "foo" :: Maybe String)

305307 , Example "Maybe [Identity Char]" "\"xy\"" (pure [pure 'x', pure 'y'] :: Maybe [Identity Char])

306308

309+ , Example "Product I Maybe Int" "[1,2]" (Pair (pure 1) (pure 2) :: Product I Maybe Int)

310+ , Example "Product I Maybe Int" "[1,null]" (Pair (pure 1) Nothing :: Product I Maybe Int)

311+ , Example "Product I [] Char" "[\"a\",\"foo\"]" (Pair (pure 'a') "foo" :: Product I [] Char)

312+

313+ , Example "Sum I [] Int: InL" "{\"InL\":1}" (InL (pure 1) :: Sum I [] Int)

314+ , Example "Sum I [] Int: InR" "{\"InR\":[1,2]}" (InR [1, 2] :: Sum I [] Int)

315+ , Example "Sum I [] Char: InR" "{\"InR\":\"foo\"}" (InR "foo" :: Sum I [] Char)

316+

307317 , Example "Compose I I Int" "1" (pure 1 :: Compose I I Int)

308318 , Example "Compose I [] Int" "[1]" (pure 1 :: Compose I [] Int)

309319 , Example "Compose [] I Int" "[1]" (pure 1 :: Compose [] I Int)