Bryan O'Sullivan avatar Bryan O'Sullivan committed 0ec9cfb Merge

Merge

Comments (0)

Files changed (6)

 ^(?:dist|\.DS_Store)$
 ^benchmarks/(?:AesonParse|EncodeFile|JsonParse|.*_p)$
-.*\.(?:h[ip]|o|orig|out|pdf|prof|ps|rej)$
+.*\.(?:aux|h[ip]|o|orig|out|pdf|prof|ps|rej)$
 
 syntax: glob
 *~
 05d9437b2280648ae25ac170697ec1c48eda7af0 0.1.0.0
 f4cf6abd5a81affb08c6563d51e38ac4f8451217 0.2.0.0
+fe4084e5615941d9822834239e4c32a036291327 0.3.0.0

Data/Aeson/Functions.hs

       hashMap
     , mapHash
     , transformMap
+    -- * String conversions
+    , decode
+    , strict
+    , lazy
     ) where
 
 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
 
 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 #-}

Data/Aeson/Generic.hs

 import Control.Applicative ((<$>))
 import Control.Arrow (first)
 import Control.Monad.State.Strict
-import Data.Aeson.Functions (hashMap, transformMap)
+import Data.Aeson.Functions
 import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)
 import Data.Attoparsec.Number (Number)
 import Data.Generics
 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
     set s = Array . V.fromList . map toJSON . Set.toList $ s
 
     mapAny m
-      | tyrep == typeOf ""       = remap pack
       | 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 ""       = remap pack
       | 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
                _        -> myFail
     mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)
     mapAny
-        | tyrep `elem` [typeOf LT.empty, typeOf DT.empty, typeOf ""] = res
+        | 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 = fromJust . cast . id
-               | tyrep == typeOf LT.empty = fromJust . cast . LT.fromStrict
-               | tyrep == typeOf ""       = fromJust . cast . DT.unpack
+               | 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
     hashMapAny :: forall e f. (Data e, Data f) => Parser (H.HashMap f e)
     hashMapAny
         | tyrep == typeOf ""       = process DT.unpack
                         _          -> myFail
         tyrep = typeOf (undefined :: 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

Data/Aeson/Types.hs

 import Control.Applicative
 import Control.DeepSeq (NFData(..))
 import Control.Monad (MonadPlus(..))
-import Data.Aeson.Functions (hashMap, mapHash, transformMap)
+import Data.Aeson.Functions
 import Data.Attoparsec.Char8 (Number(..))
 import Data.Data (Data)
 import Data.Int (Int8, Int16, Int32, Int64)
 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.Typeable (Typeable)
     {-# INLINE parseJSON #-}
 
 instance ToJSON B.ByteString where
-    toJSON = String . decodeUtf8
+    toJSON = String . decode
     {-# INLINE toJSON #-}
 
 instance FromJSON B.ByteString where
     {-# 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 #-}
 
     {-# 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 #-}
 
     {-# 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 #-}
 
     {-# 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
 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 <$> go (M.toList o)
-      where
-        go ((k,v):kvs)   = ((:) . (,) k) <$> parseJSON v <*> go kvs
-        go _             = pure []
+    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
 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 #-}
 
 -- | 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) =
     {-# INLINE parseJSON #-}
 
 instance ToJSON UTCTime where
-    toJSON t = String (pack (formatTime defaultTimeLocale "%FT%X%QZ" t))
+    toJSON t = String (pack (take 23 str ++ "Z"))
+      where str = formatTime defaultTimeLocale "%FT%T%Q" t
     {-# INLINE toJSON #-}
 
 instance FromJSON UTCTime where
 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 []
 name:            aeson
-version:         0.2.0.0
+version:         0.3.0.0
 license:         BSD3
 license-file:    LICENSE
 category:        Text, Web, JSON
     syb,
     text >= 0.11.0.2,
     time,
-    unordered-containers,
+    unordered-containers >= 0.1.2.0,
     vector >= 0.7
 
   if flag(developer)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.