aeson 0.6.0.2 → 0.6.1.0

raw patch · 14 files changed

+504/−107 lines, 14 filesdep ~hashabledep ~timePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hashable, time

API changes (from Hackage documentation)

Files

• Data/Aeson.hs +255/−2
• Data/Aeson/Encode.hs +14/−3
• Data/Aeson/Functions.hs +1/−1
• Data/Aeson/Generic.hs +2/−1
• Data/Aeson/Parser.hs +2/−1
• Data/Aeson/Parser/Internal.hs +11/−1
• Data/Aeson/TH.hs +6/−6
• Data/Aeson/Types.hs +9/−1
• Data/Aeson/Types/Class.hs +145/−73
• Data/Aeson/Types/Generic.hs +1/−1
• Data/Aeson/Types/Internal.hs +11/−7
• aeson.cabal +4/−8
• release-notes.markdown +20/−0
• tests/Properties.hs +23/−2

@@ -1,6 +1,6 @@ -- | -- Module:      Data.Aeson--- Copyright:   (c) 2011 Bryan O'Sullivan+-- Copyright:   (c) 2011, 2012 Bryan O'Sullivan --              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>@@ -13,9 +13,30 @@  module Data.Aeson     (+    -- * How to use this library+    -- $use++    -- ** Working with the AST+    -- $ast++    -- ** Decoding to a Haskell value+    -- $haskell++    -- ** Decoding a mixed-type object+    -- $mixed++    -- ** Automatically decoding data types+    -- $typeable++    -- ** Pitfalls+    -- $pitfalls+     -- * Encoding and decoding+    -- $encoding_and_decoding       decode     , decode'+    , eitherDecode+    , eitherDecode'     , encode     -- * Core JSON types     , Value(..)@@ -28,6 +49,12 @@     , Result(..)     , fromJSON     , ToJSON(..)+    -- * Inspecting @'Value's@+    , withObject+    , withText+    , withArray+    , withNumber+    , withBool     -- * Constructors and accessors     , (.=)     , (.:)@@ -40,7 +67,7 @@     ) where  import Data.Aeson.Encode (encode)-import Data.Aeson.Parser.Internal (decodeWith, json, json')+import Data.Aeson.Parser.Internal (decodeWith, eitherDecodeWith, json, json') import Data.Aeson.Types import qualified Data.ByteString.Lazy as L @@ -63,3 +90,229 @@ decode' :: (FromJSON a) => L.ByteString -> Maybe a decode' = decodeWith json' fromJSON {-# INLINE decode' #-}++-- | Like 'decode' but returns an error message when decoding fails.+eitherDecode :: (FromJSON a) => L.ByteString -> Either String a+eitherDecode = eitherDecodeWith json fromJSON+{-# INLINE eitherDecode #-}++-- | Like 'decode'' but returns an error message when decoding fails.+eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a+eitherDecode' = eitherDecodeWith json' fromJSON+{-# INLINE eitherDecode' #-}++-- $use+--+-- This section contains basic information on the different ways to+-- decode data using this library. These range from simple but+-- inflexible, to complex but flexible.+--+-- The most common way to use the library is to define a data type,+-- corresponding to some JSON data you want to work with, and then+-- write either a 'FromJSON' instance, a to 'ToJSON' instance, or both+-- for that type. For example, given this JSON data:+--+-- > { "name": "Joe", "age": 12 }+--+-- we create a matching data type:+--+-- > data Person = Person+-- >     { name :: Text+-- >     , age  :: Int+-- >     } deriving Show-+--+-- To decode data, we need to define a 'FromJSON' instance:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > instance FromJSON Coord where+-- >     parseJSON (Object v) = Person <$>+-- >                            v .: "name" <*>+-- >                            v .: "age"+-- >     -- A non-Object value is of the wrong type, so fail.+-- >     parseJSON _          = mzero+--+-- We can now parse the JSON data like so:+--+-- > >>> decode "{\"name\":\"Joe\",\"age\":12}" :: Maybe Person+-- > Just (Person {name = "Joe", age = 12})+--+-- To encode data, we need to define a 'ToJSON' instance:+--+-- > instance ToJSON Person where+-- >     toJSON (Person name age) = object ["name" .= name, "age" .= age]+--+-- We can now encode a value like so:+--+-- > >>> encode (Person {name = "Joe", age = 12})+-- > "{\"name\":\"Joe\",\"age\":12}"+--+-- There are predefined 'FromJSON' and 'ToJSON' instances for many+-- types. Here's an example using lists and 'Int's:+--+-- > >>> decode "[1,2,3]" :: Maybe [Int]+-- > Just [1,2,3]+--+-- And here's an example using the 'Data.Map.Map' type to get a map of+-- 'Int's.+--+-- > >>> decode "{\"foo\":1,\"bar\":2}" :: Maybe (Map String Int)+-- > Just (fromList [("bar",2),("foo",1)])++-- While the notes below focus on decoding, you can apply almost the+-- same techniques to /encoding/ data. (The main difference is that+-- encoding always succeeds, but decoding has to handle the+-- possibility of failure, where an input doesn't match our+-- expectations.)+--+-- See the documentation of 'FromJSON' and 'ToJSON' for some examples+-- of how you can automatically derive instances in some+-- circumstances.++-- $ast+--+-- Sometimes you want to work with JSON data directly, without first+-- converting it to a custom data type. This can be useful if you want+-- to e.g. convert JSON data to YAML data, without knowing what the+-- contents of the original JSON data was. The 'Value' type, which is+-- an instance of 'FromJSON', is used to represent an arbitrary JSON+-- AST (abstract syntax tree). Example usage:+--+-- > >>> decode "{\"foo\": 123}" :: Maybe Value+-- > Just (Object (fromList [("foo",Number 123)]))+--+-- > >>> decode "{\"foo\": [\"abc\",\"def\"]}" :: Maybe Value+-- > Just (Object (fromList [("foo",Array (fromList [String "abc",String "def"]))]))+--+-- Once you have a 'Value' you can write functions to traverse it and+-- make arbitrary transformations.++-- $haskell+--+-- Any instance of 'FromJSON' can be specified (but see the+-- \"Pitfalls\" section here&#8212;"Data.Aeson#pitfalls"):+--+-- > λ> decode "[1,2,3]" :: Maybe [Int]+-- > Just [1,2,3]+--+-- Alternatively, there are instances for standard data types, so you+-- can use them directly. For example, use the 'Data.Map.Map' type to+-- get a map of 'Int's.+--+-- > λ> :m + Data.Map+-- > λ> decode "{\"foo\":1,\"bar\":2}" :: Maybe (Map String Int)+-- > Just (fromList [("bar",2),("foo",1)])++-- $mixed+--+-- The above approach with maps of course will not work for mixed-type+-- objects that don't follow a strict schema, but there are a couple+-- of approaches available for these.+--+-- The 'Object' type contains JSON objects:+--+-- > λ> decode "{\"name\":\"Dave\",\"age\":2}" :: Maybe Object+-- > Just (fromList) [("name",String "Dave"),("age",Number 2)]+--+-- You can extract values from it with a parser using 'parse',+-- 'parseEither' or, in this example, 'parseMaybe':+--+-- > λ> do result <- decode "{\"name\":\"Dave\",\"age\":2}"+-- >       flip parseMaybe result $ \obj -> do+-- >         age <- obj .: "age"+-- >         name <- obj .: "name"+-- >         return (name ++ ": " ++ show (age*2))+-- >+-- > Just "Dave: 4"+--+-- Considering that any type that implements 'FromJSON' can be used+-- here, this is quite a powerful way to parse JSON. See the+-- documentation in 'FromJSON' for how to implement this class for+-- your own data types.+--+-- The downside is that you have to write the parser yourself; the+-- upside is that you have complete control over the way the JSON is+-- parsed.++-- $typeable+--+-- If you don't want fine control and would prefer the JSON be parsed+-- to your own data types automatically according to some reasonably+-- sensible isomorphic implementation, you can use the generic parser+-- based on 'Data.Typeable.Typeable' and 'Data.Data.Data'. Switch to+-- the 'Data.Aeson.Generic' module, and you can do the following:+--+-- > λ> decode "[1]" :: Maybe [Int]+-- > Just [1]+-- > λ> :m + Data.Typeable Data.Data+-- > λ> :set -XDeriveDataTypeable+-- > λ> data Person = Person { personName :: String, personAge :: Int } deriving (Data,Typeable,Show)+-- > λ> encode Person { personName = "Chris", personAge = 123 }+-- > "{\"personAge\":123,\"personName\":\"Chris\"}"+-- > λ> decode "{\"personAge\":123,\"personName\":\"Chris\"}" :: Maybe Person+-- > Just (Person {+-- > personName = "Chris", personAge = 123+-- > })+--+-- Be aware that the encoding may not always be what you'd naively+-- expect:+--+-- > λ> data Foo = Foo Int Int deriving (Data,Typeable,Show)+-- > λ> encode (Foo 1 2)+-- > "[1,2]"+--+-- With this approach, it's best to treat the+-- 'Data.Aeson.Generic.decode' and 'Data.Aeson.Generic.encode'+-- functions as an isomorphism, and not to rely upon (or care about)+-- the specific intermediate representation.++-- $pitfalls+-- #pitfalls#+--+-- Note that the JSON standard only allows arrays or objects of things+-- at the top-level. Since this library follows the standard, calling+-- 'decode' on an unsupported result type will typecheck, but will+-- always \"fail\":+--+-- > >>> decode "1" :: Maybe Int+-- > Nothing+-- > >>> decode "1" :: Maybe String+-- > Nothing+--+-- So stick to objects (e.g. maps in Haskell) or arrays (lists or+-- vectors in Haskell):+--+-- > >>> decode "[1,2,3]" :: Maybe [Int]+-- > Just [1,2,3]+--+-- When encoding to JSON you can encode anything that's an instance of+-- 'ToJSON', and this may include simple types. So beware that this+-- aspect of the API is not isomorphic. You can round-trip arrays and+-- maps, but not simple values:+--+-- > >>> encode [1,2,3]+-- > "[1,2,3]"+-- > >>> decode (encode [1]) :: Maybe [Int]+-- > Just [1]+-- > >>> encode 1+-- > "1"+-- > >>> decode (encode (1 :: Int)) :: Maybe Int+-- > Nothing+--+-- Alternatively, see 'Data.Aeson.Parser.value' to parse non-top-level+-- JSON values.++-- $encoding_and_decoding+--+-- Encoding and decoding are each two-step processes.+--+-- * To encode a value, it is first converted to an abstract syntax+--   tree (AST), using 'ToJSON'. This generic representation is then+--   encoded as bytes.+--+-- * When decoding a value, the process is reversed: the bytes are+--   converted to an AST, then the 'FromJSON' class is used to convert+--   to the desired type.+--+-- For convenience, the 'encode' and+-- 'decode' functions combine both steps for convenience.

