f934e7a · typeable/aeson

git.iko.soy/typeable/aeson

Merge pull request #417 from phadej/dlist

Add DList instances and some roundtrip key tests

commitf934e7a369241716818d3f1fb83b86083c366542 authorAdam Bergmark <adam@bergmark.nl> dateWed 8 Jun 2016, 12:49 (10 years ago) parent0a03013 1cde7f1

6 files changed+76−3

compare with master

unifiedsplit

Data/Aeson/Types/FromJSON.hs+22−1 Data/Aeson/Types/ToJSON.hs+18 aeson.cabal+2 tests/Instances.hs+8−2 tests/Properties.hs+21 tests/UnitTests.hs+5

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

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

104104import Numeric.Natural (Natural)

105105import Text.ParserCombinators.ReadP (readP_to_S)

106106

107+import qualified Data.DList as DList

107108import qualified Data.HashMap.Strict as H

108109import qualified Data.HashSet as HashSet

109110import qualified Data.IntMap as IntMap

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

11461147 parseJSON = withScientific "Scientific" pure

11471148 {-# INLINE parseJSON #-}

11481149

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+

11491164-------------------------------------------------------------------------------

11501165-- containers

11511166-------------------------------------------------------------------------------

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

13731388instance FromJSONKey Text where

13741389 fromJSONKey = fromJSONKeyCoerce

13751390

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+

13761397instance FromJSONKey Int where

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

13781399 -- aeson for doing this.

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

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

13801401 Left err -> fail err

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

13821403 then return v

Data/Aeson/Types/ToJSON.hs+18

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

13681368 toEncoding = Encoding . EB.number

13691369 {-# INLINE toEncoding #-}

13701370

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+

13711389-------------------------------------------------------------------------------

13721390-- containers

13731391-------------------------------------------------------------------------------

aeson.cabal+2

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

148148 aeson,

149149 attoparsec,

150150 base,

151+ base-compat,

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

152153 bytestring,

153154 containers,

155+ dlist,

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

155157 ghc-prim >= 0.2,

156158 hashable >= 1.1.2.0,

tests/Instances.hs+8−2

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

88module Instances where

10+import Prelude ()

11+import Prelude.Compat

12+

1013import Types

1114import Data.Function (on)

1215import Control.Monad

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

1720import Data.List.NonEmpty (NonEmpty(..))

1821import Data.Version

1922import Data.Aeson.Types

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

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

2124import Data.Tagged (Tagged(..))

2225import Data.Proxy (Proxy(..))

23−import Control.Applicative

2426import Functions

27+import qualified Data.DList as DList

2528

2629import Data.Orphans ()

2730import Test.QuickCheck.Instances ()

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

171174

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

173176 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)

1010import Data.Aeson.Types

1111import Data.ByteString.Builder (toLazyByteString)

1212import 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)

1318import Data.List.NonEmpty (NonEmpty)

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

1520 ZonedTime)

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

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

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

6671

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+

6778infix 4 ==~

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

6980x ==~ y =

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

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

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

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

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

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

155168 , testGroup "ghcGenerics" [

156169 testProperty "OneConstructor" $ roundTripEq OneConstructor

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

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

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

160173 ]

161174 ]

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+ ]

162183 , testGroup "toFromJSON" [

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

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

tests/UnitTests.hs+5

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

3535import qualified Data.Text.Lazy as LT

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

3737

38+import qualified Data.Sequence as Seq

39+import qualified Data.DList as DList

40+

3841tests :: Test

3942tests = testGroup "unit" [

4043 testGroup "camelCase" [

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

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

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

242245 , 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)

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

244249 ]

245250