git.iko.soy/typeable/aeson
on master help sign in
List instance
commit93b1550c1996e1aab35bd580a5a310020eb5843b authorOleg Grenrus <oleg.grenrus@iki.fi> dateWed 30 Mar 2016, 12:33 (11 years ago) parent0e35a32
2 files changed+52−29
compare with master
unifiedsplit
Data/Aeson/Types/Class.hs+31−1 Data/Aeson/Types/Instances.hs+21−28
Data/Aeson/Types/Class.hs+31−1
@@ -36,14 +36,18 @@ module Data.Aeson.Types.Class
3636 ) where
3737
3838import Data.Aeson.Types.Internal
39+import Data.Monoid ((<>))
3940import Data.Text (Text)
4041import GHC.Generics (Generic, Rep, from, to)
41−import Data.Monoid ((<>))
4242import Data.Aeson.Encode.Builder (emptyArray_)
4343import qualified Data.ByteString.Builder as B
4444import qualified Data.Aeson.Encode.Builder as E
4545import qualified Data.Vector as V
4646
47+#if !MIN_VERSION_base(4,8,0)
48+import Data.Monoid (mempty)
49+#endif
50+
4751-- Coercible derivations aren't as powerful on GHC 7.8, though supported.
4852#define HAS_COERCIBLE (__GLASGOW_HASKELL__ >= 709)
4953
@@ -188,6 +192,19 @@ class ToJSON a where
188192 toEncoding = Encoding . E.encodeToBuilder . toJSON
189193 {-# INLINE toEncoding #-}
190194
195+ toJSONList :: [a] -> Value
196+ toJSONList = Array . V.fromList . map toJSON
197+ {-# INLINE toJSONList #-}
198+
199+ toEncodingList :: [a] -> Encoding
200+ toEncodingList [] = emptyArray_
201+ toEncodingList (x:xs) = Encoding $
202+ B.char7 '[' <> builder x <> commas xs <> B.char7 ']'
203+ where
204+ commas = foldr (\v vs -> B.char7 ',' <> builder v <> vs) mempty
205+ builder = fromEncoding . toEncoding
206+ {-# INLINE toEncodingList #-}
207+
191208-- | A type that can be converted from JSON, with the possibility of
192209-- failure.
193210--
@@ -268,6 +285,19 @@ class FromJSON a where
268285 default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
269286 parseJSON = genericParseJSON defaultOptions
270287
288+ parseJSONList :: Value -> Parser [a]
289+ parseJSONList (Array a)
290+ = sequence
291+ . zipWith parseIndexedJSON [0..]
292+ . V.toList
293+ $ a
294+ where
295+ parseIndexedJSON :: FromJSON a => Int -> Value -> Parser a
296+ parseIndexedJSON idx value = parseJSON value <?> Index idx
297+
298+ parseJSONList v = typeMismatch "[a]" v
299+
300+
271301-- | A key-value pair for encoding a JSON object.
272302class KeyValue kv where
273303 (.=) :: ToJSON v => Text -> v -> kv
Data/Aeson/Types/Instances.hs+21−28
@@ -4,14 +4,6 @@
44 ViewPatterns #-}
55{-# LANGUAGE DefaultSignatures #-}
66
7−-- Needed for Tagged, Const and Proxy instances
8−#if __GLASGOW_HASKELL__ >= 706
9−{-# LANGUAGE PolyKinds #-}
10−#endif
11−
12−#define NEEDS_INCOHERENT
13−#include "overlapping-compat.h"
14−
157{-# OPTIONS_GHC -fno-warn-orphans #-}
168
179-- TODO: Drop this when we remove support for Data.Attoparsec.Number
@@ -74,7 +66,7 @@ module Data.Aeson.Types.Instances
7466 ) where
7567
7668import Control.Applicative (Const(..))
77−import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, list, list')
69+import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, list')
7870import Data.Aeson.Functions (mapHashKeyVal, mapKey, mapKeyVal)
7971import Data.Aeson.Types.Class
8072import Data.Aeson.Types.Internal
@@ -104,6 +96,7 @@ import Text.ParserCombinators.ReadP (readP_to_S)
10496import Foreign.Storable (Storable)
10597import Numeric.Natural (Natural)
10698import Prelude hiding (foldr)
99+import qualified Prelude
107100import qualified Data.Aeson.Encode.Builder as E
108101import qualified Data.Aeson.Parser.Time as Time
109102import qualified Data.ByteString.Builder as B
@@ -259,24 +252,19 @@ instance FromJSON () where
259252 else fail "Expected an empty array"
260253 {-# INLINE parseJSON #-}
261254
262−instance INCOHERENT_ ToJSON [Char] where
263− toJSON = String . T.pack
264− {-# INLINE toJSON #-}
265−
266− toEncoding = Encoding . E.string
267− {-# INLINE toEncoding #-}
268−
269−instance INCOHERENT_ FromJSON [Char] where
270− parseJSON = withText "String" $ pure . T.unpack
271− {-# INLINE parseJSON #-}
272−
273255instance ToJSON Char where
274256 toJSON = String . T.singleton
275257 {-# INLINE toJSON #-}
276258
259+ toJSONList = String . T.pack
260+ {-# INLINE toJSONList #-}
261+
277262 toEncoding = Encoding . E.string . (:[])
278263 {-# INLINE toEncoding #-}
279264
265+ toEncodingList = Encoding . E.string
266+ {-# INLINE toEncodingList #-}
267+
280268instance FromJSON Char where
281269 parseJSON = withText "Char" $ \t ->
282270 if T.compareLength t 1 == EQ
@@ -284,6 +272,9 @@ instance FromJSON Char where
284272 else fail "Expected a string of length 1"
285273 {-# INLINE parseJSON #-}
286274
275+ parseJSONList = withText "String" $ pure . T.unpack
276+ {-# INLINE parseJSONList #-}
277+
287278instance ToJSON Scientific where
288279 toJSON = Number
289280 {-# INLINE toJSON #-}
@@ -528,10 +519,13 @@ instance FromJSON LT.Text where
528519 {-# INLINE parseJSON #-}
529520
530521instance (ToJSON a) => ToJSON (NonEmpty a) where
531− toJSON = toJSON . toList
522+ toJSON = Array . V.fromList . map toJSON . toList
532523 {-# INLINE toJSON #-}
533524
534− toEncoding = toEncoding . toList
525+ toEncoding (x :| xs) = Encoding $
526+ B.char7 '[' <> builder x <> commas xs <> B.char7 ']'
527+ where
528+ commas = Prelude.foldr (\v vs -> B.char7 ',' <> builder v <> vs) mempty
535529 {-# INLINE toEncoding #-}
536530
537531instance (FromJSON a) => FromJSON (NonEmpty a) where
@@ -541,16 +535,15 @@ instance (FromJSON a) => FromJSON (NonEmpty a) where
541535 ne [] = fail "Expected a NonEmpty but got an empty list"
542536 ne (x:xs) = pure (x :| xs)
543537
544−instance OVERLAPPABLE_ (ToJSON a) => ToJSON [a] where
545− toJSON = Array . V.fromList . map toJSON
538+instance (ToJSON a) => ToJSON [a] where
539+ toJSON = toJSONList
546540 {-# INLINE toJSON #-}
547541
548− toEncoding xs = list xs
542+ toEncoding = toEncodingList
549543 {-# INLINE toEncoding #-}
550544
551−instance OVERLAPPABLE_ (FromJSON a) => FromJSON [a] where
552− parseJSON = withArray "[a]" $ Tr.sequence .
553− zipWith parseIndexedJSON [0..] . V.toList
545+instance (FromJSON a) => FromJSON [a] where
546+ parseJSON = parseJSONList
554547 {-# INLINE parseJSON #-}
555548
556549instance (ToJSON a) => ToJSON (Seq.Seq a) where