@@ -2,7 +2,8 @@  -- | -- Module:      Data.Aeson.Encode--- Copyright:   (c) 2011 MailRank, Inc.+-- Copyright:   (c) 2012 Bryan O'Sullivan+--              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com> -- Stability:   experimental@@ -62,15 +63,25 @@ string s = {-# SCC "string" #-} singleton '"' <> quote s <> singleton '"'   where     quote q = case T.uncons t of-                Nothing     -> fromText h+                Nothing      -> fromText h                 Just (!c,t') -> fromText h <> escape c <> quote t'         where (h,t) = {-# SCC "break" #-} T.break isEscape q-    isEscape c = c == '\"' || c == '\\' || c < '\x20'+    isEscape c = c == '\"' ||+                 c == '\\' ||+                 c == '<'  ||+                 c == '>'  ||+                 c < '\x20'     escape '\"' = "\\\""     escape '\\' = "\\\\"     escape '\n' = "\\n"     escape '\r' = "\\r"     escape '\t' = "\\t"++    -- The following prevents untrusted JSON strings containing </script> or -->+    -- from causing an XSS vulnerability:+    escape '<'  = "\\u003c"+    escape '>'  = "\\u003e"+     escape c         | c < '\x20' = fromString $ "\\u" ++ replicate (4 - length h) '0' ++ h         | otherwise  = singleton c

