8c6a8cf · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Add Proxy, Tagged and Const instances

8c6a8cfOleg Grenrus11 years ago

Data/Aeson/Types/Instances.hs+37−1

compare with master

unifiedsplit

@@ -61,6 +61,7 @@ module Data.Aeson.Types.Instances

61 , typeMismatch

62 ) where

64+import Control.Applicative (Const(..))

64import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, list)

65import Data.Aeson.Encode.Functions (brackets, builder, encode, foldable, list)

65import Data.Aeson.Functions (hashMapKey, mapHashKeyVal, mapKey, mapKeyVal)

66import Data.Aeson.Functions (hashMapKey, mapHashKeyVal, mapKey, mapKeyVal)

66import Data.Aeson.Types.Class

67import Data.Aeson.Types.Class

@@ -74,8 +75,10 @@ import Data.Int (Int8, Int16, Int32, Int64)

74import Data.Maybe (fromMaybe)

75import Data.Maybe (fromMaybe)

75import Data.Monoid ((<>))

76import Data.Monoid ((<>))

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

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

78+import Data.Proxy (Proxy(..))

77import Data.Ratio (Ratio, (%), numerator, denominator)

79import Data.Ratio (Ratio, (%), numerator, denominator)

78import Data.Scientific (Scientific)

80import Data.Scientific (Scientific)

81+import Data.Tagged (Tagged(..))

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

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

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

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

81 ZonedTime)

84 ZonedTime)

@@ -115,7 +118,6 @@ import Numeric.Natural

115#else

118#else

116import Control.Applicative ((<$>), (<*>), pure)

119import Control.Applicative ((<$>), (<*>), pure)

117import Data.Monoid (mempty)

120import Data.Monoid (mempty)

118−import Data.Traversable as Tr (traverse)

119import Data.Word (Word)

121import Data.Word (Word)

120#endif

122#endif

121

123

@@ -1530,6 +1532,40 @@ instance FromJSON Version where

1530 go (_ : xs) = go xs

1532 go (_ : xs) = go xs

1531 go _ = fail $ "could not parse Version"

1533 go _ = fail $ "could not parse Version"

1532

1534

1535+instance ToJSON (Proxy a) where

1536+ toJSON _ = Null

