6143ec2 · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #367 from phadej/tagged

6143ec2Adam Bergmark11 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

@@ -75,8 +76,10 @@ import Data.List.NonEmpty (NonEmpty(..))

75import Data.Maybe (fromMaybe)

76import Data.Maybe (fromMaybe)

76import Data.Monoid ((<>))

77import Data.Monoid ((<>))

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

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

79+import Data.Proxy (Proxy(..))

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

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

79import Data.Scientific (Scientific)

81import Data.Scientific (Scientific)

82+import Data.Tagged (Tagged(..))

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

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

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

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

82 ZonedTime)

85 ZonedTime)

@@ -116,7 +119,6 @@ import qualified Data.Vector.Unboxed as VU

116#else

119#else

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

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

118import Data.Monoid (mempty)

121import Data.Monoid (mempty)

119−import Data.Traversable as Tr (traverse)

120import Data.Word (Word)

122import Data.Word (Word)

121#endif

123#endif

122

124

@@ -1543,6 +1545,40 @@ instance FromJSON Version where

1543 go (_ : xs) = go xs

1545 go (_ : xs) = go xs

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

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

1545

1547

1548+instance ToJSON (Proxy a) where

1549+ toJSON _ = Null

1550+ {-# INLINE toJSON #-}

1551+

1552+ toEncoding _ = Encoding E.null_

1553+ {-# INLINE toEncoding #-}

1554+

1555+instance FromJSON (Proxy a) where

1556+ {-# INLINE parseJSON #-}

1557+ parseJSON Null = pure Proxy

1558+ parseJSON v = typeMismatch "Proxy" v

1559+

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

1561+ toJSON (Tagged x) = toJSON x

1562+ {-# INLINE toJSON #-}

1563+

1564+ toEncoding (Tagged x) = toEncoding x

1565+ {-# INLINE toEncoding #-}

1566+

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

1568+ {-# INLINE parseJSON #-}

1569+ parseJSON = fmap Tagged . parseJSON

1570+

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

1572+ toJSON (Const x) = toJSON x

1573+ {-# INLINE toJSON #-}

1574+

1575+ toEncoding (Const x) = toEncoding x

1576+ {-# INLINE toEncoding #-}

1577+

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

1579+ {-# INLINE parseJSON #-}

1580+ parseJSON = fmap Const . parseJSON

1581+

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

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

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

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

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

1584withObject :: 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,

@@ -153,9 +154,11 @@ test-suite tests

153 aeson,

154 aeson,

154 attoparsec,

155 attoparsec,

155 base,

156 base,

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

156 bytestring,

158 bytestring,

157 containers,

159 containers,

158 ghc-prim >= 0.2,

160 ghc-prim >= 0.2,

161+ tagged,

159 template-haskell,

162 template-haskell,

160 test-framework,

163 test-framework,

161 test-framework-hunit,

164 test-framework-hunit,

tests/Instances.hs+13

@@ -17,9 +17,13 @@ import Data.Time (ZonedTime(..), TimeZone(..))

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

18import Data.Version

19import Data.Aeson.Types

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

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

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

20import Control.Applicative

23import Control.Applicative

21import Functions

24import Functions

26+import Data.Orphans ()

23import Test.QuickCheck.Instances ()

27import Test.QuickCheck.Instances ()

25#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)

29#if !MIN_VERSION_base(4,8,0) && !MIN_VERSION_QuickCheck(2,8,3)

@@ -158,3 +162,12 @@ makeVersion b = Version b []

158instance Arbitrary Natural where

162instance Arbitrary Natural where

159 arbitrary = fromInteger . abs <$> arbitrary

163 arbitrary = fromInteger . abs <$> arbitrary

160#endif

164#endif

165+

166+instance Arbitrary (Proxy a) where

167+ arbitrary = pure Proxy

168+

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

170+ arbitrary = Tagged <$> arbitrary

171+

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

173+ arbitrary = Const <$> arbitrary

tests/Properties.hs+7−1

@@ -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,10 +13,12 @@ import Data.Int (Int8)

12import Data.List.NonEmpty (NonEmpty)

13import Data.List.NonEmpty (NonEmpty)

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

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

14 ZonedTime)

15 ZonedTime)

16+import Data.Proxy (Proxy)

17+import Data.Tagged (Tagged)

15import Data.Version (Version)

18import Data.Version (Version)

16−import Numeric.Natural (Natural)

17import Encoders

19import Encoders

18import Instances ()

20import Instances ()

21+import Numeric.Natural (Natural)

19import Test.Framework (Test, testGroup)

22import Test.Framework (Test, testGroup)

20import Test.Framework.Providers.QuickCheck2 (testProperty)

23import Test.Framework.Providers.QuickCheck2 (testProperty)

21import Test.QuickCheck (Arbitrary(..), Property, (===), (.&&.), counterexample)

24import Test.QuickCheck (Arbitrary(..), Property, (===), (.&&.), counterexample)

@@ -143,6 +146,9 @@ tests = testGroup "properties" [

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

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

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

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

145 , testProperty "Natural" $ roundTripEq (undefined :: Natural)

148 , testProperty "Natural" $ roundTripEq (undefined :: Natural)

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

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

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

146 , testGroup "ghcGenerics" [

152 , testGroup "ghcGenerics" [

147 testProperty "OneConstructor" $ roundTripEq OneConstructor

153 testProperty "OneConstructor" $ roundTripEq OneConstructor

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

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

tests/UnitTests.hs+8−2

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

@@ -11,11 +12,13 @@ import Data.Aeson.Internal (JSONPathElement(..), formatError)

11import Data.Aeson.TH (deriveJSON)

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

14−import Data.Maybe (fromMaybe)

15import Data.List.NonEmpty (NonEmpty(..))

16+import Data.Maybe (fromMaybe)

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

18+import Data.Sequence (Seq)

19+import Data.Tagged (Tagged(..))

16import Data.Time (UTCTime)

20import Data.Time (UTCTime)

17import Data.Time.Format (parseTime)

21import Data.Time.Format (parseTime)

18−import Data.Sequence (Seq)

19import GHC.Generics (Generic)

22import GHC.Generics (Generic)

20import Test.Framework (Test, testGroup)

23import Test.Framework (Test, testGroup)

21import Test.Framework.Providers.HUnit (testCase)

24import Test.Framework.Providers.HUnit (testCase)

@@ -224,6 +227,9 @@ jsonEncoding = [

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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