@@ -1,6 +1,6 @@ -- | -- Module:      Data.Aeson.Functions--- Copyright:   (c) 2011 Bryan O'Sullivan+-- Copyright:   (c) 2011, 2012 Bryan O'Sullivan --              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>

@@ -2,7 +2,7 @@  -- | -- Module:      Data.Aeson.Generic--- Copyright:   (c) 2011 Bryan O'Sullivan+-- Copyright:   (c) 2011, 2012 Bryan O'Sullivan --              (c) 2011 MailRank, Inc. --              (c) 2008, 2009 Lennart Augustsson -- License:     BSD3@@ -290,6 +290,7 @@         decodeArgs c0 = go (numConstrArgs (resType generic) c0) c0                            (constrFields c0)          where+          go 0 c _        Null       = construct c []           go 1 c []       jd         = construct c [jd] -- unary constructor           go _ c []       (Array js) = construct c (V.toList js) -- no field names           -- FIXME? We could allow reading an array into a constructor

@@ -2,7 +2,8 @@  -- | -- Module:      Data.Aeson.Parser--- Copyright:   (c) 2011 MailRank, Inc.+-- Copyright:   (c) 2012 Bryan O'Sullivan+--              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com> -- Stability:   experimental

@@ -2,7 +2,7 @@  -- | -- Module:      Data.Aeson.Parser.Internal--- Copyright:   (c) 2011 Bryan O'Sullivan+-- Copyright:   (c) 2011, 2012 Bryan O'Sullivan --              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>@@ -23,6 +23,7 @@     , value'     -- * Helpers     , decodeWith+    , eitherDecodeWith     ) where  import Blaze.ByteString.Builder (fromByteString, toByteString)@@ -237,6 +238,15 @@                       _         -> Nothing       _          -> Nothing {-# INLINE decodeWith #-}++eitherDecodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Either String a+eitherDecodeWith p to s =+    case L.parse p s of+      L.Done _ v -> case to v of+                      Success a -> Right a+                      Error msg -> Left msg+      L.Fail _ _ msg -> Left msg+{-# INLINE eitherDecodeWith #-}  -- $lazy --