1537+ {-# INLINE toJSON #-}

1538+

1539+ toEncoding _ = Encoding E.null_

1540+ {-# INLINE toEncoding #-}

1541+

1542+instance FromJSON (Proxy a) where

1543+ {-# INLINE parseJSON #-}

1544+ parseJSON Null = pure Proxy

1545+ parseJSON v = typeMismatch "Proxy" v

1546+

1547+instance ToJSON b => ToJSON (Tagged a b) where

1548+ toJSON (Tagged x) = toJSON x

1549+ {-# INLINE toJSON #-}

1550+

1551+ toEncoding (Tagged x) = toEncoding x

1552+ {-# INLINE toEncoding #-}

1553+

1554+instance FromJSON b => FromJSON (Tagged a b) where

1555+ {-# INLINE parseJSON #-}

1556+ parseJSON = fmap Tagged . parseJSON

1557+

1558+instance ToJSON a => ToJSON (Const a b) where

1559+ toJSON (Const x) = toJSON x

1560+ {-# INLINE toJSON #-}

1561+

1562+ toEncoding (Const x) = toEncoding x

1563+ {-# INLINE toEncoding #-}

1564+

1565+instance FromJSON a => FromJSON (Const a b) where

1566+ {-# INLINE parseJSON #-}

1567+ parseJSON = fmap Const . parseJSON

1568+

1533-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@

1569-- | @withObject expected f value@ applies @f@ to the 'Object' when @value@ is an @Object@

1534-- and fails using @'typeMismatch' expected@ otherwise.

1570-- and fails using @'typeMismatch' expected@ otherwise.

1535withObject :: String -> (Object -> Parser a) -> Value -> Parser a

1571withObject :: String -> (Object -> Parser a) -> Value -> Parser a

aeson.cabal+3

@@ -100,6 +100,7 @@ library

100 mtl,

101 scientific >= 0.3.1 && < 0.4,

102 syb,

103+ tagged >=0.8.3 && <0.9,

103 template-haskell >= 2.7,

104 template-haskell >= 2.7,

104 text >= 1.1.1.0,

105 text >= 1.1.1.0,

105 transformers,

106 transformers,

@@ -149,9 +150,11 @@ test-suite tests

149 aeson,

150 aeson,

150 attoparsec,

151 attoparsec,

151 base,

152 base,

153+ base-orphans >=0.5.3 && <0.6,

152 bytestring,

154 bytestring,

153 containers,

155 containers,

154 ghc-prim >= 0.2,

156 ghc-prim >= 0.2,

157+ tagged,

155 template-haskell,

158 template-haskell,

156 test-framework,

159 test-framework,

157 test-framework-hunit,

160 test-framework-hunit,

tests/Instances.hs+13

@@ -16,9 +16,13 @@ import Data.Time.Clock (UTCTime(..))

16import Data.Time (ZonedTime(..), TimeZone(..))

17import Data.Version

18import Data.Aeson.Types

19+import Control.Applicative (Const(..))

20+import Data.Tagged (Tagged(..))

21+import Data.Proxy (Proxy(..))

19import Control.Applicative

22import Control.Applicative

20import Functions

23import Functions

25+import Data.Orphans ()

22import Test.QuickCheck.Instances ()

26import Test.QuickCheck.Instances ()

24-- "System" types.

28-- "System" types.

@@ -145,3 +149,12 @@ instance Arbitrary Version where

145makeVersion :: [Int] -> Version

149makeVersion :: [Int] -> Version

146makeVersion b = Version b []

150makeVersion b = Version b []

147#endif

151#endif

152+

153+instance Arbitrary (Proxy a) where

154+ arbitrary = pure Proxy

155+

156+instance Arbitrary b => Arbitrary (Tagged a b) where

157+ arbitrary = Tagged <$> arbitrary

158+

159+instance Arbitrary a => Arbitrary (Const a b) where

160+ arbitrary = Const <$> arbitrary

tests/Properties.hs+6

@@ -2,6 +2,7 @@

3module Properties where

5+import Control.Applicative (Const)

5import Data.Aeson (eitherDecode)

6import Data.Aeson (eitherDecode)

6import Data.Aeson.Encode (encode)

7import Data.Aeson.Encode (encode)

7import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)

8import Data.Aeson.Internal (IResult(..), formatError, ifromJSON, iparse)

@@ -12,6 +13,8 @@ import Data.Int (Int8)

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

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

13 ZonedTime)

14 ZonedTime)

14import Data.Version (Version)

15import Data.Version (Version)

16+import Data.Tagged (Tagged)

17+import Data.Proxy (Proxy)

15import Encoders

18import Encoders

16import Instances ()

19import Instances ()

17import Test.Framework (Test, testGroup)

20import Test.Framework (Test, testGroup)

@@ -139,6 +142,9 @@ tests = testGroup "properties" [

139 , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)

142 , testProperty "ZonedTime" $ roundTripEq (undefined :: ZonedTime)

140 , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)

143 , testProperty "NominalDiffTime" $ roundTripEq (undefined :: NominalDiffTime)

141 , testProperty "Version" $ roundTripEq (undefined :: Version)

144 , testProperty "Version" $ roundTripEq (undefined :: Version)

145+ , testProperty "Proxy" $ roundTripEq (undefined :: Proxy Int)

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

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

142 , testGroup "ghcGenerics" [

148 , testGroup "ghcGenerics" [

143 testProperty "OneConstructor" $ roundTripEq OneConstructor

149 testProperty "OneConstructor" $ roundTripEq OneConstructor

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

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

tests/UnitTests.hs+6

@@ -4,6 +4,7 @@

5module UnitTests (ioTests, tests) where

7+import Control.Applicative (Const(..))

7import Control.Monad (forM)

8import Control.Monad (forM)

8import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding, FromJSON(..), withObject, (.:), (.:?), (.:!))

9import Data.Aeson (decode, eitherDecode, encode, genericToJSON, genericToEncoding, FromJSON(..), withObject, (.:), (.:?), (.:!))

9import Data.Aeson.Encode (encodeToTextBuilder)

10import Data.Aeson.Encode (encodeToTextBuilder)

@@ -12,6 +13,8 @@ import Data.Aeson.TH (deriveJSON)

12import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)

13import Data.Aeson.Types (ToJSON(..), Value, camelTo, camelTo2, defaultOptions, omitNothingFields)

13import Data.Char (toUpper)

14import Data.Char (toUpper)

14import Data.Maybe (fromMaybe)

15import Data.Maybe (fromMaybe)

16+import Data.Tagged (Tagged(..))

17+import Data.Proxy (Proxy(..))

15import Data.Time (UTCTime)

18import Data.Time (UTCTime)

16import Data.Time.Format (parseTime)

19import Data.Time.Format (parseTime)

17import Data.Sequence (Seq)

20import Data.Sequence (Seq)

@@ -223,6 +226,9 @@ jsonEncoding = [

223 , assertEqual "Nothing" "null" $ encode (Nothing :: Maybe Int)

226 , assertEqual "Nothing" "null" $ encode (Nothing :: Maybe Int)

224 , assertEqual "Just" "1" $ encode (Just 1 :: Maybe Int)

227 , assertEqual "Just" "1" $ encode (Just 1 :: Maybe Int)

225 , assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))

228 , assertEqual "Just Nothing" "null" $ encode (Just Nothing :: Maybe (Maybe Int))

229+ , assertEqual "Proxy Int" "null" $ encode (Proxy :: Proxy Int)

230+ , assertEqual "Tagged Char Int" "1" $ encode (Tagged 1 :: Tagged Char Int)

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

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

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

227 ]

233 ]

228

234