8c6a8cf · typeable/aeson

git.iko.soy/typeable/aeson

Add Proxy, Tagged and Const instances

commit8c6a8cf8034771e656186392bc6cf8228415a5ca authorOleg Grenrus <oleg.grenrus@iki.fi> dateTue 1 Mar 2016, 09:16 (11 years ago) parent692d3dd

5 files changed+65−1

compare with master

unifiedsplit

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

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

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

7475import Data.Maybe (fromMaybe)

7576import Data.Monoid ((<>))

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

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

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

7880import Data.Scientific (Scientific)

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

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

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

8184 ZonedTime)

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

115118#else

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

117120import Data.Monoid (mempty)

118−import Data.Traversable as Tr (traverse)

119121import Data.Word (Word)

120122#endif

121123

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

15301532 go (_ : xs) = go xs

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

15321534

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+

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

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

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

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

149150 aeson,

150151 attoparsec,

151152 base,

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

152154 bytestring,

153155 containers,

154156 ghc-prim >= 0.2,

157+ tagged,

155158 template-haskell,

156159 test-framework,

157160 test-framework-hunit,

tests/Instances.hs+13

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

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

1717import Data.Version

1818import Data.Aeson.Types

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

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

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

1922import Control.Applicative

2023import Functions

2124

25+import Data.Orphans ()

2226import Test.QuickCheck.Instances ()

2327

2428-- "System" types.

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

145149makeVersion :: [Int] -> Version

146150makeVersion b = Version b []

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

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

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

1314 ZonedTime)

1415import Data.Version (Version)

16+import Data.Tagged (Tagged)

17+import Data.Proxy (Proxy)

1518import Encoders

1619import Instances ()

1720import Test.Framework (Test, testGroup)

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

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

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

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

142148 , testGroup "ghcGenerics" [

143149 testProperty "OneConstructor" $ roundTripEq OneConstructor

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

tests/UnitTests.hs+6

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

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

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

1314import Data.Char (toUpper)

1415import Data.Maybe (fromMaybe)

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

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

1518import Data.Time (UTCTime)

1619import Data.Time.Format (parseTime)

1720import Data.Sequence (Seq)

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

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

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

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

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

227233 ]

228234