@@ -2,7 +2,7 @@  {-| Module:      Data.Aeson.TH-Copyright:   (c) 2011 Bryan O'Sullivan+Copyright:   (c) 2011, 2012 Bryan O'Sullivan              (c) 2011 MailRank, Inc. License:     Apache Stability:   experimental@@ -46,7 +46,7 @@  instance 'ToJSON' a => 'ToJSON' (D a) where     'toJSON' =-      \value ->+      \\value ->         case value of           Nullary ->               'object' [T.pack \"Nullary\" .= 'toJSON' ([] :: [()])]@@ -73,7 +73,7 @@ @ instance 'FromJSON' a => 'FromJSON' (D a) where     'parseJSON' =-      \value ->+      \\value ->         case value of           'Object' obj ->             case H.toList obj of@@ -234,7 +234,7 @@ -- @ -- instance 'ToJSON' Foo where --      'toJSON' =---          \value -> case value of+--          \\value -> case value of --                      Foo arg1 arg2 -> 'Array' $ 'V.create' $ do --                        mv <- 'VM.unsafeNew' 2 --                        'VM.unsafeWrite' mv 0 ('toJSON' arg1)@@ -281,7 +281,7 @@ -- This will splice in the following code: -- -- @--- \value -> case value of Foo arg1 -> 'toJSON' arg1+-- \\value -> case value of Foo arg1 -> 'toJSON' arg1 -- @ mkToJSON :: (String -> String) -- ^ Function to change field names.          -> Name -- ^ Name of the type to encode.@@ -406,7 +406,7 @@ -- @ -- instance 'FromJSON' Foo where --     'parseJSON' =---         \value -> case value of+--         \\value -> case value of --                     'Array' arr -> --                       if (V.length arr == 2) --                       then Foo \<$\> 'parseJSON' (arr `V.unsafeIndex` 0)

@@ -2,7 +2,7 @@  -- | -- Module:      Data.Aeson.Types--- Copyright:   (c) 2011 Bryan O'Sullivan+-- Copyright:   (c) 2011, 2012 Bryan O'Sullivan --              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>@@ -32,6 +32,14 @@     , parseEither     , parseMaybe     , ToJSON(..)++    -- * Inspecting @'Value's@+    , withObject+    , withText+    , withArray+    , withNumber+    , withBool+     -- * Constructors and accessors     , (.=)     , (.:)

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,     GeneralizedNewtypeDeriving, IncoherentInstances, OverlappingInstances,     OverloadedStrings, UndecidableInstances, ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}  #ifdef GENERICS {-# LANGUAGE DefaultSignatures #-}@@ -8,7 +9,7 @@  -- | -- Module:      Data.Aeson.Types.Class--- Copyright:   (c) 2011 Bryan O'Sullivan+-- Copyright:   (c) 2011, 2012 Bryan O'Sullivan --              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>@@ -30,6 +31,14 @@ #endif     -- * Types     , DotNetTime(..)++      -- * Inspecting @'Value's@+    , withObject+    , withText+    , withArray+    , withNumber+    , withBool+     -- * Functions     , fromJSON     , (.:)@@ -39,18 +48,19 @@     , typeMismatch     ) where -import Control.Applicative ((<$>), (<*>), pure)+import Control.Applicative ((<$>), (<*>), (<|>), pure, empty) import Data.Aeson.Functions import Data.Aeson.Types.Internal import Data.Attoparsec.Char8 (Number(..))+import Data.Fixed import Data.Hashable (Hashable(..)) import Data.Int (Int8, Int16, Int32, Int64) import Data.Maybe (fromMaybe)-import Data.Monoid (Dual(..), First(..), Last(..))+import Data.Monoid (Dual(..), First(..), Last(..), mappend) import Data.Ratio (Ratio) import Data.Text (Text, pack, unpack) import Data.Text.Encoding (encodeUtf8)-import Data.Time.Clock (UTCTime)+import Data.Time (UTCTime, ZonedTime(..), TimeZone(..)) import Data.Time.Format (FormatTime, formatTime, parseTime) import Data.Traversable (traverse) import Data.Typeable (Typeable)@@ -111,8 +121,8 @@ -- type which is an instance of 'Data'. -- -- * If your compiler has support for the @DeriveGeneric@ and--- @DefaultSignatures@ language extensions, @toJSON@ will have a default generic--- implementation.+-- @DefaultSignatures@ language extensions (GHC 7.2 and newer),+-- @toJSON@ will have a default generic implementation. -- -- To use the latter option, simply add a @deriving 'Generic'@ clause to your -- datatype and declare a @ToJSON@ instance for your datatype without giving a@@ -228,8 +238,7 @@     {-# INLINE toJSON #-}  instance FromJSON Bool where-    parseJSON (Bool b) = pure b-    parseJSON v        = typeMismatch "Bool" v+    parseJSON = withBool "Bool" pure     {-# INLINE parseJSON #-}  instance ToJSON () where@@ -237,8 +246,10 @@     {-# INLINE toJSON #-}  instance FromJSON () where-    parseJSON (Array v) | V.null v = pure ()-    parseJSON v        = typeMismatch "()" v+    parseJSON = withArray "()" $ \v ->+                  if V.null v+                    then pure ()+                    else fail "Expected an empty array"     {-# INLINE parseJSON #-}  instance ToJSON [Char] where@@ -246,8 +257,7 @@     {-# INLINE toJSON #-}  instance FromJSON [Char] where-    parseJSON (String t) = pure (T.unpack t)-    parseJSON v          = typeMismatch "String" v+    parseJSON = withText "String" $ pure . T.unpack     {-# INLINE parseJSON #-}  instance ToJSON Char where@@ -255,9 +265,10 @@     {-# INLINE toJSON #-}  instance FromJSON Char where-    parseJSON (String t)-        | T.compareLength t 1 == EQ = pure (T.head t)-    parseJSON v          = typeMismatch "Char" v+    parseJSON = withText "Char" $ \t ->+                  if T.compareLength t 1 == EQ+                    then pure $ T.head t+                    else fail "Expected a string of length 1"     {-# INLINE parseJSON #-}  instance ToJSON Double where@@ -299,10 +310,21 @@     {-# INLINE toJSON #-}  instance FromJSON (Ratio Integer) where+    parseJSON = withNumber "Ration Integer" $ \n ->+                  pure $ case n of+                           D d -> toRational d+                           I i -> fromIntegral i+    {-# INLINE parseJSON #-}++instance HasResolution a => ToJSON (Fixed a) where+    toJSON = Number . realToFrac+    {-# INLINE toJSON #-}++instance HasResolution a => FromJSON (Fixed a) where     parseJSON (Number n) = pure $ case n of-                                    D d -> toRational d+                                    D d -> realToFrac d                                     I i -> fromIntegral i-    parseJSON v          = typeMismatch "Ratio Integer" v+    parseJSON v          = typeMismatch "Fixed" v     {-# INLINE parseJSON #-}  instance ToJSON Int where@@ -314,8 +336,7 @@     {-# INLINE parseJSON #-}  parseIntegral :: Integral a => Value -> Parser a-parseIntegral (Number n) = pure (floor n)-parseIntegral v          = typeMismatch "Integral" v+parseIntegral = withNumber "Integral" $ pure . floor {-# INLINE parseIntegral #-}  instance ToJSON Integer where@@ -403,8 +424,7 @@     {-# INLINE toJSON #-}  instance FromJSON Text where-    parseJSON (String t) = pure t-    parseJSON v          = typeMismatch "Text" v+    parseJSON = withText "Text" pure     {-# INLINE parseJSON #-}  instance ToJSON LT.Text where@@ -412,8 +432,7 @@     {-# INLINE toJSON #-}  instance FromJSON LT.Text where-    parseJSON (String t) = pure (LT.fromStrict t)-    parseJSON v          = typeMismatch "Lazy Text" v+    parseJSON = withText "Lazy Text" $ pure . LT.fromStrict     {-# INLINE parseJSON #-}  instance ToJSON B.ByteString where@@ -421,8 +440,7 @@     {-# INLINE toJSON #-}  instance FromJSON B.ByteString where-    parseJSON (String t) = pure . encodeUtf8 $ t-    parseJSON v          = typeMismatch "ByteString" v+    parseJSON = withText "ByteString" $ pure . encodeUtf8     {-# INLINE parseJSON #-}  instance ToJSON LB.ByteString where@@ -430,8 +448,7 @@     {-# INLINE toJSON #-}  instance FromJSON LB.ByteString where-    parseJSON (String t) = pure . lazy $ t-    parseJSON v          = typeMismatch "Lazy ByteString" v+    parseJSON = withText "Lazy ByteString" $ pure . lazy     {-# INLINE parseJSON #-}  instance (ToJSON a) => ToJSON [a] where@@ -439,8 +456,7 @@     {-# INLINE toJSON #-}  instance (FromJSON a) => FromJSON [a] where-    parseJSON (Array a) = mapM parseJSON (V.toList a)-    parseJSON v         = typeMismatch "[a]" v+    parseJSON = withArray "[a]" $ mapM parseJSON . V.toList     {-# INLINE parseJSON #-}  instance (ToJSON a) => ToJSON (Vector a) where@@ -448,8 +464,7 @@     {-# INLINE toJSON #-}  instance (FromJSON a) => FromJSON (Vector a) where-    parseJSON (Array a) = V.mapM parseJSON a-    parseJSON v         = typeMismatch "Vector a" v+    parseJSON = withArray "Vector a" $ V.mapM parseJSON     {-# INLINE parseJSON #-}  vectorToJSON :: (VG.Vector v a, ToJSON a) => v a -> Value@@ -457,8 +472,7 @@ {-# INLINE vectorToJSON #-}  vectorParseJSON :: (FromJSON a, VG.Vector w a) => String -> Value -> Parser (w a)-vectorParseJSON _ (Array a) = V.convert <$> V.mapM parseJSON a-vectorParseJSON s v         = typeMismatch s v+vectorParseJSON s = withArray s $ fmap V.convert . V.mapM parseJSON {-# INLINE vectorParseJSON #-}  instance (Storable a, ToJSON a) => ToJSON (VS.Vector a) where@@ -516,8 +530,8 @@     {-# INLINE toJSON #-}  instance (FromJSON v) => FromJSON (M.Map Text v) where-    parseJSON (Object o) = H.foldrWithKey M.insert M.empty <$> traverse parseJSON o-    parseJSON v          = typeMismatch "Map Text a" v+    parseJSON = withObject "Map Text a" $+                  fmap (H.foldrWithKey M.insert M.empty) . traverse parseJSON  instance (ToJSON v) => ToJSON (M.Map LT.Text v) where     toJSON = Object . mapHashKeyVal LT.toStrict toJSON@@ -548,8 +562,7 @@     {-# INLINE toJSON #-}  instance (FromJSON v) => FromJSON (H.HashMap Text v) where-    parseJSON (Object o) = traverse parseJSON o-    parseJSON v          = typeMismatch "HashMap Text a" v+    parseJSON = withObject "HashMap Text a" $ traverse parseJSON  instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where     toJSON = Object . mapKeyVal LT.toStrict toJSON@@ -602,26 +615,53 @@     {-# INLINE toJSON #-}  instance FromJSON DotNetTime where-    parseJSON (String t) =-        case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of-          Just d -> pure (DotNetTime d)-          _      -> fail "could not parse .NET time"-      where (s,m) = T.splitAt (T.length t - 5) t+    parseJSON = withText "DotNetTime" $ \t ->+        let (s,m) = T.splitAt (T.length t - 5) t             t'    = T.concat [s,".",m]-    parseJSON v   = typeMismatch "DotNetTime" v+        in case parseTime defaultTimeLocale "/Date(%s%Q)/" (unpack t') of+             Just d -> pure (DotNetTime d)+             _      -> fail "could not parse .NET time"     {-# INLINE parseJSON #-} +instance ToJSON ZonedTime where+    toJSON t = String $ pack $ formatTime defaultTimeLocale format t+      where+        format = "%FT%T" ++ milliseconds ++ tzFormat+        milliseconds = take 4 $ formatTime defaultTimeLocale "%Q" t+        tzFormat+          | 0 == timeZoneMinutes (zonedTimeZone t) = "Z"+          | otherwise = "%z"++instance FromJSON ZonedTime where+    parseJSON (String t) =+      tryFormats alternateFormats+      <|> fail "could not parse ECMA-262 ISO-8601 date"+      where+        tryFormat f =+          case parseTime defaultTimeLocale f (unpack t) of+            Just d -> pure d+            Nothing -> empty+        tryFormats = foldr1 (<|>) . map tryFormat+        alternateFormats =+          distributeList ["%Y", "%Y-%m", "%F"]+                         ["T%R", "T%T", "T%T%Q", "T%T%QZ", "T%T%Q%z"]++        distributeList xs ys =+          foldr (\x acc -> acc ++ distribute x ys) [] xs+        distribute x = map (mappend x)++    parseJSON v = typeMismatch "ZonedTime" v+ instance ToJSON UTCTime where     toJSON t = String (pack (take 23 str ++ "Z"))       where str = formatTime defaultTimeLocale "%FT%T%Q" t     {-# INLINE toJSON #-}  instance FromJSON UTCTime where-    parseJSON (String t) =+    parseJSON = withText "UTCTime" $ \t ->         case parseTime defaultTimeLocale "%FT%T%QZ" (unpack t) of           Just d -> pure d           _      -> fail "could not parse ISO-8601 date"-    parseJSON v   = typeMismatch "UTCTime" v     {-# INLINE parseJSON #-}  instance (ToJSON a, ToJSON b) => ToJSON (a,b) where@@ -633,14 +673,13 @@     {-# INLINE toJSON #-}  instance (FromJSON a, FromJSON b) => FromJSON (a,b) where-    parseJSON (Array ab)-        | n == 2    = (,) <$> parseJSON (V.unsafeIndex ab 0)-                          <*> parseJSON (V.unsafeIndex ab 1)-        | otherwise = fail $ "cannot unpack array of length " ++-                        show n ++ " into a pair"-          where-            n = V.length ab-    parseJSON v = typeMismatch "(a,b)" v+    parseJSON = withArray "(a,b)" $ \ab ->+        let n = V.length ab+        in if n == 2+             then (,) <$> parseJSON (V.unsafeIndex ab 0)+                      <*> parseJSON (V.unsafeIndex ab 1)+             else fail $ "cannot unpack array of length " +++                         show n ++ " into a pair"     {-# INLINE parseJSON #-}  instance (ToJSON a, ToJSON b, ToJSON c) => ToJSON (a,b,c) where@@ -653,15 +692,14 @@     {-# INLINE toJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c) => FromJSON (a,b,c) where-    parseJSON (Array abc)-        | n == 3    = (,,) <$> parseJSON (V.unsafeIndex abc 0)-                           <*> parseJSON (V.unsafeIndex abc 1)-                           <*> parseJSON (V.unsafeIndex abc 2)-        | otherwise = fail $ "cannot unpack array of length " ++-                        show n ++ " into a 3-tuple"-          where-            n = V.length abc-    parseJSON v = typeMismatch "(a,b,c)" v+    parseJSON = withArray "(a,b,c)" $ \abc ->+        let n = V.length abc+        in if n == 3+             then (,,) <$> parseJSON (V.unsafeIndex abc 0)+                       <*> parseJSON (V.unsafeIndex abc 1)+                       <*> parseJSON (V.unsafeIndex abc 2)+             else fail $ "cannot unpack array of length " +++                          show n ++ " into a 3-tuple"     {-# INLINE parseJSON #-}  instance (ToJSON a, ToJSON b, ToJSON c, ToJSON d) => ToJSON (a,b,c,d) where@@ -675,16 +713,15 @@     {-# INLINE toJSON #-}  instance (FromJSON a, FromJSON b, FromJSON c, FromJSON d) => FromJSON (a,b,c,d) where-    parseJSON (Array abcd)-        | n == 4    = (,,,) <$> parseJSON (V.unsafeIndex abcd 0)-                            <*> parseJSON (V.unsafeIndex abcd 1)-                            <*> parseJSON (V.unsafeIndex abcd 2)-                            <*> parseJSON (V.unsafeIndex abcd 3)-        | otherwise = fail $ "cannot unpack array of length " ++-                        show n ++ " into a 4-tuple"-          where-            n = V.length abcd-    parseJSON v = typeMismatch "(a,b,c,d)" v+    parseJSON = withArray "(a,b,c,d)" $ \abcd ->+        let n = V.length abcd+        in if n == 4+             then (,,,) <$> parseJSON (V.unsafeIndex abcd 0)+                        <*> parseJSON (V.unsafeIndex abcd 1)+                        <*> parseJSON (V.unsafeIndex abcd 2)+                        <*> parseJSON (V.unsafeIndex abcd 3)+             else fail $ "cannot unpack array of length " +++                         show n ++ " into a 4-tuple"     {-# INLINE parseJSON #-}  instance ToJSON a => ToJSON (Dual a) where@@ -711,6 +748,41 @@     parseJSON = fmap Last . parseJSON     {-# INLINE parseJSON #-} +-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@+--   and fails using @'typeMismatch' expected@ otherwise.+withObject :: String -> (Object -> Parser a) -> Value -> Parser a+withObject _        f (Object obj) = f obj+withObject expected _ v            = typeMismatch expected v+{-# INLINE withObject #-}++-- | @withObject expected f value@ applies @f@ to the 'Text' when @value@ is a @String@+--   and fails using @'typeMismatch' expected@ otherwise.+withText :: String -> (Text -> Parser a) -> Value -> Parser a+withText _        f (String txt) = f txt+withText expected _ v            = typeMismatch expected v+{-# INLINE withText #-}++-- | @withObject expected f value@ applies @f@ to the 'Array' when @value@ is an @Array@+--   and fails using @'typeMismatch' expected@ otherwise.+withArray :: String -> (Array -> Parser a) -> Value -> Parser a+withArray _        f (Array arr) = f arr+withArray expected _ v           = typeMismatch expected v+{-# INLINE withArray #-}++-- | @withObject expected f value@ applies @f@ to the 'Number' when @value@ is a @Number@+--   and fails using @'typeMismatch' expected@ otherwise.+withNumber :: String -> (Number -> Parser a) -> Value -> Parser a+withNumber _        f (Number num) = f num+withNumber expected _ v            = typeMismatch expected v+{-# INLINE withNumber #-}++-- | @withObject expected f value@ applies @f@ to the 'Bool' when @value@ is a @Bool@+--   and fails using @'typeMismatch' expected@ otherwise.+withBool :: String -> (Bool -> Parser a) -> Value -> Parser a+withBool _        f (Bool arr) = f arr+withBool expected _ v          = typeMismatch expected v+{-# INLINE withBool #-}+ -- | Construct a 'Pair' from a key and a value. (.=) :: ToJSON a => Text -> a -> Pair name .= value = (name, toJSON value)@@ -754,7 +826,7 @@ -- from an object without affecting its validity and we know a default -- value to assign in that case.  If the key and value are mandatory, -- use '(.:)' instead.--- +-- -- Example usage: -- -- @ v1 <- o '.:?' \"opt_field_with_dfl\" .!= \"default_val\"

@@ -6,7 +6,7 @@ -- | -- Module:      Data.Aeson.Types.Generic -- Copyright:   (c) 2012 Bryan O'Sullivan---              (c) 2011 Bas Van Dijk+--              (c) 2011, 2012 Bas Van Dijk --              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>

@@ -2,7 +2,7 @@  -- | -- Module:      Data.Aeson.Types.Internal--- Copyright:   (c) 2011 Bryan O'Sullivan+-- Copyright:   (c) 2011, 2012 Bryan O'Sullivan --              (c) 2011 MailRank, Inc. -- License:     Apache -- Maintainer:  Bryan O'Sullivan <bos@serpentine.com>@@ -177,12 +177,16 @@     {-# INLINE fromString #-}  instance Hashable Value where-    hash (Object o) = H.foldl' hashWithSalt 0 o-    hash (Array a)  = V.foldl' hashWithSalt 1 a-    hash (String s) = 2 `hashWithSalt` s-    hash (Number n) = 3 `hashWithSalt` case n of I i -> hash i; D d -> hash d-    hash (Bool b)   = 4 `hashWithSalt` b-    hash Null       = 5+    hashWithSalt s (Object o)   = H.foldl' hashWithSalt+                                  (s `hashWithSalt` (0::Int)) o+    hashWithSalt s (Array a)    = V.foldl' hashWithSalt+                                  (s `hashWithSalt` (1::Int)) a+    hashWithSalt s (String str) = s `hashWithSalt` (2::Int) `hashWithSalt` str+    hashWithSalt s (Number n)   = 3 `hashWithSalt`+                                  case n of I i -> hashWithSalt s i+                                            D d -> hashWithSalt s d+    hashWithSalt s (Bool b)   = s `hashWithSalt` (4::Int) `hashWithSalt` b+    hashWithSalt s Null       = s `hashWithSalt` (5::Int)  -- | The empty array. emptyArray :: Value

@@ -1,9 +1,9 @@ name:            aeson-version:         0.6.0.2+version:         0.6.1.0 license:         BSD3 license-file:    LICENSE category:        Text, Web, JSON-copyright:       (c) 2011 Bryan O'Sullivan+copyright:       (c) 2011, 2012 Bryan O'Sullivan                  (c) 2011 MailRank, Inc. author:          Bryan O'Sullivan <bos@serpentine.com> maintainer:      Bryan O'Sullivan <bos@serpentine.com>@@ -24,11 +24,6 @@     For release notes, see     <https://github.com/bos/aeson/blob/master/release-notes.markdown>     .-    /Note/: if you use GHCi or Template Haskell, please see the-    @README@ file for important details about building this package,-    and other packages that depend on it:-    <https://github.com/bos/aeson#readme>-    .     Parsing performance on a late 2010 MacBook Pro (2.66GHz Core i7),     for mostly-English tweets from Twitter's JSON search API:     .@@ -159,7 +154,8 @@     template-haskell,     test-framework,     test-framework-quickcheck2,-    text+    text,+    time  source-repository head   type:     git

@@ -1,3 +1,23 @@+# 0.6 series++Much improved documentation.++Angle brackets are now escaped in JSON strings, to help avoid XSS+attacks.++Fixed up handling of nullary constructors when using generic encoding.++Added ToJSON/FromJSON instances for:++* The `Fixed` class++* ISO-8601 dates: `UTCTime`, `ZonedTime`, and `TimeZone`++Added accessor functions for inspecting `Value`s.++Added `eitherDecode` function that returns an error message if+decoding fails.+ # 0.5 to 0.6  This release introduces a slightly obscure, but

@@ -1,5 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards,-    ScopedTypeVariables #-}+    ScopedTypeVariables, StandaloneDeriving #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  import Control.Monad@@ -12,12 +12,13 @@ import Data.Text (Text) import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty)-import Test.QuickCheck (Arbitrary(..))+import Test.QuickCheck (Arbitrary(..), choose, Gen) import qualified Data.Aeson.Generic as G import qualified Data.Attoparsec.Lazy as L import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Text as T import qualified Data.Map as Map+import Data.Time (ZonedTime(..), LocalTime(..), TimeZone(..), hoursToTimeZone, Day(..), TimeOfDay(..))  encodeDouble :: Double -> Double -> Bool encodeDouble num denom@@ -61,6 +62,9 @@                 Error _ -> False                 Success x' -> x == x' +regress_gh72 :: [(String, Maybe String)] -> Bool+regress_gh72 ys = G.decode (G.encode m) == Just m+    where m = Map.fromList ys  data Foo = Foo {       fooInt :: Int@@ -100,6 +104,17 @@ instance Arbitrary Foo where     arbitrary = liftM4 Foo arbitrary arbitrary arbitrary arbitrary +instance Arbitrary LocalTime where+    arbitrary = return $ LocalTime (ModifiedJulianDay 1) (TimeOfDay 1 2 3)++instance Arbitrary TimeZone where+    arbitrary = do+      offset <- choose (0,2) :: Gen Int+      return $ hoursToTimeZone offset++instance Arbitrary ZonedTime where+    arbitrary = liftM2 ZonedTime arbitrary arbitrary+ data UFoo = UFoo {       _UFooInt :: Int     , uFooInt :: Int@@ -112,8 +127,13 @@ main :: IO () main = defaultMain tests +deriving instance Eq ZonedTime+ tests :: [Test] tests = [+  testGroup "regression" [+      testProperty "gh-72" regress_gh72+  ],   testGroup "encode" [       testProperty "encodeDouble" encodeDouble     , testProperty "encodeInteger" encodeInteger@@ -138,6 +158,7 @@     , testProperty "String" $ roundTripEq (""::String)     , testProperty "Text" $ roundTripEq T.empty     , testProperty "Foo" $ roundTripEq (undefined::Foo)+    , testProperty "ZonedTime" $ roundTripEq (undefined::ZonedTime)     ],   testGroup "toFromJSON" [       testProperty "Integer" (toFromJSON :: Integer -> Bool)