8d734c1 · typeable/aeson

git.iko.soy/typeable/aeson

Merge

commit8d734c1892f1d6ca4df7c1a2f84629a4abf4fba7 authorBryan O'Sullivan <bos@mailrank.com> dateWed 9 Mar 2011, 12:18 (16 years ago) parente8199b8 17a613b

5 files changed+147−44

compare with master

unifiedsplit

Data/Aeson/Encode.hs+5−3 Data/Aeson/Functions.hs+20−4 Data/Aeson/Generic.hs+90−32 Data/Aeson/Types.hs+29−5 aeson.cabal+3

Data/Aeson/Encode.hs+5−3

@@ -18,19 +18,21 @@ module Data.Aeson.Encode

1818import Blaze.ByteString.Builder

1919import Blaze.ByteString.Builder.Char.Utf8

2020import Data.Aeson.Types (ToJSON(..), Value(..))

21+import Data.Attoparsec.Number (Number(..))

2122import Data.Monoid (mappend)

2223import Numeric (showHex)

23−import qualified Data.ByteString.Char8 as B

2424import qualified Data.ByteString.Lazy.Char8 as L

2525import qualified Data.Map as M

2626import qualified Data.Text as T

2727import qualified Data.Vector as V

28+import qualified Text.Show.ByteString as S

2829

2930-- | Encode a JSON value to a 'Builder'.

3031fromValue :: Value -> Builder

3132fromValue Null = fromByteString "null"

3233fromValue (Bool b) = fromByteString $ if b then "true" else "false"

33−fromValue (Number n) = fromByteString (B.pack (show n))

34+fromValue (Number (I n)) = fromLazyByteString (S.show n)

35+fromValue (Number (D n)) = fromLazyByteString (S.show n)

3436fromValue (String s) = string s

3537fromValue (Array v)

3638 | V.null v = fromByteString "[]"

@@ -52,7 +54,7 @@ string s = fromChar '"' `mappend` quote s `mappend` fromChar '"'

5254 where

5355 quote q = case T.uncons t of

5456 Just (c,t') -> fromText h `mappend` escape c `mappend` quote t'

55− Nothing -> fromText h

57+ Nothing -> fromText h

5658 where (h,t) = T.break isEscape q

5759 isEscape c = c == '\"' || c == '\\' || c < '\x20'

5860 escape '\"' = fromByteString "\\\""

Data/Aeson/Functions.hs+20−4

@@ -1,13 +1,29 @@

11module Data.Aeson.Functions

22 (

3− transformMap

3+ hashMap

4+ , mapHash

5+ , transformMap

46 ) where

6−import Control.Arrow ((***))

8+import Control.Arrow ((***), first)

9+import Data.Hashable (Hashable)

10+import qualified Data.HashMap.Strict as H

711import qualified Data.Map as M

812

913-- | Transform one map into another. The ordering of keys must be

10−-- preserved.

11−transformMap :: (Ord k1, Ord k2) => (k1 -> k2) -> (v1 -> v2)

14+-- preserved by the key transformation function.

15+transformMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)

1216 -> M.Map k1 v1 -> M.Map k2 v2

1317transformMap fk fv = M.fromAscList . map (fk *** fv) . M.toAscList

