aeson 0.2.0.0 → 0.3.0.0

raw patch · 5 files changed

+210/−63 lines, 5 filesdep +bytestring-showdep +hashabledep +unordered-containersdep ~timePVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring-show, hashable, unordered-containers

Dependency ranges changed: time

API changes (from Hackage documentation)

Files

• Data/Aeson/Encode.hs +5/−3
• Data/Aeson/Functions.hs +40/−4
• Data/Aeson/Generic.hs +99/−32
• Data/Aeson/Types.hs +62/−23
• aeson.cabal +4/−1

@@ -18,19 +18,21 @@ import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char.Utf8 import Data.Aeson.Types (ToJSON(..), Value(..))+import Data.Attoparsec.Number (Number(..)) import Data.Monoid (mappend) import Numeric (showHex)-import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as L import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Vector as V+import qualified Text.Show.ByteString as S  -- | Encode a JSON value to a 'Builder'. fromValue :: Value -> Builder fromValue Null = fromByteString "null" fromValue (Bool b) = fromByteString $ if b then "true" else "false"-fromValue (Number n) = fromByteString (B.pack (show n))+fromValue (Number (I n)) = fromLazyByteString (S.show n)+fromValue (Number (D n)) = fromLazyByteString (S.show n) fromValue (String s) = string s fromValue (Array v)     | V.null v = fromByteString "[]"@@ -52,7 +54,7 @@   where     quote q = case T.uncons t of                 Just (c,t') -> fromText h `mappend` escape c `mappend` quote t'-                Nothing -> fromText h+                Nothing     -> fromText h         where (h,t) = T.break isEscape q     isEscape c = c == '\"' || c == '\\' || c < '\x20'     escape '\"' = fromByteString "\\\""

@@ -1,13 +1,49 @@ module Data.Aeson.Functions     (-      transformMap+      hashMap+    , mapHash+    , transformMap+    -- * String conversions+    , decode+    , strict+    , lazy     ) where -import Control.Arrow ((***))+import Control.Arrow ((***), first)+import Data.Hashable (Hashable)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as L+import qualified Data.HashMap.Strict as H import qualified Data.Map as M  -- | Transform one map into another.  The ordering of keys must be--- preserved.-transformMap :: (Ord k1, Ord k2) => (k1 -> k2) -> (v1 -> v2)+-- preserved by the key transformation function.+transformMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)              -> M.Map k1 v1 -> M.Map k2 v2 transformMap fk fv = M.fromAscList . map (fk *** fv) . M.toAscList+{-# INLINE transformMap #-}++-- | Transform a 'H.HashMap' into a 'M.Map'.+hashMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)+        -> H.HashMap k1 v1 -> M.Map k2 v2+hashMap fk kv = M.fromList . map (fk *** kv) . H.toList+{-# INLINE hashMap #-}++-- | Transform a 'M.Map' into a 'H.HashMap'.+mapHash :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.Map k1 v -> H.HashMap k2 v+mapHash fk = H.fromList . map (first fk) . M.toList+{-# INLINE mapHash #-}++strict :: L.ByteString -> Text+strict = decode . B.concat . L.toChunks+{-# INLINE strict #-}++lazy :: Text -> L.ByteString+lazy = L.fromChunks . (:[]) . encodeUtf8+{-# INLINE lazy #-}++decode :: B.ByteString -> Text+decode = decodeUtf8+{-# INLINE decode #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE PatternGuards, RankNTypes, ScopedTypeVariables  #-}  -- Module:      Data.Aeson.Generic -- Copyright:   (c) 2011 MailRank, Inc.@@ -22,22 +22,26 @@ import Control.Applicative ((<$>)) import Control.Arrow (first) import Control.Monad.State.Strict-import Data.Aeson.Functions (transformMap)+import Data.Aeson.Functions import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON) import Data.Attoparsec.Number (Number) import Data.Generics import Data.Int (Int8, Int16, Int32, Int64) import Data.IntSet (IntSet)+import Data.Maybe (fromJust) import Data.Text (Text, pack, unpack)+import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (UTCTime) import Data.Word (Word, Word8, Word16, Word32, Word64) import qualified Data.Aeson.Types as T import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L+import qualified Data.HashMap.Strict as H import qualified Data.Map as Map-import qualified Data.Traversable as T import qualified Data.Set as Set-import qualified Data.Text.Lazy as L+import qualified Data.Text as DT+import qualified Data.Text.Lazy as LT+import qualified Data.Traversable as T import qualified Data.Vector as V  type T a = a -> Value@@ -47,9 +51,8 @@          `ext1Q` list          `ext1Q` vector          `ext1Q` set-         `ext1Q` mapText-         `ext1Q` mapLazyText-         `ext1Q` mapString+         `ext2Q'` mapAny+         `ext2Q'` hashMapAny          -- Use the standard encoding for all base types.          `extQ` (T.toJSON :: T Integer)          `extQ` (T.toJSON :: T Int)@@ -68,7 +71,7 @@          `extQ` (T.toJSON :: T Rational)          `extQ` (T.toJSON :: T Char)          `extQ` (T.toJSON :: T Text)-         `extQ` (T.toJSON :: T L.Text)+         `extQ` (T.toJSON :: T LT.Text)          `extQ` (T.toJSON :: T String)          `extQ` (T.toJSON :: T B.ByteString)          `extQ` (T.toJSON :: T L.ByteString)@@ -83,10 +86,30 @@     list xs = Array . V.fromList . map toJSON $ xs     vector v = Array . V.map toJSON $ v     set s = Array . V.fromList . map toJSON . Set.toList $ s-    mapText m = Object . Map.map toJSON $ m-    mapLazyText m = Object . transformMap L.toStrict toJSON $ m-    mapString m = Object . transformMap pack toJSON $ m +    mapAny m+      | tyrep == typeOf DT.empty = remap id+      | tyrep == typeOf LT.empty = remap LT.toStrict+      | tyrep == typeOf ""       = remap pack+      | tyrep == typeOf B.empty  = remap decode+      | tyrep == typeOf L.empty  = remap strict+      | otherwise = modError "toJSON" $+                             "cannot convert map keyed by type " ++ show tyrep+      where tyrep = typeOf . head . Map.keys $ m+            remap f = Object . transformMap (f . fromJust . cast) toJSON $ m++    hashMapAny m+      | tyrep == typeOf DT.empty = remap id+      | tyrep == typeOf LT.empty = remap LT.toStrict+      | tyrep == typeOf ""       = remap pack+      | tyrep == typeOf B.empty  = remap decode+      | tyrep == typeOf L.empty  = remap strict+      | otherwise = modError "toJSON" $+                             "cannot convert map keyed by type " ++ show tyrep+      where tyrep = typeOf . head . H.keys $ m+            remap f = Object . hashMap (f . fromJust . cast) toJSON $ m++ toJSON_generic :: (Data a) => a -> Value toJSON_generic = generic   where@@ -104,8 +127,8 @@                 AlgRep _   -> encodeConstr (toConstr a) (gmapQ toJSON a)                 rep        -> err (dataTypeOf a) rep            where-              err dt r = error $ "Data.Aeson.Generic.toJSON: not AlgRep " ++-                                 show r ++ "(" ++ show dt ++ ")"+              err dt r = modError "toJSON" $ "not AlgRep " +++                                  show r ++ "(" ++ show dt ++ ")"         -- Encode nullary constructor as a string.         -- Encode non-nullary constructors as an object with the constructor         -- name as the single field and the arguments as the value.@@ -135,9 +158,8 @@ parseJSON j = parseJSON_generic j              `ext1R` list              `ext1R` vector-             `ext1R` mapText-             `ext1R` mapLazyText-             `ext1R` mapString+             `ext2R'` mapAny+             -- Don't know how to support parsing HashMaps :-(              -- Use the standard encoding for all base types.              `extR` (value :: F Integer)              `extR` (value :: F Int)@@ -156,7 +178,7 @@              `extR` (value :: F Rational)              `extR` (value :: F Char)              `extR` (value :: F Text)-             `extR` (value :: F L.Text)+             `extR` (value :: F LT.Text)              `extR` (value :: F String)              `extR` (value :: F B.ByteString)              `extR` (value :: F L.ByteString)@@ -174,15 +196,27 @@     vector :: (Data a) => Parser (V.Vector a)     vector = case j of                Array js -> V.mapM parseJSON js-               _        -> modFail "parseJSON" $ "bad data: " ++ show j-    mapText :: (Data a) => Parser (Map.Map Text a)-    mapText = case j of-                Object js -> T.mapM parseJSON js-                _         -> modFail "parseJSON" $ "bad data: " ++ show j-    mapLazyText :: (Data a) => Parser (Map.Map L.Text a)-    mapLazyText = Map.mapKeysMonotonic L.fromStrict <$> parseJSON j-    mapString :: (Data a) => Parser (Map.Map String a)-    mapString = Map.mapKeysMonotonic unpack <$> parseJSON j+               _        -> myFail+    mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)+    mapAny+        | tyrep `elem` stringyTypes = res+        | otherwise = myFail+      where res = case j of+                Object js -> Map.mapKeysMonotonic trans <$> T.mapM parseJSON js+                _         -> myFail+            trans+               | tyrep == typeOf DT.empty = remap id+               | tyrep == typeOf LT.empty = remap LT.fromStrict+               | tyrep == typeOf ""       = remap DT.unpack+               | tyrep == typeOf B.empty  = remap encodeUtf8+               | tyrep == typeOf L.empty  = remap lazy+               | otherwise = modError "parseJSON"+                                      "mapAny -- should never happen"+            tyrep = typeOf (undefined :: f)+            remap f = fromJust . cast . f+    myFail = modFail "parseJSON" $ "bad data: " ++ show j+    stringyTypes = [typeOf LT.empty, typeOf DT.empty, typeOf B.empty, +                    typeOf L.empty, typeOf ""]  parseJSON_generic :: (Data a) => Value -> Parser a parseJSON_generic j = generic@@ -190,7 +224,7 @@         typ = dataTypeOf $ resType generic         generic = case dataTypeRep typ of                     AlgRep []  -> case j of-                                    Null -> return (error "Empty type")+                                    Null -> return (modError "parseJSON" "empty type")                                     _ -> modFail "parseJSON" "no-constr bad data"                     AlgRep [_] -> decodeArgs (indexConstr typ 1) j                     AlgRep _   -> do (c, j') <- getConstr typ j; decodeArgs c j'@@ -202,10 +236,10 @@         getConstr t (String js) = do c <- readConstr' t (unpack js)                                      return (c, Null) -- handle nullary ctor         getConstr _ _ = modFail "parseJSON" "bad constructor encoding"-        readConstr' t s = -	  maybe (modFail "parseJSON" $ "unknown constructor: " ++ s ++ " " ++-                         show t) -	        return $ readConstr t s+        readConstr' t s =+          maybe (modFail "parseJSON" $ "unknown constructor: " ++ s ++ " " +++                         show t)+                return $ readConstr t s          decodeArgs c0 = go (numConstrArgs (resType generic) c0) c0                            (constrFields c0)@@ -243,7 +277,40 @@           where f = do modify (+1); return undefined          resType :: MonadPlus m => m a -> a-        resType _ = error "resType"+        resType _ = modError "parseJSON" "resType"  modFail :: (Monad m) => String -> String -> m a modFail func err = fail $ "Data.Aeson.Generic." ++ func ++ ": " ++ err++modError :: String -> String -> a+modError func err = error $ "Data.Aeson.Generic." ++ func ++ ": " ++ err+++-- Type extension for binary type constructors.++-- | Flexible type extension+ext2' :: (Data a, Typeable2 t)+     => c a+     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))+     -> c a+ext2' def ext = maybe def id (dataCast2 ext)++-- | Type extension of queries for type constructors+ext2Q' :: (Data d, Typeable2 t)+      => (d -> q)+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)+      -> d -> q+ext2Q' def ext = unQ ((Q def) `ext2'` (Q ext))++-- | Type extension of readers for type constructors+ext2R' :: (Monad m, Data d, Typeable2 t)+      => m d+      -> (forall d1 d2. (Data d1, Data d2) => m (t d1 d2))+      -> m d+ext2R' def ext = unR ((R def) `ext2'` (R ext))++-- | The type constructor for queries+newtype Q q x = Q { unQ :: x -> q }++-- | The type constructor for readers+newtype R m x = R { unR :: m x }

@@ -36,33 +36,34 @@     ) where  import Control.Applicative-import Control.Monad (MonadPlus(..))-import Data.Monoid (Monoid(..)) import Control.DeepSeq (NFData(..))+import Control.Monad (MonadPlus(..))+import Data.Aeson.Functions+import Data.Attoparsec.Char8 (Number(..)) import Data.Data (Data) import Data.Int (Int8, Int16, Int32, Int64)-import qualified Data.IntSet as IntSet import Data.Map (Map) import Data.Monoid (Dual(..), First(..), Last(..))+import Data.Monoid (Monoid(..)) import Data.Ratio (Ratio) import Data.String (IsString(..)) import Data.Text (Text, pack, unpack)-import Data.Text.Encoding (decodeUtf8, encodeUtf8)+import Data.Text.Encoding (encodeUtf8) import Data.Time.Clock (UTCTime) import Data.Time.Format (FormatTime, formatTime, parseTime)-import Data.Attoparsec.Char8 (Number(..)) import Data.Typeable (Typeable) import Data.Vector (Vector) import Data.Word (Word, Word8, Word16, Word32, Word64) import System.Locale (defaultTimeLocale) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB+import qualified Data.HashMap.Strict as H+import qualified Data.IntSet as IntSet import qualified Data.Map as M import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Lazy as LT import qualified Data.Vector as V-import Data.Aeson.Functions  -- | The result of running a 'Parser'. data Result a = Error String@@ -457,7 +458,7 @@     {-# INLINE parseJSON #-}  instance ToJSON B.ByteString where-    toJSON = String . decodeUtf8+    toJSON = String . decode     {-# INLINE toJSON #-}  instance FromJSON B.ByteString where@@ -466,11 +467,11 @@     {-# INLINE parseJSON #-}  instance ToJSON LB.ByteString where-    toJSON = toJSON . B.concat . LB.toChunks+    toJSON = toJSON . strict     {-# INLINE toJSON #-}  instance FromJSON LB.ByteString where-    parseJSON (String t) = pure . LB.fromChunks . (:[]) . encodeUtf8 $ t+    parseJSON (String t) = pure . lazy $ t     parseJSON _          = empty     {-# INLINE parseJSON #-} @@ -479,7 +480,7 @@     {-# INLINE toJSON #-}      instance (FromJSON a) => FromJSON [a] where-    parseJSON (Array a) = mapA parseJSON (V.toList a)+    parseJSON (Array a) = mapM parseJSON (V.toList a)     parseJSON _         = empty     {-# INLINE parseJSON #-} @@ -488,7 +489,7 @@     {-# INLINE toJSON #-}      instance (FromJSON a) => FromJSON (Vector a) where-    parseJSON (Array a) = V.fromList <$> mapA parseJSON (V.toList a)+    parseJSON (Array a) = V.mapM parseJSON a     parseJSON _         = empty     {-# INLINE parseJSON #-} @@ -513,10 +514,8 @@     {-# INLINE toJSON #-}  instance (FromJSON v) => FromJSON (M.Map Text v) where-    parseJSON (Object o) = M.fromAscList <$> go (M.toAscList o)-      where-        go ((k,v):kvs)  = ((:) . (,) k) <$> parseJSON v <*> go kvs-        go _            = pure []+    parseJSON (Object o) = M.fromAscList <$> mapM go (M.toAscList o)+      where go (k,v)     = ((,) k) <$> parseJSON v     parseJSON _          = empty  instance (ToJSON v) => ToJSON (M.Map LT.Text v) where@@ -531,6 +530,51 @@ instance (FromJSON v) => FromJSON (M.Map String v) where     parseJSON = fmap (M.mapKeysMonotonic unpack) . parseJSON +instance (ToJSON v) => ToJSON (M.Map B.ByteString v) where+    toJSON = Object . transformMap decode toJSON++instance (FromJSON v) => FromJSON (M.Map B.ByteString v) where+    parseJSON = fmap (M.mapKeysMonotonic encodeUtf8) . parseJSON++instance (ToJSON v) => ToJSON (M.Map LB.ByteString v) where+    toJSON = Object . transformMap strict toJSON++instance (FromJSON v) => FromJSON (M.Map LB.ByteString v) where+    parseJSON = fmap (M.mapKeysMonotonic lazy) . parseJSON++instance (ToJSON v) => ToJSON (H.HashMap Text v) where+    toJSON = Object . hashMap id toJSON+    {-# INLINE toJSON #-}++instance (FromJSON v) => FromJSON (H.HashMap Text v) where+    parseJSON (Object o) = H.fromList <$> mapM go (M.toList o)+      where go (k,v)     = ((,) k) <$> parseJSON v+    parseJSON _          = empty++instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where+    toJSON = Object . M.fromList . H.foldrWithKey (\k v -> ((LT.toStrict k,toJSON v) :)) []++instance (FromJSON v) => FromJSON (H.HashMap LT.Text v) where+    parseJSON = fmap (mapHash LT.fromStrict) . parseJSON++instance (ToJSON v) => ToJSON (H.HashMap String v) where+    toJSON = Object . hashMap pack toJSON++instance (FromJSON v) => FromJSON (H.HashMap String v) where+    parseJSON = fmap (mapHash unpack) . parseJSON++instance (ToJSON v) => ToJSON (H.HashMap B.ByteString v) where+    toJSON = Object . hashMap decode toJSON++instance (FromJSON v) => FromJSON (H.HashMap B.ByteString v) where+    parseJSON = fmap (mapHash encodeUtf8) . parseJSON++instance (ToJSON v) => ToJSON (H.HashMap LB.ByteString v) where+    toJSON = Object . hashMap strict toJSON++instance (FromJSON v) => FromJSON (H.HashMap LB.ByteString v) where+    parseJSON = fmap (mapHash lazy) . parseJSON+ instance ToJSON Value where     toJSON a = a     {-# INLINE toJSON #-}@@ -541,8 +585,9 @@  -- | A newtype wrapper for 'UTCTime' that uses the same non-standard -- serialization format as Microsoft .NET.-newtype DotNetTime = DotNetTime UTCTime-    deriving (Eq, Ord, Read, Show, Typeable, FormatTime)+newtype DotNetTime = DotNetTime {+      fromDotNetTime :: UTCTime+    } deriving (Eq, Ord, Read, Show, Typeable, FormatTime)  instance ToJSON DotNetTime where     toJSON (DotNetTime t) =@@ -603,9 +648,3 @@ instance FromJSON a => FromJSON (Last a) where     parseJSON = fmap Last . parseJSON     {-# INLINE parseJSON #-}--mapA :: (Alternative m) => (t -> m a) -> [t] -> m [a]-mapA f = go-  where-    go (a:as) = (:) <$> f a <*> go as-    go _      = pure []

@@ -1,5 +1,5 @@ name:            aeson-version:         0.2.0.0+version:         0.3.0.0 license:         BSD3 license-file:    LICENSE category:        Text, Web, JSON@@ -90,13 +90,16 @@     base == 4.*,     blaze-builder >= 0.2.1.4,     bytestring,+    bytestring-show,     containers,     deepseq,+    hashable,     monads-fd,     old-locale,     syb,     text >= 0.11.0.2,     time,+    unordered-containers >= 0.1.2.0,     vector >= 0.7    if flag(developer)