6143ec2 · typeable/aeson

git.iko.soy/typeable/aeson

Merge pull request #367 from phadej/tagged

commit6143ec2be51d691c185969a10979756e132e22cf authorAdam Bergmark <adam@bergmark.nl> dateTue 1 Mar 2016, 18:15 (11 years ago) parent9fb62b9 8c6a8cf

5 files changed+68−4

compare with master

unifiedsplit

Data/Aeson/Types/Instances.hs+37−1 aeson.cabal+3 tests/Instances.hs+13 tests/Properties.hs+7−1 tests/UnitTests.hs+8−2

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

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

6161 , typeMismatch

6262 ) where

6363

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

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

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

6667import Data.Aeson.Types.Class

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

7576import Data.Maybe (fromMaybe)

7677import Data.Monoid ((<>))

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

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

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

7981import Data.Scientific (Scientific)

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

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

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

8285 ZonedTime)

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

116119#else

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

118121import Data.Monoid (mempty)

119−import Data.Traversable as Tr (traverse)

120122import Data.Word (Word)

121123#endif

122124

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

15431545 go (_ : xs) = go xs

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

15451547

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+

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

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

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

aeson.cabal+3

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

100100 mtl,

101101 scientific >= 0.3.1 && < 0.4,

102102 syb,

103+ tagged >=0.8.3 && <0.9,

103104 template-haskell >= 2.7,

104105 text >= 1.1.1.0,

105106 transformers,

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

153154 aeson,

154155 attoparsec,

155156 base,

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

156158 bytestring,

157159 containers,

158160 ghc-prim >= 0.2,

161+ tagged,

159162 template-haskell,

160163 test-framework,

161164 test-framework-hunit,

tests/Instances.hs+13

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

1717import Data.List.NonEmpty (NonEmpty(..))

1818import Data.Version

1919import Data.Aeson.Types

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

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

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

2023import Control.Applicative

2124import Functions

2225

26+import Data.Orphans ()

2327import Test.QuickCheck.Instances ()

2428

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

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

158162instance Arbitrary Natural where

159163 arbitrary = fromInteger . abs <$> arbitrary

160164#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 @@

33module Properties where

5+import Control.Applicative (Const)

56import Data.Aeson (eitherDecode)

67import Data.Aeson.Encode (encode)

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

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

1213import Data.List.NonEmpty (NonEmpty)

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

1415 ZonedTime)

16+import Data.Proxy (Proxy)

17+import Data.Tagged (Tagged)

1518import Data.Version (Version)

16−import Numeric.Natural (Natural)

1719import Encoders

1820import Instances ()

21+import Numeric.Natural (Natural)

1922import Test.Framework (Test, testGroup)

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

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

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

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

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

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

146152 , testGroup "ghcGenerics" [

147153 testProperty "OneConstructor" $ roundTripEq OneConstructor

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

tests/UnitTests.hs+8−2

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

55module UnitTests (ioTests, tests) where

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

78import Control.Monad (forM)

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

910import Data.Aeson.Encode (encodeToTextBuilder)

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

1112import Data.Aeson.TH (deriveJSON)

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

1314import Data.Char (toUpper)

14−import Data.Maybe (fromMaybe)

1515import Data.List.NonEmpty (NonEmpty(..))

16+import Data.Maybe (fromMaybe)

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

18+import Data.Sequence (Seq)

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

1620import Data.Time (UTCTime)

1721import Data.Time.Format (parseTime)

18−import Data.Sequence (Seq)

1922import GHC.Generics (Generic)

2023import Test.Framework (Test, testGroup)

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

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

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

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

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

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

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

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