18+{-# INLINE transformMap #-}

19+

20+-- | Transform a 'H.HashMap' into a 'M.Map'.

21+hashMap :: (Ord k2) => (k1 -> k2) -> (v1 -> v2)

22+ -> H.HashMap k1 v1 -> M.Map k2 v2

23+hashMap fk kv = M.fromList . map (fk *** kv) . H.toList

24+{-# INLINE hashMap #-}

25+

26+-- | Transform a 'M.Map' into a 'H.HashMap'.

27+mapHash :: (Eq k2, Hashable k2) => (k1 -> k2) -> M.Map k1 v -> H.HashMap k2 v

28+mapHash fk = H.fromList . map (first fk) . M.toList

29+{-# INLINE mapHash #-}

Data/Aeson/Generic.hs+90−32

@@ -1,4 +1,4 @@

1−{-# LANGUAGE PatternGuards #-}

1+{-# LANGUAGE PatternGuards, RankNTypes, ScopedTypeVariables #-}

33-- Module: Data.Aeson.Generic

@@ -22,22 +22,25 @@ module Data.Aeson.Generic

2222import Control.Applicative ((<$>))

2323import Control.Arrow (first)

2424import Control.Monad.State.Strict

25−import Data.Aeson.Functions (transformMap)

25+import Data.Aeson.Functions (hashMap, transformMap)

2626import Data.Aeson.Types hiding (FromJSON(..), ToJSON(..), fromJSON)

2727import Data.Attoparsec.Number (Number)

2828import Data.Generics

2929import Data.Int (Int8, Int16, Int32, Int64)

3030import Data.IntSet (IntSet)

31+import Data.Maybe (fromJust)

3132import Data.Text (Text, pack, unpack)

3233import Data.Time.Clock (UTCTime)

3334import Data.Word (Word, Word8, Word16, Word32, Word64)

3435import qualified Data.Aeson.Types as T

3536import qualified Data.ByteString as B

3637import qualified Data.ByteString.Lazy as L

38+import qualified Data.HashMap.Strict as H

3739import qualified Data.Map as Map

38−import qualified Data.Traversable as T

3940import qualified Data.Set as Set

40−import qualified Data.Text.Lazy as L

41+import qualified Data.Text as DT

42+import qualified Data.Text.Lazy as LT

43+import qualified Data.Traversable as T

4144import qualified Data.Vector as V

4245

4346type T a = a -> Value

@@ -47,9 +50,8 @@ toJSON = toJSON_generic

4750 `ext1Q` list

4851 `ext1Q` vector

4952 `ext1Q` set

50− `ext1Q` mapText

51− `ext1Q` mapLazyText

52− `ext1Q` mapString

53+ `ext2Q'` mapAny

54+ `ext2Q'` hashMapAny

5355 -- Use the standard encoding for all base types.

5456 `extQ` (T.toJSON :: T Integer)

5557 `extQ` (T.toJSON :: T Int)

@@ -68,7 +70,7 @@ toJSON = toJSON_generic

6870 `extQ` (T.toJSON :: T Rational)

6971 `extQ` (T.toJSON :: T Char)

7072 `extQ` (T.toJSON :: T Text)

71− `extQ` (T.toJSON :: T L.Text)

73+ `extQ` (T.toJSON :: T LT.Text)

7274 `extQ` (T.toJSON :: T String)

7375 `extQ` (T.toJSON :: T B.ByteString)

7476 `extQ` (T.toJSON :: T L.ByteString)

@@ -83,9 +85,25 @@ toJSON = toJSON_generic

8385 list xs = Array . V.fromList . map toJSON $ xs

8486 vector v = Array . V.map toJSON $ v

8587 set s = Array . V.fromList . map toJSON . Set.toList $ s

86− mapText m = Object . Map.map toJSON $ m

87− mapLazyText m = Object . transformMap L.toStrict toJSON $ m

88− mapString m = Object . transformMap pack toJSON $ m

88+

89+ mapAny m

90+ | tyrep == typeOf "" = remap pack

91+ | tyrep == typeOf DT.empty = remap id

92+ | tyrep == typeOf LT.empty = remap LT.toStrict

93+ | otherwise = modError "toJSON" $

94+ "cannot convert map keyed by type " ++ show tyrep

95+ where tyrep = typeOf . head . Map.keys $ m

96+ remap f = Object . transformMap (f . fromJust . cast) toJSON $ m

97+

98+ hashMapAny m

99+ | tyrep == typeOf "" = remap pack

100+ | tyrep == typeOf DT.empty = remap id

101+ | tyrep == typeOf LT.empty = remap LT.toStrict

102+ | otherwise = modError "toJSON" $

103+ "cannot convert map keyed by type " ++ show tyrep

104+ where tyrep = typeOf . head . H.keys $ m

105+ remap f = Object . hashMap (f . fromJust . cast) toJSON $ m

106+

89107

90108toJSON_generic :: (Data a) => a -> Value

91109toJSON_generic = generic

@@ -104,8 +122,8 @@ toJSON_generic = generic

104122 AlgRep _ -> encodeConstr (toConstr a) (gmapQ toJSON a)

105123 rep -> err (dataTypeOf a) rep

106124 where

107− err dt r = error $ "Data.Aeson.Generic.toJSON: not AlgRep " ++

108− show r ++ "(" ++ show dt ++ ")"

125+ err dt r = modError "toJSON" $ "not AlgRep " ++

126+ show r ++ "(" ++ show dt ++ ")"

109127 -- Encode nullary constructor as a string.

110128 -- Encode non-nullary constructors as an object with the constructor

111129 -- name as the single field and the arguments as the value.

@@ -135,9 +153,8 @@ parseJSON :: (Data a) => Value -> Parser a

135153parseJSON j = parseJSON_generic j

136154 `ext1R` list

137155 `ext1R` vector

138− `ext1R` mapText

139− `ext1R` mapLazyText

140− `ext1R` mapString

156+ `ext2R'` mapAny

157+ -- Don't know how to support parsing HashMaps :-(

141158 -- Use the standard encoding for all base types.

142159 `extR` (value :: F Integer)

143160 `extR` (value :: F Int)

@@ -156,7 +173,7 @@ parseJSON j = parseJSON_generic j

156173 `extR` (value :: F Rational)

157174 `extR` (value :: F Char)

158175 `extR` (value :: F Text)

159− `extR` (value :: F L.Text)

176+ `extR` (value :: F LT.Text)

160177 `extR` (value :: F String)

161178 `extR` (value :: F B.ByteString)

162179 `extR` (value :: F L.ByteString)

@@ -174,15 +191,23 @@ parseJSON j = parseJSON_generic j

174191 vector :: (Data a) => Parser (V.Vector a)

175192 vector = case j of

176193 Array js -> V.mapM parseJSON js

177− _ -> modFail "parseJSON" $ "bad data: " ++ show j

178− mapText :: (Data a) => Parser (Map.Map Text a)

179− mapText = case j of

180− Object js -> T.mapM parseJSON js

181− _ -> modFail "parseJSON" $ "bad data: " ++ show j

182− mapLazyText :: (Data a) => Parser (Map.Map L.Text a)

183− mapLazyText = Map.mapKeysMonotonic L.fromStrict <$> parseJSON j

184− mapString :: (Data a) => Parser (Map.Map String a)

185− mapString = Map.mapKeysMonotonic unpack <$> parseJSON j

194+ _ -> myFail

195+ mapAny :: forall e f. (Data e, Data f) => Parser (Map.Map f e)

196+ mapAny

197+ | tyrep `elem` [typeOf LT.empty, typeOf DT.empty, typeOf ""] = res

198+ | otherwise = myFail

199+ where res = case j of

200+ Object js -> Map.mapKeysMonotonic trans <$> T.mapM parseJSON js

201+ _ -> myFail

202+ trans

203+ | tyrep == typeOf DT.empty = fromJust . cast . id

204+ | tyrep == typeOf LT.empty = fromJust . cast . LT.fromStrict

205+ | tyrep == typeOf "" = fromJust . cast . DT.unpack

206+ | otherwise = modError "parseJSON"

207+ "mapAny -- should never happen"

208+ tyrep = typeOf (undefined :: f)

209+ myFail = modFail "parseJSON" $ "bad data: " ++ show j

210+

186211

187212parseJSON_generic :: (Data a) => Value -> Parser a

188213parseJSON_generic j = generic

@@ -190,7 +215,7 @@ parseJSON_generic j = generic

190215 typ = dataTypeOf $ resType generic

191216 generic = case dataTypeRep typ of

192217 AlgRep [] -> case j of

193− Null -> return (error "Empty type")

218+ Null -> return (modError "parseJSON" "empty type")

194219 _ -> modFail "parseJSON" "no-constr bad data"

195220 AlgRep [_] -> decodeArgs (indexConstr typ 1) j

196221 AlgRep _ -> do (c, j') <- getConstr typ j; decodeArgs c j'

@@ -202,10 +227,10 @@ parseJSON_generic j = generic

202227 getConstr t (String js) = do c <- readConstr' t (unpack js)

203228 return (c, Null) -- handle nullary ctor

204229 getConstr _ _ = modFail "parseJSON" "bad constructor encoding"

205− readConstr' t s =

206− maybe (modFail "parseJSON" $ "unknown constructor: " ++ s ++ " " ++

207− show t)

208− return $ readConstr t s

230+ readConstr' t s =

231+ maybe (modFail "parseJSON" $ "unknown constructor: " ++ s ++ " " ++

232+ show t)

233+ return $ readConstr t s

209234

210235 decodeArgs c0 = go (numConstrArgs (resType generic) c0) c0

211236 (constrFields c0)

@@ -243,7 +268,40 @@ parseJSON_generic j = generic

243268 where f = do modify (+1); return undefined

244269

245270 resType :: MonadPlus m => m a -> a

246− resType _ = error "resType"

271+ resType _ = modError "parseJSON" "resType"

247272

248273modFail :: (Monad m) => String -> String -> m a

249274modFail func err = fail $ "Data.Aeson.Generic." ++ func ++ ": " ++ err

275+

276+modError :: String -> String -> a

277+modError func err = error $ "Data.Aeson.Generic." ++ func ++ ": " ++ err

278+

279+

280+-- Type extension for binary type constructors.

281+

282+-- | Flexible type extension

283+ext2' :: (Data a, Typeable2 t)

284+ => c a

285+ -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))

286+ -> c a

287+ext2' def ext = maybe def id (dataCast2 ext)

288+

289+-- | Type extension of queries for type constructors

290+ext2Q' :: (Data d, Typeable2 t)

291+ => (d -> q)

292+ -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)

293+ -> d -> q

294+ext2Q' def ext = unQ ((Q def) `ext2'` (Q ext))

295+

296+-- | Type extension of readers for type constructors

297+ext2R' :: (Monad m, Data d, Typeable2 t)

298+ => m d

299+ -> (forall d1 d2. (Data d1, Data d2) => m (t d1 d2))

300+ -> m d

301+ext2R' def ext = unR ((R def) `ext2'` (R ext))

302+

303+-- | The type constructor for queries

304+newtype Q q x = Q { unQ :: x -> q }

305+

306+-- | The type constructor for readers

307+newtype R m x = R { unR :: m x }

Data/Aeson/Types.hs+29−5

@@ -36,33 +36,34 @@ module Data.Aeson.Types

3636 ) where

3737

3838import Control.Applicative

39−import Control.Monad (MonadPlus(..))

40−import Data.Monoid (Monoid(..))

4139import Control.DeepSeq (NFData(..))

40+import Control.Monad (MonadPlus(..))

41+import Data.Aeson.Functions (hashMap, mapHash, transformMap)

42+import Data.Attoparsec.Char8 (Number(..))

4243import Data.Data (Data)

4344import Data.Int (Int8, Int16, Int32, Int64)

44−import qualified Data.IntSet as IntSet

4545import Data.Map (Map)

4646import Data.Monoid (Dual(..), First(..), Last(..))

47+import Data.Monoid (Monoid(..))

4748import Data.Ratio (Ratio)

4849import Data.String (IsString(..))

4950import Data.Text (Text, pack, unpack)

5051import Data.Text.Encoding (decodeUtf8, encodeUtf8)

5152import Data.Time.Clock (UTCTime)

5253import Data.Time.Format (FormatTime, formatTime, parseTime)

53−import Data.Attoparsec.Char8 (Number(..))

5454import Data.Typeable (Typeable)

5555import Data.Vector (Vector)

5656import Data.Word (Word, Word8, Word16, Word32, Word64)

5757import System.Locale (defaultTimeLocale)

5858import qualified Data.ByteString as B

5959import qualified Data.ByteString.Lazy as LB

60+import qualified Data.HashMap.Strict as H

61+import qualified Data.IntSet as IntSet

6062import qualified Data.Map as M

6163import qualified Data.Set as Set

6264import qualified Data.Text as T

6365import qualified Data.Text.Lazy as LT

6466import qualified Data.Vector as V

65−import Data.Aeson.Functions

6667

6768-- | The result of running a 'Parser'.

6869data Result a = Error String

@@ -531,6 +532,29 @@ instance (ToJSON v) => ToJSON (M.Map String v) where

531532instance (FromJSON v) => FromJSON (M.Map String v) where

532533 parseJSON = fmap (M.mapKeysMonotonic unpack) . parseJSON

533534

535+instance (ToJSON v) => ToJSON (H.HashMap Text v) where

536+ toJSON = Object . hashMap id toJSON

537+ {-# INLINE toJSON #-}

538+

539+instance (FromJSON v) => FromJSON (H.HashMap Text v) where

540+ parseJSON (Object o) = H.fromList <$> go (M.toList o)

541+ where

542+ go ((k,v):kvs) = ((:) . (,) k) <$> parseJSON v <*> go kvs

543+ go _ = pure []

544+ parseJSON _ = empty

545+

546+instance (ToJSON v) => ToJSON (H.HashMap LT.Text v) where

547+ toJSON = Object . M.fromList . H.foldrWithKey (\k v -> ((LT.toStrict k,toJSON v) :)) []

548+

549+instance (FromJSON v) => FromJSON (H.HashMap LT.Text v) where

550+ parseJSON = fmap (mapHash LT.fromStrict) . parseJSON

551+

552+instance (ToJSON v) => ToJSON (H.HashMap String v) where

553+ toJSON = Object . hashMap pack toJSON

554+

555+instance (FromJSON v) => FromJSON (H.HashMap String v) where

556+ parseJSON = fmap (mapHash unpack) . parseJSON

557+

534558instance (ToJSON v) => ToJSON (M.Map B.ByteString v) where

535559 toJSON = Object . transformMap decode toJSON

536560

aeson.cabal+3

@@ -90,13 +90,16 @@ library

9090 base == 4.*,

9191 blaze-builder >= 0.2.1.4,

9292 bytestring,

93+ bytestring-show,

9394 containers,

9495 deepseq,

96+ hashable,

9597 monads-fd,

9698 old-locale,

9799 syb,

98100 text >= 0.11.0.2,

99101 time,

102+ unordered-containers,

100103 vector >= 0.7

101104

102105 if flag(developer)