diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,10 @@ +# 0.4.1.0 (2017-07-24) + +- GHC-8.2 support +- add `NFData SingObject` and `NFData SymTag` instances +- add `lodashMerge` +- rename `Foldable` to `Recursive` (the old module is still there). + # 0.4.0.0 - `aeson-1` related changes: diff --git a/aeson-extra.cabal b/aeson-extra.cabal --- a/aeson-extra.cabal +++ b/aeson-extra.cabal @@ -1,5 +1,5 @@ name: aeson-extra -version: 0.4.0.0 +version: 0.4.1.0 synopsis: Extra goodies for aeson description: Package provides extra funcitonality on top of @aeson@ and @aeson-compat@ category: Web @@ -9,7 +9,7 @@ maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE -tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 +tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1 build-type: Simple cabal-version: >= 1.10 @@ -26,24 +26,26 @@ src ghc-options: -Wall build-depends: - base >=4.6 && <4.10 - , aeson >=0.7.0.6 && <1.1 + base >=4.6 && <4.11 + , aeson >=0.7.0.6 && <1.3 , aeson-compat >=0.3.0.0 && <0.4 , attoparsec >=0.11.3.4 && <0.14 - , base-compat >=0.6.0 && <0.10 + , attoparsec-iso8601 >=1.0 && <1.1 + , base-compat >=0.6.0 && <0.10 , bytestring >=0.10 && <0.11 , containers >=0.5 && <0.6 + , deepseq >=1.3 && <1.5 , exceptions >=0.8 && <0.9 , hashable >=1.2 && <1.3 , parsec >=3.1.9 && <3.2 , recursion-schemes >=4.1.2 && <5.1 , scientific >=0.3 && <0.4 - , template-haskell >=2.8 && <2.12 + , template-haskell >=2.8 && <2.13 , text >=1.2 && <1.3 - , time >=1.4.2 && <1.7 - , time-parsers >=0.1.0.0 && <0.2 + , these >=0.7.4 && <0.8 + , time >=1.4.0.1 && <1.9 , unordered-containers >=0.2 && <0.3 - , vector >=0.10 && <0.12 + , vector >=0.10 && <0.13 if impl(ghc >= 7.8) exposed-modules: Data.Aeson.Extra.SingObject @@ -54,9 +56,10 @@ Data.Aeson.Extra.Foldable Data.Aeson.Extra.Map Data.Aeson.Extra.Merge + Data.Aeson.Extra.Recursive Data.Aeson.Extra.Stream - Data.Aeson.Extra.Time Data.Aeson.Extra.TH + Data.Aeson.Extra.Time default-language: Haskell2010 @@ -67,17 +70,17 @@ test ghc-options: -Wall build-depends: - 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 + base + , aeson-extra + , containers + , these + , time + , unordered-containers + , vector , 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 + , tasty-quickcheck >=0.8 && <0.10 , quickcheck-instances >=0.3 && <0.4 other-modules: Orphans 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 @@ -39,6 +39,7 @@ ArrayF, -- * Merge merge, + lodashMerge, -- * Stream streamDecode, -- * Template Haskell @@ -57,7 +58,7 @@ import qualified Data.ByteString.Lazy as LBS import Data.Aeson.Extra.CollapsedList -import Data.Aeson.Extra.Foldable +import Data.Aeson.Extra.Recursive import Data.Aeson.Extra.Map import Data.Aeson.Extra.Merge import Data.Aeson.Extra.Stream 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,86 +1,5 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveFoldable #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveTraversable #-} -{-# LANGUAGE TypeFamilies #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} ------------------------------------------------------------------------------ --- | --- Module : Data.Aeson.Extra.Foldable --- Copyright : (C) 2015-2016 Oleg Grenrus --- License : BSD3 --- Maintainer : Oleg Grenrus --- --- Helps writing recursive algorithms on 'Value', for example: --- --- @ --- stripNulls :: Value -> Value --- stripNulls = 'cata' ('embed' . f) --- where --- f (ObjectF a) = ObjectF $ HM.filter (== Null) a --- f x = x --- @ -module Data.Aeson.Extra.Foldable ( - ValueF(..), - ObjectF, - ArrayF, - ) where - -import Prelude () -import Prelude.Compat - -import Data.Aeson.Compat -import Data.Data (Data) -import Data.Functor.Foldable -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). --- --- /Since: aeson-extra-0.3.1.0/ -type ObjectF a = HashMap Text a - --- | A JSON \"array\" (sequence). --- --- /Since: aeson-extra-0.3.1.0/ -type ArrayF a = Vector a - --- | An algebra of 'Value' --- --- /Since: aeson-extra-0.3.1.0/ -data ValueF a - = ObjectF (ObjectF a) - | ArrayF !(ArrayF a) - | StringF !Text - | NumberF !Scientific - | BoolF !Bool - | NullF - deriving (Eq, Read, Show, Typeable, Data, Functor, Prelude.Compat.Foldable, Traversable) - -type instance Base Value = ValueF - -instance Recursive Value where - project (Object o) = ObjectF o - project (Array a) = ArrayF a - project (String s) = StringF s - project (Number n) = NumberF n - project (Bool b) = BoolF b - project Null = NullF +module Data.Aeson.Extra.Foldable + {-# DEPRECATED "Use Data.Aeson.Extra.Recursive module" #-} + (module Data.Aeson.Extra.Recursive) where -instance Corecursive Value where - embed (ObjectF o) = Object o - embed (ArrayF a) = Array a - embed (StringF s) = String s - embed (NumberF n) = Number n - embed (BoolF b) = Bool b - embed NullF = Null +import Data.Aeson.Extra.Recursive diff --git a/src/Data/Aeson/Extra/Merge.hs b/src/Data/Aeson/Extra/Merge.hs --- a/src/Data/Aeson/Extra/Merge.hs +++ b/src/Data/Aeson/Extra/Merge.hs @@ -9,6 +9,7 @@ module Data.Aeson.Extra.Merge ( merge, mergeA, + lodashMerge, ValueF(..), ObjectF, ArrayF, @@ -18,26 +19,14 @@ import Prelude.Compat import Data.Aeson.Compat -import Data.Aeson.Extra.Foldable +import Data.Aeson.Extra.Recursive +import Data.These (These (..)) +import Data.Align (alignWith) import Data.Functor.Foldable (project, embed) -- | Generic merge. -- --- For example : --- --- @ --- lodashMerge :: Value -> Value -> Value --- lodashMerge x y = merge lodashMergeAlg x y --- --- lodashMergeAlg :: (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a --- lodashMergeAlg r a' b' = case (a', b') of --- (ObjectF a, ObjectF b) -> ObjectF $ alignWith f a b --- (ArrayF a, ArrayF b) -> ArrayF $ alignWith f a b --- (_, b) -> b --- where f (These x y) = r x y --- f (This x) = x --- f (That x) = x --- @ +-- For example see 'lodashMerge'. -- -- /Since: aeson-extra-0.3.1.0/ merge :: (forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a) @@ -51,3 +40,21 @@ => (forall a. (a -> a -> f a) -> ValueF a -> ValueF a -> f (ValueF a)) -> Value -> Value -> f Value mergeA f a b = embed <$> f (mergeA f) (project a) (project b) + +-- | Example of using 'merge'. see : +-- +-- /Note:/ not tested against JavaScript lodash, so may disagree in the results. +-- +-- @since 0.4.1.0 +lodashMerge :: Value -> Value -> Value +lodashMerge = merge alg + where + alg :: (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a + alg r a' b' = case (a', b') of + (ObjectF a, ObjectF b) -> ObjectF $ alignWith f a b + (ArrayF a, ArrayF b) -> ArrayF $ alignWith f a b + (_, b) -> b + where + f (These x y) = r x y + f (This x) = x + f (That x) = x diff --git a/src/Data/Aeson/Extra/Recursive.hs b/src/Data/Aeson/Extra/Recursive.hs new file mode 100644 --- /dev/null +++ b/src/Data/Aeson/Extra/Recursive.hs @@ -0,0 +1,86 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +----------------------------------------------------------------------------- +-- | +-- Module : Data.Aeson.Extra.Recursive +-- Copyright : (C) 2015-2017 Oleg Grenrus +-- License : BSD3 +-- Maintainer : Oleg Grenrus +-- +-- Helps writing recursive algorithms on 'Value', for example: +-- +-- @ +-- stripNulls :: Value -> Value +-- stripNulls = 'cata' ('embed' . f) +-- where +-- f (ObjectF a) = ObjectF $ HM.filter (== Null) a +-- f x = x +-- @ +module Data.Aeson.Extra.Recursive ( + ValueF(..), + ObjectF, + ArrayF, + ) where + +import Prelude () +import Prelude.Compat + +import Data.Aeson.Compat +import Data.Data (Data) +import Data.Functor.Foldable +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). +-- +-- /Since: aeson-extra-0.3.1.0/ +type ObjectF a = HashMap Text a + +-- | A JSON \"array\" (sequence). +-- +-- /Since: aeson-extra-0.3.1.0/ +type ArrayF a = Vector a + +-- | An algebra of 'Value' +-- +-- /Since: aeson-extra-0.3.1.0/ +data ValueF a + = ObjectF (ObjectF a) + | ArrayF !(ArrayF a) + | StringF !Text + | NumberF !Scientific + | BoolF !Bool + | NullF + deriving (Eq, Read, Show, Typeable, Data, Functor, Prelude.Compat.Foldable, Traversable) + +type instance Base Value = ValueF + +instance Recursive Value where + project (Object o) = ObjectF o + project (Array a) = ArrayF a + project (String s) = StringF s + project (Number n) = NumberF n + project (Bool b) = BoolF b + project Null = NullF + +instance Corecursive Value where + embed (ObjectF o) = Object o + embed (ArrayF a) = Array a + embed (StringF s) = String s + embed (NumberF n) = Number n + embed (BoolF b) = Bool b + embed NullF = Null 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 @@ -22,6 +22,7 @@ import Prelude () import Prelude.Compat +import Control.DeepSeq (NFData (..)) import Data.Aeson.Compat import Data.Monoid ((<>)) import Data.Proxy @@ -97,3 +98,7 @@ toJSON (SingObject x) = object [T.pack key .= x] where key = symbolVal (Proxy :: Proxy s) #endif + +-- | @since 0.4.1.0 +instance NFData a => NFData (SingObject s a) where + rnf (SingObject x) = rnf x diff --git a/src/Data/Aeson/Extra/SymTag.hs b/src/Data/Aeson/Extra/SymTag.hs --- a/src/Data/Aeson/Extra/SymTag.hs +++ b/src/Data/Aeson/Extra/SymTag.hs @@ -16,6 +16,7 @@ import Prelude () import Prelude.Compat +import Control.DeepSeq (NFData (..)) import Data.Aeson.Compat import Data.Aeson.Types hiding ((.:?)) import Data.Proxy @@ -48,3 +49,7 @@ toEncoding _ = toEncoding (symbolVal (Proxy :: Proxy s)) #endif toJSON _ = toJSON (symbolVal (Proxy :: Proxy s)) + +-- | @since 0.4.1.0 +instance NFData (SymTag s) where + rnf SymTag = () diff --git a/test/Tests.hs b/test/Tests.hs --- a/test/Tests.hs +++ b/test/Tests.hs @@ -21,8 +21,6 @@ import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck -import Data.These (These (..)) -import Data.Align (alignWith) import qualified Data.HashMap.Lazy as H @@ -258,18 +256,6 @@ ------------------------------------------------------------------------------ -- Merge tests ------------------------------------------------------------------------------ - -lodashMerge :: Value -> Value -> Value -lodashMerge x y = merge lodashMergeAlg x y - -lodashMergeAlg :: (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a -lodashMergeAlg r a' b' = case (a', b') of - (ObjectF a, ObjectF b) -> ObjectF $ alignWith f a b - (ArrayF a, ArrayF b) -> ArrayF $ alignWith f a b - (_, b) -> b - where f (These x y) = r x y - f (This x) = x - f (That x) = x mergeTests :: TestTree mergeTests = testGroup "Lodash merge examples" $ map f examples