f934e7a · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #417 from phadej/dlist

f934e7aAdam Bergmark10 years ago

Data/Aeson/Types/FromJSON.hs+22−1

compare with master

unifiedsplit

@@ -104,6 +104,7 @@ import GHC.Generics

104import Numeric.Natural (Natural)

105import Text.ParserCombinators.ReadP (readP_to_S)

106

107+import qualified Data.DList as DList

107import qualified Data.HashMap.Strict as H

108import qualified Data.HashMap.Strict as H

108import qualified Data.HashSet as HashSet

109import qualified Data.HashSet as HashSet

109import qualified Data.IntMap as IntMap

110import qualified Data.IntMap as IntMap

@@ -1146,6 +1147,20 @@ instance FromJSON Scientific where

1146 parseJSON = withScientific "Scientific" pure

1147 parseJSON = withScientific "Scientific" pure

1147 {-# INLINE parseJSON #-}

1148 {-# INLINE parseJSON #-}

1148

1149

1150+-------------------------------------------------------------------------------

1151+-- DList

1152+-------------------------------------------------------------------------------

1153+

1154+instance FromJSON1 DList.DList where

1155+ liftParseJSON p _ = withArray "DList a" $

1156+ fmap DList.fromList .

1157+ Tr.sequence . zipWith (parseIndexedJSON p) [0..] . V.toList

1158+ {-# INLINE liftParseJSON #-}

1159+

1160+instance (FromJSON a) => FromJSON (DList.DList a) where

1161+ parseJSON = parseJSON1

1162+ {-# INLINE parseJSON #-}

1163+

1149-------------------------------------------------------------------------------

1164-------------------------------------------------------------------------------

1150-- containers

1165-- containers

1151-------------------------------------------------------------------------------

1166-------------------------------------------------------------------------------

@@ -1373,10 +1388,16 @@ instance FromJSONKey b => FromJSONKey (Tagged a b) where

1373instance FromJSONKey Text where

1388instance FromJSONKey Text where

1374 fromJSONKey = fromJSONKeyCoerce

1389 fromJSONKey = fromJSONKeyCoerce

1375

1390

1391+instance FromJSONKey Bool where

1392+ fromJSONKey = FromJSONKeyTextParser $ \t -> case t of

1393+ "true" -> pure True

1394+ "false" -> pure False

1395+ _ -> fail $ "Cannot parse key into Bool: " ++ T.unpack t

1396+

1376instance FromJSONKey Int where

1397instance FromJSONKey Int where

1377 -- not sure if there if there is already a helper in

1398 -- not sure if there if there is already a helper in

1378 -- aeson for doing this.

1399 -- aeson for doing this.

1379− fromJSONKey = FromJSONKeyTextParser $ \t -> case TR.decimal t of

1400+ fromJSONKey = FromJSONKeyTextParser $ \t -> case TR.signed TR.decimal t of

1380 Left err -> fail err

1401 Left err -> fail err

1381 Right (v,t2) -> if T.null t2

1402 Right (v,t2) -> if T.null t2

1382 then return v

1403 then return v

Data/Aeson/Types/ToJSON.hs+18

@@ -1368,6 +1368,24 @@ instance ToJSON Scientific where

1368 toEncoding = Encoding . EB.number

1369 {-# INLINE toEncoding #-}

1370

1371+-------------------------------------------------------------------------------

1372+-- DList

1373+-------------------------------------------------------------------------------

1374+

1375+instance ToJSON1 DList.DList where

1376+ liftToJSON t _ = listValue t . toList

1377+ {-# INLINE liftToJSON #-}

1378+

1379+ liftToEncoding t _ = listEncoding t . toList

1380+ {-# INLINE liftToEncoding #-}

1381+

1382+instance (ToJSON a) => ToJSON (DList.DList a) where

1383+ toJSON = toJSON1

1384+ {-# INLINE toJSON #-}

1385+

1386+ toEncoding = toEncoding1

1387+ {-# INLINE toEncoding #-}

1388+

1371-------------------------------------------------------------------------------

1389-------------------------------------------------------------------------------

1372-- containers

1390-- containers

1373-------------------------------------------------------------------------------

1391-------------------------------------------------------------------------------

aeson.cabal+2

@@ -148,9 +148,11 @@ test-suite tests

148 aeson,

149 attoparsec,

150 base,

151+ base-compat,

151 base-orphans >= 0.5.3 && <0.6,

152 base-orphans >= 0.5.3 && <0.6,

152 bytestring,

153 bytestring,

153 containers,

154 containers,

155+ dlist,

154 generic-deriving >= 1.10 && < 1.11,

156 generic-deriving >= 1.10 && < 1.11,

155 ghc-prim >= 0.2,

157 ghc-prim >= 0.2,

156 hashable >= 1.1.2.0,

158 hashable >= 1.1.2.0,

tests/Instances.hs+8−2

@@ -7,6 +7,9 @@

8module Instances where

10+import Prelude ()

11+import Prelude.Compat

12+

10import Types

13import Types

11import Data.Function (on)

14import Data.Function (on)

12import Control.Monad

15import Control.Monad

@@ -17,11 +20,11 @@ import Data.Time (ZonedTime(..), TimeZone(..))

17import Data.List.NonEmpty (NonEmpty(..))

20import Data.List.NonEmpty (NonEmpty(..))

18import Data.Version

21import Data.Version

19import Data.Aeson.Types

22import Data.Aeson.Types

20−import Control.Applicative (Const(..))

23+import Control.Applicative (Const(..), empty)

21import Data.Tagged (Tagged(..))

24import Data.Tagged (Tagged(..))

22import Data.Proxy (Proxy(..))

25import Data.Proxy (Proxy(..))

23−import Control.Applicative

24import Functions

26import Functions

27+import qualified Data.DList as DList

26import Data.Orphans ()

29import Data.Orphans ()

27import Test.QuickCheck.Instances ()

30import Test.QuickCheck.Instances ()

@@ -171,3 +174,6 @@ instance Arbitrary b => Arbitrary (Tagged a b) where

171

174

172instance Arbitrary a => Arbitrary (Const a b) where

175instance Arbitrary a => Arbitrary (Const a b) where

173 arbitrary = Const <$> arbitrary

176 arbitrary = Const <$> arbitrary

177+

178+instance Arbitrary a => Arbitrary (DList.DList a) where

179+ arbitrary = DList.fromList <$> arbitrary

tests/Properties.hs+21

@@ -10,6 +10,11 @@ import Data.Aeson.Parser (value)

10import Data.Aeson.Types

11import Data.ByteString.Builder (toLazyByteString)

12import Data.Int (Int8)

13+import Data.Sequence (Seq)

14+import Data.DList (DList)

15+import Data.Hashable (Hashable)

16+import Data.HashMap.Strict (HashMap)

17+import Data.Map (Map)

13import Data.List.NonEmpty (NonEmpty)

18import Data.List.NonEmpty (NonEmpty)

14import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,

19import Data.Time (Day, LocalTime, NominalDiffTime, TimeOfDay, UTCTime,

15 ZonedTime)

20 ZonedTime)

@@ -64,6 +69,12 @@ roundTripNoEnc eq _ i =

64roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property

69roundTripEq :: (Eq a, FromJSON a, ToJSON a, Show a) => a -> a -> Property

65roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y

70roundTripEq x y = roundTripEnc (===) x y .&&. roundTripNoEnc (===) x y

72+-- We test keys by encoding HashMap and Map with it

73+roundTripKey

74+ :: (Ord a, Hashable a, FromJSONKey a, ToJSONKey a, Show a)

75+ => a -> HashMap a Int -> Map a Int -> Property

76+roundTripKey _ h m = roundTripEq h h .&&. roundTripEq m m

77+

67infix 4 ==~

78infix 4 ==~

68(==~) :: (ApproxEq a, Show a) => a -> a -> Property

79(==~) :: (ApproxEq a, Show a) => a -> a -> Property

69x ==~ y =

80x ==~ y =

@@ -152,6 +163,8 @@ tests = testGroup "properties" [

152 , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)

163 , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)

153 , testProperty "Tagged" $ roundTripEq (undefined :: Tagged Int Char)

164 , testProperty "Tagged" $ roundTripEq (undefined :: Tagged Int Char)

154 , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)

165 , testProperty "Const" $ roundTripEq (undefined :: Const Int Char)

166+ , testProperty "DList" $ roundTripEq (undefined :: DList Int)

167+ , testProperty "Seq" $ roundTripEq (undefined :: Seq Int)

155 , testGroup "ghcGenerics" [

168 , testGroup "ghcGenerics" [

156 testProperty "OneConstructor" $ roundTripEq OneConstructor

169 testProperty "OneConstructor" $ roundTripEq OneConstructor

157 , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)

170 , testProperty "Product2" $ roundTripEq (undefined :: Product2 Int Bool)

@@ -159,6 +172,14 @@ tests = testGroup "properties" [

159 , testProperty "Sum4" $ roundTripEq (undefined :: S4)

172 , testProperty "Sum4" $ roundTripEq (undefined :: S4)

160 ]

173 ]

161 ]

174 ]

175+ , testGroup "roundTrip Key"

176+ [ testProperty "Bool" $ roundTripKey True

177+ , testProperty "Text" $ roundTripKey (undefined :: T.Text)

178+ , testProperty "String" $ roundTripKey (undefined :: String)

179+ , testProperty "Int" $ roundTripKey (undefined :: Int)

180+ , testProperty "[Text]" $ roundTripKey (undefined :: [T.Text])

181+ , testProperty "(Int,Char)" $ roundTripKey (undefined :: (Int,Char))

182+ ]

162 , testGroup "toFromJSON" [

183 , testGroup "toFromJSON" [

163 testProperty "Integer" (toFromJSON :: Integer -> Property)

184 testProperty "Integer" (toFromJSON :: Integer -> Property)

164 , testProperty "Double" (toFromJSON :: Double -> Property)

185 , testProperty "Double" (toFromJSON :: Double -> Property)

tests/UnitTests.hs+5

@@ -35,6 +35,9 @@ import qualified Data.Text.Lazy.Encoding as TLE

35import qualified Data.Text.Lazy as LT

36import qualified Data.Text.Lazy.Encoding as LT

38+import qualified Data.Sequence as Seq

39+import qualified Data.DList as DList

40+

38tests :: Test

41tests :: Test

39tests = testGroup "unit" [

42tests = testGroup "unit" [

40 testGroup "camelCase" [

43 testGroup "camelCase" [

@@ -240,6 +243,8 @@ jsonEncoding = [

240 , assertEqual "Const Char Int" "\"c\"" $ encode (Const 'c' :: Const Char Int)

243 , assertEqual "Const Char Int" "\"c\"" $ encode (Const 'c' :: Const Char Int)

241 , assertEqual "Tuple" "[1,2]" $ encode ((1, 2) :: (Int, Int))

244 , assertEqual "Tuple" "[1,2]" $ encode ((1, 2) :: (Int, Int))

242 , assertEqual "NonEmpty" "[1,2,3]" $ encode (1 :| [2, 3] :: NonEmpty Int)

245 , assertEqual "NonEmpty" "[1,2,3]" $ encode (1 :| [2, 3] :: NonEmpty Int)

246+ , assertEqual "Seq" "[1,2,3]" $ encode (Seq.fromList [1, 2, 3] :: Seq.Seq Int)

247+ , assertEqual "DList" "[1,2,3]" $ encode (DList.fromList [1, 2, 3] :: DList.DList Int)

243 , assertEqual "()" "[]" $ encode ()

248 , assertEqual "()" "[]" $ encode ()

244 ]

249 ]

245

250