diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +# 0.4.0.0 + +- `aeson-1` related changes: + - `SingObject` and `CollapsedList` changes + - deprecated `Map` module + # 0.3.2.0 - Add `Data.Aeson.Extra.Stream` with `streamDecode` diff --git a/aeson-extra.cabal b/aeson-extra.cabal --- a/aeson-extra.cabal +++ b/aeson-extra.cabal @@ -1,9 +1,5 @@ --- This file has been generated from package.yaml by hpack version 0.8.0. --- --- see: https://github.com/sol/hpack - name: aeson-extra -version: 0.3.2.0 +version: 0.4.0.0 synopsis: Extra goodies for aeson description: Package provides extra funcitonality on top of @aeson@ and @aeson-compat@ category: Web @@ -31,7 +27,7 @@ ghc-options: -Wall build-depends: base >=4.6 && <4.10 - , aeson >=0.7.0.6 && <0.12 + , aeson >=0.7.0.6 && <1.1 , aeson-compat >=0.3.0.0 && <0.4 , attoparsec >=0.11.3.4 && <0.14 , base-compat >=0.6.0 && <0.10 @@ -40,15 +36,18 @@ , exceptions >=0.8 && <0.9 , hashable >=1.2 && <1.3 , parsec >=3.1.9 && <3.2 - , recursion-schemes >=4.1.2 && <4.2 + , recursion-schemes >=4.1.2 && <5.1 , scientific >=0.3 && <0.4 - , template-haskell >=2.8 && <2.11 + , template-haskell >=2.8 && <2.12 , text >=1.2 && <1.3 , time >=1.4.2 && <1.7 , time-parsers >=0.1.0.0 && <0.2 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.12 - , transformers >=0.3 && <0.6 + if impl(ghc >= 7.8) + exposed-modules: + Data.Aeson.Extra.SingObject + Data.Aeson.Extra.SymTag exposed-modules: Data.Aeson.Extra Data.Aeson.Extra.CollapsedList @@ -59,11 +58,6 @@ Data.Aeson.Extra.Time Data.Aeson.Extra.TH - if impl(ghc >= 7.8) - exposed-modules: - Data.Aeson.Extra.SingObject - Data.Aeson.Extra.SymTag - default-language: Haskell2010 test-suite aeson-extra-test @@ -73,28 +67,18 @@ test ghc-options: -Wall build-depends: - base >=4.6 && <4.10 - , aeson >=0.7.0.6 && <0.12 - , aeson-compat >=0.3.0.0 && <0.4 - , base-compat >=0.6.0 && <0.10 - , bytestring >=0.10 && <0.11 - , containers >=0.5 && <0.6 - , exceptions >=0.8 && <0.9 - , hashable >=1.2 && <1.3 - , parsec >=3.1.9 && <3.2 - , scientific >=0.3 && <0.4 - , template-haskell >=2.8 && <2.11 - , text >=1.2 && <1.3 - , these >=0.6.2.0 && <0.8 - , time >=1.4.2 && <1.7 - , time-parsers >=0.1.0.0 && <0.2 - , unordered-containers >=0.2 && <0.3 - , vector >=0.10 && <0.12 - , aeson-extra - , tasty >=0.10 && <0.12 - , tasty-hunit >=0.9 && <0.10 - , tasty-quickcheck >=0.8 && <0.9 - , quickcheck-instances >=0.3 && <0.4 + base >=4.6 && <4.10 + , aeson-extra >=0.4 && <0.5 + , containers >=0.5 && <0.6 + , these >=0.6.2.0 && <0.8 + , time >=1.4.2 && <1.7 + , time-parsers >=0.1.0.0 && <0.2 + , unordered-containers >=0.2 && <0.3 + , vector >=0.10 && <0.12 + , tasty >=0.10 && <0.12 + , tasty-hunit >=0.9 && <0.10 + , tasty-quickcheck >=0.8 && <0.9 + , quickcheck-instances >=0.3 && <0.4 other-modules: Orphans default-language: Haskell2010 diff --git a/src/Data/Aeson/Extra.hs b/src/Data/Aeson/Extra.hs --- a/src/Data/Aeson/Extra.hs +++ b/src/Data/Aeson/Extra.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra diff --git a/src/Data/Aeson/Extra/CollapsedList.hs b/src/Data/Aeson/Extra/CollapsedList.hs --- a/src/Data/Aeson/Extra/CollapsedList.hs +++ b/src/Data/Aeson/Extra/CollapsedList.hs @@ -1,9 +1,9 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra.CollapsedList @@ -11,26 +11,27 @@ -- License : BSD3 -- Maintainer : Oleg Grenrus -- +-- Note: the contexts of functions are different with @aeson-1@. module Data.Aeson.Extra.CollapsedList ( CollapsedList(..), getCollapsedList, parseCollapsedList, )where -import Prelude () +import Prelude () import Prelude.Compat -import Control.Applicative (Alternative(..)) +import Control.Applicative (Alternative (..)) import Data.Aeson.Compat import Data.Aeson.Types hiding ((.:?)) import Data.Text (Text) #if __GLASGOW_HASKELL__ >= 708 -import Data.Typeable (Typeable) +import Data.Typeable (Typeable) #endif -import qualified Data.Foldable as Foldable -import qualified Data.HashMap.Strict as H +import qualified Data.Foldable as Foldable +import qualified Data.HashMap.Strict as H #if MIN_VERSION_aeson(0,10,0) import qualified Data.Text as T @@ -63,24 +64,74 @@ getCollapsedList :: CollapsedList f a -> f a getCollapsedList (CollapsedList l) = l +#if MIN_VERSION_aeson(1,0,0) +instance (FromJSON1 f, Alternative f) => FromJSON1 (CollapsedList f) where + liftParseJSON p _ v = CollapsedList <$> case v of + Null -> pure Control.Applicative.empty + Array _ -> liftParseJSON p (listParser p) v + x -> pure <$> p x + +instance (ToJSON1 f, Foldable f) => ToJSON1 (CollapsedList f) where + liftToEncoding to _ (CollapsedList l) = case l' of + [] -> toEncoding Null + [x] -> to x + _ -> liftToEncoding to (listEncoding to) l + where + l' = Foldable.toList l + + liftToJSON to _ (CollapsedList l) = case l' of + [] -> toJSON Null + [x] -> to x + _ -> liftToJSON to (listValue to) l + where + l' = Foldable.toList l + +instance (ToJSON1 f, Foldable f, ToJSON a) => ToJSON (CollapsedList f a) where + toJSON = toJSON1 + toEncoding = toEncoding1 + +instance (FromJSON1 f, Alternative f, FromJSON a) => FromJSON (CollapsedList f a) where + parseJSON = parseJSON1 + +-- | Parses possibly collapsed array value from the object's field. +-- +-- > λ > newtype V = V [Int] deriving (Show) +-- > λ > instance FromJSON V where parseJSON = withObject "V" $ \obj -> V <$> parseCollapsedList obj "value" +-- > λ > decode "{}" :: Maybe V +-- > Just (V []) +-- > λ > decode "{\"value\": null}" :: Maybe V +-- > Just (V []) +-- > λ > decode "{\"value\": 42}" :: Maybe V +-- > Just (V [42]) +-- > λ > decode "{\"value\": [1, 2, 3, 4]}" :: Maybe V +-- > Just (V [1,2,3,4]) +parseCollapsedList :: (FromJSON a, FromJSON1 f, Alternative f) => Object -> Text -> Parser (f a) +parseCollapsedList obj key = + case H.lookup key obj of + Nothing -> pure Control.Applicative.empty + Just v -> modifyFailure addKeyName $ (getCollapsedList <$> parseJSON v) -- Key key + where + addKeyName = (mappend ("failed to parse field " `mappend` T.unpack key `mappend`": ")) + +#else instance (FromJSON a, FromJSON (f a), Alternative f) => FromJSON (CollapsedList f a) where - parseJSON Null = pure (CollapsedList Control.Applicative.empty) - parseJSON v@(Array _) = CollapsedList <$> parseJSON v - parseJSON v = CollapsedList . pure <$> parseJSON v + parseJSON Null = pure (CollapsedList Control.Applicative.empty) + parseJSON v@(Array _) = CollapsedList <$> parseJSON v + parseJSON v = CollapsedList . pure <$> parseJSON v instance (ToJSON a, ToJSON (f a), Foldable f) => ToJSON (CollapsedList f a) where #if MIN_VERSION_aeson (0,10,0) - toEncoding (CollapsedList l) = - case Foldable.toList l of - [] -> toEncoding Null - [x] -> toEncoding x - _ -> toEncoding l + toEncoding (CollapsedList l) = + case Foldable.toList l of + [] -> toEncoding Null + [x] -> toEncoding x + _ -> toEncoding l #endif - toJSON (CollapsedList l) = - case Foldable.toList l of - [] -> toJSON Null - [x] -> toJSON x - _ -> toJSON l + toJSON (CollapsedList l) = + case Foldable.toList l of + [] -> toJSON Null + [x] -> toJSON x + _ -> toJSON l -- | Parses possibly collapsed array value from the object's field. -- @@ -96,12 +147,13 @@ -- > Just (V [1,2,3,4]) parseCollapsedList :: (FromJSON a, FromJSON (f a), Alternative f) => Object -> Text -> Parser (f a) parseCollapsedList obj key = - case H.lookup key obj of - Nothing -> pure Control.Applicative.empty + case H.lookup key obj of + Nothing -> pure Control.Applicative.empty #if MIN_VERSION_aeson(0,10,0) - Just v -> modifyFailure addKeyName $ (getCollapsedList <$> parseJSON v) -- Key key + Just v -> modifyFailure addKeyName $ (getCollapsedList <$> parseJSON v) -- Key key where addKeyName = (mappend ("failed to parse field " `mappend` T.unpack key `mappend`": ")) #else - Just v -> getCollapsedList <$> parseJSON v + Just v -> getCollapsedList <$> parseJSON v +#endif #endif diff --git a/src/Data/Aeson/Extra/Foldable.hs b/src/Data/Aeson/Extra/Foldable.hs --- a/src/Data/Aeson/Extra/Foldable.hs +++ b/src/Data/Aeson/Extra/Foldable.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, TypeFamilies, DeriveFoldable, DeriveTraversable #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | @@ -26,15 +31,19 @@ import Prelude.Compat import Data.Aeson.Compat +import Data.Data (Data) import Data.Functor.Foldable -import Data.HashMap.Strict (HashMap) -import Data.Data (Data) -import Data.Text (Text) -import Data.Scientific (Scientific) -import Data.Typeable (Typeable) -import Data.Vector (Vector) +import Data.HashMap.Strict (HashMap) +import Data.Scientific (Scientific) +import Data.Text (Text) +import Data.Typeable (Typeable) +import Data.Vector (Vector) +#if !(MIN_VERSION_recursion_schemes(5,0,0)) +#define Recursive F.Foldable +#define Corecursive F.Unfoldable import qualified Data.Functor.Foldable as F +#endif -- | A JSON \"object\" (key\/value map). -- @@ -60,7 +69,7 @@ type instance Base Value = ValueF -instance F.Foldable Value where +instance Recursive Value where project (Object o) = ObjectF o project (Array a) = ArrayF a project (String s) = StringF s @@ -68,7 +77,7 @@ project (Bool b) = BoolF b project Null = NullF -instance F.Unfoldable Value where +instance Corecursive Value where embed (ObjectF o) = Object o embed (ArrayF a) = Array a embed (StringF s) = String s diff --git a/src/Data/Aeson/Extra/Map.hs b/src/Data/Aeson/Extra/Map.hs --- a/src/Data/Aeson/Extra/Map.hs +++ b/src/Data/Aeson/Extra/Map.hs @@ -13,7 +13,7 @@ -- Maintainer : Oleg Grenrus -- -- More or less useful newtypes for writing 'FromJSON' & 'ToJSON' instances -module Data.Aeson.Extra.Map ( +module Data.Aeson.Extra.Map {-# DEPRECATED "Use aeson-1 TOJSONKey etc functionality" #-} ( M(..), FromJSONKey(..), parseIntegralJSONKey, @@ -25,8 +25,8 @@ import Prelude () import Prelude.Compat -import Data.Aeson.Compat -import Data.Aeson.Types hiding ((.:?)) +import Data.Aeson.Compat (ToJSON (..), FromJSON (..), Value (..), withObject) +import Data.Aeson.Types (Parser) import Data.Hashable (Hashable) import Data.Monoid ((<>)) import Data.Text (Text) @@ -44,6 +44,7 @@ -- > Just (M {getMap = fromList [(1,1),(2,2)]}) newtype M a = M { getMap :: a } deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, Typeable) +{-# DEPRECATED M "Use aeson-1 TOJSONKey etc functionality" #-} class FromJSONKey a where parseJSONKey :: Text -> Parser a diff --git a/src/Data/Aeson/Extra/SingObject.hs b/src/Data/Aeson/Extra/SingObject.hs --- a/src/Data/Aeson/Extra/SingObject.hs +++ b/src/Data/Aeson/Extra/SingObject.hs @@ -19,7 +19,7 @@ getSingObject, ) where -import Prelude () +import Prelude () import Prelude.Compat import Data.Aeson.Compat @@ -28,8 +28,16 @@ import Data.Typeable (Typeable) import GHC.TypeLits -import qualified Data.Text as T +import qualified Data.Text as T +#if MIN_VERSION_aeson(1,0,0) +import Data.Aeson.Internal (JSONPathElement (Key), ()) +import Data.Aeson.Encoding (pair) +import Data.Aeson.Types hiding ((.:?)) + +import qualified Data.HashMap.Strict as HM +#endif + -- | Singleton value object -- -- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int) @@ -48,6 +56,34 @@ getSingObject :: Proxy s -> SingObject s a -> a getSingObject _ (SingObject x) = x +#if MIN_VERSION_aeson(1,0,0) + +instance KnownSymbol s => FromJSON1 (SingObject s) where + liftParseJSON p _ = withObject ("SingObject "<> show key) $ \obj -> + case HM.lookup key obj of + Nothing -> fail $ "key " ++ show key ++ " not present" + Just v -> SingObject <$> p v Key key + where + key = T.pack $ symbolVal (Proxy :: Proxy s) + +instance KnownSymbol s => ToJSON1 (SingObject s) where + liftToJSON to _ (SingObject x) = + object [ key .= to x] + where + key = T.pack $ symbolVal (Proxy :: Proxy s) + liftToEncoding to _ (SingObject x) = + pairs $ pair key $ to x + where + key = T.pack $ symbolVal (Proxy :: Proxy s) + +instance (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where + parseJSON = parseJSON1 + +instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where + toJSON = toJSON1 + toEncoding = toEncoding1 + +#else instance (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where parseJSON = withObject ("SingObject "<> show key) $ \obj -> SingObject <$> obj .: T.pack key @@ -60,3 +96,4 @@ #endif toJSON (SingObject x) = object [T.pack key .= x] where key = symbolVal (Proxy :: Proxy s) +#endif diff --git a/src/Data/Aeson/Extra/TH.hs b/src/Data/Aeson/Extra/TH.hs --- a/src/Data/Aeson/Extra/TH.hs +++ b/src/Data/Aeson/Extra/TH.hs @@ -15,19 +15,26 @@ mkValue', ) where -import Control.Arrow (first) -import Data.Aeson.Compat -import Data.Scientific (scientific, coefficient, base10Exponent) -import Language.Haskell.TH -import Language.Haskell.TH.Syntax (Lift(..)) +import Data.Aeson.Compat +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import Language.Haskell.TH -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import qualified Data.Vector as V -import qualified Data.HashMap.Strict as HM +#if !MIN_VERSION_aeson_compat(0,3,5) +import Data.Aeson.Types (Parser) +#endif +#if !MIN_VERSION_aeson(0,11,0) +import Control.Arrow (first) +import qualified Data.HashMap.Strict as HM +import Data.Scientific + (base10Exponent, coefficient, scientific) +import qualified Data.Vector as V +import Language.Haskell.TH.Syntax (Lift (..)) +#endif + -- | Create a 'Value' from string representation. --- +-- -- This is useful in tests. -- -- /Since: aeson-extra-0.3.1.0/ diff --git a/src/Data/Aeson/Extra/Time.hs b/src/Data/Aeson/Extra/Time.hs --- a/src/Data/Aeson/Extra/Time.hs +++ b/src/Data/Aeson/Extra/Time.hs @@ -17,12 +17,16 @@ import Prelude.Compat import Data.Aeson.Compat -import Data.Aeson.Types hiding ((.:?)) -import Data.Text (Text) import Data.Time (UTCTime, ZonedTime) import Data.Typeable (Typeable) #if !MIN_VERSION_aeson (0,10,0) +import Data.Text (Text) + +#if !MIN_VERSION_aeson_compat(0,3,5) +import Data.Aeson.Types (Parser) +#endif + import qualified Data.Time.Parsers as TimeParsers import qualified Text.Parsec as Parsec #endif diff --git a/test/Orphans.hs b/test/Orphans.hs --- a/test/Orphans.hs +++ b/test/Orphans.hs @@ -6,10 +6,10 @@ import Control.Applicative #endif +#if !MIN_VERSION_quickcheck_instances(0,3,12) import Data.Vector as V import Test.Tasty.QuickCheck -#if !MIN_VERSION_quickcheck_instances(0,3,12) instance Arbitrary a => Arbitrary (Vector a) where arbitrary = V.fromList <$> arbitrary shrink = fmap V.fromList . shrink . V.toList diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} module Main (main) where #if !MIN_VERSION_base(4,8,0) @@ -164,8 +165,8 @@ , testCase "error begin" $ streamDecode' "[1,2,'a']" @?= ([1,2] :: [Int], True) ] - validTestCase name value = - testCase ("valid " ++ name) $ streamDecode (encode value) @?= (value, Nothing) + validTestCase name v = + testCase ("valid " ++ name) $ streamDecode (encode v) @?= (v, Nothing) streamDecode' = fmap isJust . streamDecode