Commits

Bryan O'Sullivan committed 7a5b6e1

Simplify and extend map support.

  • Participants
  • Parent commits 7917d7e

Comments (0)

Files changed (2)

File 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 #-}

File 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 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 (M.Map B.ByteString v) where
-    toJSON = Object . transformMap decode toJSON
+instance (ToJSON v) => ToJSON (H.HashMap B.ByteString v) where
+    toJSON = Object . hashMap decode toJSON
 
-instance (FromJSON v) => FromJSON (M.Map B.ByteString v) where
-    parseJSON = fmap (M.mapKeysMonotonic encodeUtf8) . parseJSON
+instance (FromJSON v) => FromJSON (H.HashMap B.ByteString v) where
+    parseJSON = fmap (mapHash encodeUtf8) . parseJSON
 
-instance (ToJSON v) => ToJSON (M.Map LB.ByteString v) where
-    toJSON = Object . transformMap strict toJSON
+instance (ToJSON v) => ToJSON (H.HashMap LB.ByteString v) where
+    toJSON = Object . hashMap strict toJSON
 
-instance (FromJSON v) => FromJSON (M.Map LB.ByteString v) where
-    parseJSON = fmap (M.mapKeysMonotonic lazy) . parseJSON
+instance (FromJSON v) => FromJSON (H.HashMap LB.ByteString v) where
+    parseJSON = fmap (mapHash lazy) . parseJSON
 
 instance ToJSON Value where
     toJSON a = a
 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 []
-
-strict :: LB.ByteString -> Text
-strict = decode . B.concat . LB.toChunks
-
-lazy :: Text -> LB.ByteString
-lazy = LB.fromChunks . (:[]) . encodeUtf8
-
-decode :: B.ByteString -> Text
-decode = decodeUtf8
-{-# INLINE decode #-}