aeson-extra (empty) → 0.1.0.0

raw patch · 8 files changed

+663/−0 lines, 8 filesdep +ListLikedep +aesondep +aeson-extrasetup-changed

Dependencies added: ListLike, aeson, aeson-extra, attoparsec, base, bytestring, containers, exceptions, hashable, quickcheck-instances, scientific, tasty, tasty-hunit, tasty-quickcheck, text, unordered-containers, vector

Files

CHANGELOG.md +1/−0
LICENSE +30/−0
README.md +9/−0
Setup.hs +2/−0
aeson-extra.cabal +77/−0
src/Data/Aeson/Compat.hs +178/−0
src/Data/Aeson/Extra.hs +237/−0
test/Tests.hs +129/−0

+ CHANGELOG.md view

@@ -0,0 +1,1 @@+# 0.1.0.0 (2015-09-29) Initial release

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2015, Oleg Grenrus++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Oleg Grenrus nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,9 @@+# aeson-extra++[![Build Status](https://travis-ci.org/phadej/aeson-extra.svg?branch=master)](https://travis-ci.org/phadej/aeson-extra)+[![Hackage](https://img.shields.io/hackage/v/aeson-extra.svg)](http://hackage.haskell.org/package/aeson-extra)++The package motivation is twofold:++- provide compatibility layer for [`aeson`](http://hackage.haskell.org/package/aeson)+- provide extra combinators

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ aeson-extra.cabal view

@@ -0,0 +1,77 @@+-- 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.1.0.0+synopsis:       Extra goodies for aeson+description:    The package motivation is twofold:+                .+                * provide compatibility layer for @aeson@+                * provide extra combinators+category:       Web+homepage:       https://github.com/phadej/aeson-extra#readme+bug-reports:    https://github.com/phadej/aeson-extra/issues+author:         Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer:     Oleg Grenrus <oleg.grenrus@iki.fi>+license:        BSD3+license-file:   LICENSE+tested-with:    GHC==7.8.4, GHC==7.10.2+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    CHANGELOG.md+    README.md++source-repository head+  type: git+  location: https://github.com/phadej/aeson-extra++library+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base                     >=4.7  && <4.9+    , ListLike                 >=4.2  && <4.3+    , aeson                    >=0.8  && <0.11+    , attoparsec               >=0.12 && <0.14+    , bytestring               >=0.10 && <0.11+    , containers               >=0.5  && <0.6+    , exceptions               >=0.8  && <0.9+    , hashable                 >=1.2  && <1.3+    , scientific               >=0.3  && <0.4+    , text                     >=1.2  && <1.3+    , unordered-containers     >=0.2  && <0.3+    , vector                   >=0.10 && <0.12+  exposed-modules:+      Data.Aeson.Compat+      Data.Aeson.Extra+  default-language: Haskell2010++test-suite aeson-extra-test+  type: exitcode-stdio-1.0+  main-is: Tests.hs+  hs-source-dirs:+      test+  ghc-options: -Wall+  build-depends:+      base                     >=4.7  && <4.9+    , ListLike                 >=4.2  && <4.3+    , aeson                    >=0.8  && <0.11+    , attoparsec               >=0.12 && <0.14+    , bytestring               >=0.10 && <0.11+    , containers               >=0.5  && <0.6+    , exceptions               >=0.8  && <0.9+    , hashable                 >=1.2  && <1.3+    , scientific               >=0.3  && <0.4+    , text                     >=1.2  && <1.3+    , 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+  default-language: Haskell2010

+ src/Data/Aeson/Compat.hs view

@@ -0,0 +1,178 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Aeson.Compat+-- Copyright   :  (C) 2015 Oleg Grenrus+-- License     :  BSD3+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- Compatibility notices+--+--   * 'decode' etc. work as in @aeson >=0.9@+--   * but it is generalised to work in any 'MonadThrow' (that is extra)+--   * '.:?' works as in @aeson <0.10@+--   * '.:!' works as '.:?' in @aeson ==0.10@+module Data.Aeson.Compat (+  -- * Generic decoding functions+  decode,+  decode',+  decodeStrict,+  decodeStrict',+  AesonException(..),+  -- * Either decoding functions+  eitherDecode, eitherDecode', eitherDecodeStrict, eitherDecodeStrict',+  -- * Operators+  (.:?), (.:!),+  -- * Re-exports+  -- | Original 'Data.Aeson..:?' operator is not re-exported+  module Data.Aeson,+  ) where++#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative+#endif++#if MIN_VERSION_aeson(0,10,0)+import           Data.Monoid+#endif++import           Data.Aeson hiding+  ((.:?), decode, decode', decodeStrict, decodeStrict'+#if !MIN_VERSION_aeson (0,9,0)+  , eitherDecode, eitherDecode', eitherDecodeStrict, eitherDecodeStrict'+#endif+  )++#if !MIN_VERSION_aeson (0,9,0)+import           Data.Aeson.Parser (value, value')+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.ByteString.Char8 as A (skipSpace)+import qualified Data.Attoparsec.Lazy as L+#endif++import           Control.Monad.Catch+import           Data.Aeson.Types hiding ((.:?))+import           Data.ByteString as B+import           Data.ByteString.Lazy as L+import qualified Data.HashMap.Strict as H+import           Data.Text as T+import           Data.Typeable (Typeable)++-- | Exception thrown by 'throwDecode' - family of functions.+newtype AesonException = AesonException String+  deriving (Show, Typeable)++instance Exception AesonException++eitherAesonExc :: (MonadThrow m) => Either String a -> m a+eitherAesonExc (Left err) = throwM (AesonException err)+eitherAesonExc (Right x)  = return x++-- | Like original 'Data.Aeson.decode' but in arbitrary 'MonadThrow'.+-- +-- Parse a top-level JSON value, i.e. also strings, numbers etc.+decode :: (FromJSON a, MonadThrow m) => L.ByteString -> m a+decode = eitherAesonExc . eitherDecode++-- | Like original 'Data.Aeson.decode'' but in arbitrary 'MonadThrow'.+decode' :: (FromJSON a, MonadThrow m) => L.ByteString -> m a+decode' = eitherAesonExc . eitherDecode'++-- | Like original 'Data.Aeson.decodeStrict' but in arbitrary 'MonadThrow'.+decodeStrict :: (FromJSON a, MonadThrow m) => B.ByteString -> m a+decodeStrict = eitherAesonExc . eitherDecodeStrict++-- | Like original 'Data.Aeson.decodeStrict'' but in arbitrary 'MonadThrow'.+decodeStrict' :: (FromJSON a, MonadThrow m) => B.ByteString -> m a+decodeStrict' = eitherAesonExc . eitherDecodeStrict'++-- | Retrieve the value associated with the given key of an 'Object'.+-- The result is 'Nothing' if the key is not present, or 'empty' if+-- the value cannot be converted to the desired type.+--+-- This accessor is most useful if the key and value can be absent+-- from an object without affecting its validity.  If the key and+-- value are mandatory, use '.:' instead.+--+-- This operator is consistent in 'aeson >=0.8 && <0.11'+(.:?) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+obj .:? key = case H.lookup key obj of+                Nothing -> pure Nothing+                Just v  ->+#if MIN_VERSION_aeson(0,10,0)+                  modifyFailure addKeyName $ parseJSON v -- <?> Key key+  where+    addKeyName = (("failed to parse field " <> T.unpack key <> ": ") <>)+#else+                  parseJSON v+#endif+{-# INLINE (.:?) #-}++-- | Like '.:?', but the resulting parser will fail,+-- if the key is present but is 'Null'.+(.:!) :: (FromJSON a) => Object -> Text -> Parser (Maybe a)+obj .:! key = case H.lookup key obj of+                Nothing -> pure Nothing+                Just v  -> +#if MIN_VERSION_aeson(0,10,0)+                  modifyFailure addKeyName $ Just <$> parseJSON v -- <?> Key key+  where+    addKeyName = (("failed to parse field " <> T.unpack key <> ": ") <>)+#else+                  Just <$> parseJSON v+#endif+{-# INLINE (.:!) #-}++#if !MIN_VERSION_aeson(0,9,0)+-- From Parser.Internal++-- | Parse a top-level JSON value followed by optional whitespace and+-- end-of-input.  See also: 'json'.+jsonEOF :: A.Parser Value+jsonEOF = value <* A.skipSpace <* A.endOfInput++-- | Parse a top-level JSON value followed by optional whitespace and+-- end-of-input.  See also: 'json''.+jsonEOF' :: A.Parser Value+jsonEOF' = value' <* A.skipSpace <* A.endOfInput++-- | Like 'decode' but returns an error message when decoding fails.+eitherDecode :: (FromJSON a) => L.ByteString -> Either String a+eitherDecode = eitherDecodeWith jsonEOF fromJSON+{-# INLINE eitherDecode #-}++-- | Like 'decodeStrict' but returns an error message when decoding fails.+eitherDecodeStrict :: (FromJSON a) => B.ByteString -> Either String a+eitherDecodeStrict = eitherDecodeStrictWith jsonEOF fromJSON+{-# INLINE eitherDecodeStrict #-}++-- | Like 'decode'' but returns an error message when decoding fails.+eitherDecode' :: (FromJSON a) => L.ByteString -> Either String a+eitherDecode' = eitherDecodeWith jsonEOF' fromJSON+{-# INLINE eitherDecode' #-}++-- | Like 'decodeStrict'' but returns an error message when decoding fails.+eitherDecodeStrict' :: (FromJSON a) => B.ByteString -> Either String a+eitherDecodeStrict' = eitherDecodeStrictWith jsonEOF' fromJSON+{-# INLINE eitherDecodeStrict' #-}++eitherDecodeWith :: L.Parser Value -> (Value -> Result a) -> L.ByteString+                 -> Either String a+eitherDecodeWith p to s =+    case L.parse p s of+      L.Done _ v -> case to v of+                      Success a -> Right a+                      Error msg -> Left msg+      L.Fail _ _ msg -> Left msg+{-# INLINE eitherDecodeWith #-}++eitherDecodeStrictWith :: A.Parser Value -> (Value -> Result a) -> B.ByteString+                       -> Either String a+eitherDecodeStrictWith p to s =+    case either Error to (A.parseOnly p s) of+      Success a -> Right a+      Error msg -> Left msg+{-# INLINE eitherDecodeStrictWith #-}++#endif

+ src/Data/Aeson/Extra.hs view

@@ -0,0 +1,237 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Aeson.Extra+-- Copyright   :  (C) 2015 Oleg Grenrus+-- License     :  BSD3+-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>+--+-- More or less useful newtypes for writing 'FromJSON' & 'ToJSON' instances+module Data.Aeson.Extra (+  -- * Generic maps+  M(..),+  FromJSONKey(..),+  parseIntegralJSONKey,+  FromJSONMap(..),+  ToJSONKey(..),+  ToJSONMap(..),+  -- * Symbol tag+  SymTag(..),+  -- * Singleton object+  SingObject(..),+  mkSingObject,+  getSingObject,+  -- * CollapsedList+  CollapsedList(..),+  getCollapsedList,+  parseCollapsedList,+  -- * Re-exports+  module Data.Aeson.Compat,+  ) where++#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative+import           Data.Foldable (Foldable)+import           Data.Traversable (Traversable, traverse)+#endif++import           Data.Monoid+import           Data.Aeson.Compat+import           Data.Aeson.Types hiding ((.:?))+import qualified Data.HashMap.Strict as H+import           Data.Hashable (Hashable)+import           Data.ListLike (ListLike)+import qualified Data.ListLike as ListLike+import qualified Data.Map as Map+import           Data.Proxy+import           Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Read as T+import           GHC.TypeLits++-- | A wrapper type to parse arbitrary maps+--+-- > λ > decode "{\"1\": 1, \"2\": 2}" :: Maybe (M (H.HashMap Int Int))+-- > Just (M {getMap = fromList [(1,1),(2,2)]})+newtype M a = M { getMap :: a }+  deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)++class FromJSONKey a where+  parseJSONKey :: Text -> Parser a++instance FromJSONKey Text where parseJSONKey = pure+instance FromJSONKey TL.Text where parseJSONKey = pure . TL.fromStrict+instance FromJSONKey String where parseJSONKey = pure . T.unpack+instance FromJSONKey Int where parseJSONKey = parseIntegralJSONKey+instance FromJSONKey Integer where parseJSONKey = parseIntegralJSONKey++parseIntegralJSONKey :: Integral a => Text -> Parser a+parseIntegralJSONKey t = case (T.signed T.decimal) t of+  Right (v, left) | T.null left  -> pure v+                  | otherwise    -> fail $ "Garbage left: " <> T.unpack left+  Left err                       -> fail err++class FromJSONMap m k v | m -> k v where+  parseJSONMap :: H.HashMap Text Value -> Parser m++instance (Eq k, Hashable k, FromJSONKey k, FromJSON v) => FromJSONMap (H.HashMap k v) k v where+  parseJSONMap = fmap H.fromList . traverse f . H.toList+    where f (k, v) = (,) <$> parseJSONKey k <*> parseJSON v++instance (Ord k, FromJSONKey k, FromJSON v) => FromJSONMap (Map.Map k v) k v where+  parseJSONMap = fmap Map.fromList . traverse f . H.toList+    where f (k, v) = (,) <$> parseJSONKey k <*> parseJSON v++instance (FromJSONMap m k v) => FromJSON (M m) where+  parseJSON v = M <$> withObject "Map" parseJSONMap v+++class ToJSONKey a where+  toJSONKey :: a -> Text++instance ToJSONKey Text where toJSONKey = id+instance ToJSONKey TL.Text where toJSONKey = TL.toStrict+instance ToJSONKey String where toJSONKey = T.pack+instance ToJSONKey Int where toJSONKey = T.pack . show+instance ToJSONKey Integer where toJSONKey = T.pack . show++class ToJSONMap m k v | m -> k v where+  toJSONMap :: m -> H.HashMap Text Value++instance (ToJSONKey k, ToJSON v) => ToJSONMap (H.HashMap k v) k v where+  toJSONMap = H.fromList . fmap f . H.toList+    where f (k, v) = (toJSONKey k, toJSON v)++instance (ToJSONKey k, ToJSON v) => ToJSONMap (Map.Map k v) k v where+  toJSONMap = H.fromList . fmap f . Map.toList+    where f (k, v) = (toJSONKey k, toJSON v)++instance (ToJSONMap m k v) => ToJSON (M m) where+  toJSON (M m) = Object (toJSONMap m)++-- | Singleton string encoded and decoded as ifself.+--+-- > λ> encode (Sym :: Sym "foobar")+-- > "\"foobar\""+--+-- > decode "\"foobar\"" :: Maybe (Sym "foobar")+-- > Just Sym+--+-- > decode "\"foobar\"" :: Maybe (Sym "barfoo")+-- > Nothing+data SymTag (s :: Symbol) = SymTag+  deriving (Eq, Ord, Show, Read, Enum, Bounded)++instance KnownSymbol s => FromJSON (SymTag s) where+  parseJSON (String t)+    | T.unpack t == symbolVal (Proxy :: Proxy s) = pure SymTag+  parseJSON v = typeMismatch ("Sym " ++ show (symbolVal (Proxy :: Proxy s))) v++instance KnownSymbol s => ToJSON (SymTag s) where+#if MIN_VERSION_aeson (0,10,0)+  toEncoding _ = toEncoding (symbolVal (Proxy :: Proxy s))+#endif+  toJSON _ = toJSON (symbolVal (Proxy :: Proxy s))+++-- | Singleton value object+--+-- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int)+-- > Just (SingObject 42)+--+-- > λ > encode (SingObject 42 :: SingObject "value" Int)+-- > "{\"value\":42}"+newtype SingObject (s ::Symbol) a = SingObject a+  deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)++mkSingObject :: Proxy s -> a -> SingObject s a+mkSingObject _ = SingObject++getSingObject :: Proxy s -> SingObject s a -> a+getSingObject _ (SingObject x) = x++instance (KnownSymbol s, FromJSON a) => FromJSON (SingObject s a) where+  parseJSON = withObject ("SingObject "<> show key) $ \obj -> +    SingObject <$> obj .: T.pack key+    where key = symbolVal (Proxy :: Proxy s)++instance (KnownSymbol s, ToJSON a) => ToJSON (SingObject s a) where+#if MIN_VERSION_aeson(0,10,0)+  toEncoding (SingObject x) = pairs (T.pack key .= x)+    where key = symbolVal (Proxy :: Proxy s)+#endif+  toJSON (SingObject x) = object [T.pack key .= x]+    where key = symbolVal (Proxy :: Proxy s)+++-- | Collapsed list, singleton is represented as the value itself in JSON encoding.+--+-- > λ > decode "null" :: Maybe (CollapsedList [Int] Int)+-- > Just (CollapsedList [])+-- > λ > decode "42" :: Maybe (CollapsedList [Int] Int)+-- > Just (CollapsedList [42])+-- > λ > decode "[1, 2, 3]" :: Maybe (CollapsedList [Int] Int)+-- > Just (CollapsedList [1,2,3])+--+-- > λ > encode (CollapsedList ([] :: [Int]))+-- > "null"+-- > λ > encode (CollapsedList ([42] :: [Int]))+-- > "42"+-- > λ > encode (CollapsedList ([1, 2, 3] :: [Int]))+-- > "[1,2,3]"+newtype CollapsedList full elem = CollapsedList full+  deriving (Eq, Ord, Show, Read)++getCollapsedList :: CollapsedList full elem -> full+getCollapsedList (CollapsedList l) = l++instance (FromJSON elem, FromJSON full, ListLike full elem) => FromJSON (CollapsedList full elem) where+  parseJSON Null         = pure (CollapsedList ListLike.empty)+  parseJSON v@(Array _)  = CollapsedList <$> parseJSON v+  parseJSON v            = CollapsedList . ListLike.singleton <$> parseJSON v++instance (ToJSON elem, ToJSON full, ListLike full elem) => ToJSON (CollapsedList full elem) where+#if MIN_VERSION_aeson (0,10,0)+  toEncoding (CollapsedList l)+    | ListLike.null l                 = toEncoding Null+    | ListLike.null (ListLike.tail l) = toEncoding (ListLike.head l)+    | otherwise                       = toEncoding l+#endif+  toJSON (CollapsedList l)+    | ListLike.null l                 = Null+    | ListLike.null (ListLike.tail l) = toJSON (ListLike.head l)+    | otherwise                       = toJSON l++-- | 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 <$> collapsedList 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 elem, FromJSON full, ListLike full elem) => Object -> Text -> Parser full+parseCollapsedList obj key =+  case H.lookup key obj of+    Nothing   -> pure ListLike.empty+#if MIN_VERSION_aeson(0,10,0) +    Just v    -> modifyFailure addKeyName $ (getCollapsedList <$> parseJSON v) -- <?> Key key+  where+    addKeyName = (("failed to parse field " <> T.unpack key <> ": ") <>)+#else+    Just v    -> getCollapsedList <$> parseJSON v+#endif

+ test/Tests.hs view

@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+module Main (main) where++#if !MIN_VERSION_base(4,8,0)+import           Control.Applicative+#endif++import           Data.Aeson.Extra+import qualified Data.HashMap.Lazy as H+import           Data.Map (Map)+import           Data.Proxy+import           Test.QuickCheck.Instances ()+import           Test.Tasty+import           Test.Tasty.HUnit+import           Test.Tasty.QuickCheck++main :: IO ()+main = defaultMain $ testGroup "Tests"+  [ dotColonMark+  , mTests+  , symTests+  , singObjectTests+  , collapsedListTests+  ]++------------------------------------------------------------------------------+-- M+------------------------------------------------------------------------------++mTests :: TestTree+mTests = testGroup "M"+  [ testCase "decode" $ let lhs = decode "{\"1\": 1, \"2\": 2}" :: Maybe (M (H.HashMap Int Int))+                            rhs = Just result+                        in lhs @?= rhs+  , testProperty "decode . encode" $+      let prop :: Map Int Int -> Property+          prop m = let lhs = fmap getMap . decode . encode . M $ m+                       rhs = Just m+                   in lhs === rhs+      in prop+  ]+  where result = M $ H.fromList [(1,1),(2,2)]++------------------------------------------------------------------------------+-- SymTag+------------------------------------------------------------------------------++symTests :: TestTree+symTests = testGroup "SymTag"+  [ testCase "encode" $ encode (SymTag :: SymTag "foobar") @?= "\"foobar\""+  , testCase "decode success" $ (decode "\"foobar\"" :: Maybe (SymTag "foobar")) @?= Just SymTag+  , testCase "decode failure" $ (decode "\"foobar\"" :: Maybe (SymTag "barfoo")) @?= Nothing+  ]++------------------------------------------------------------------------------+-- SingObject+------------------------------------------------------------------------------++-- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int)+-- > Just (SingObject 42)++singObjectTests :: TestTree+singObjectTests = testGroup "SingObject"+  [ testCase "decode success" $ (decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int)) @?= Just (SingObject 42)+  , testCase "decode failure" $ (decode "{\"value\": 42 }" :: Maybe (SingObject "key" Int)) @?= Nothing+  , testProperty "decode . encode" $+      let prop :: Int -> Property+          prop n = let rhs = fmap (getSingObject p) . decode . encode . mkSingObject p $ n+                       lhs = Just n+                   in lhs === rhs+          p :: Proxy "value"+          p = Proxy+      in prop+  ]++------------------------------------------------------------------------------+-- parseCollapsedList+------------------------------------------------------------------------------++newtype V = V [Int] deriving (Show, Eq)+instance FromJSON V where parseJSON = withObject "V" $ \obj -> V <$> parseCollapsedList obj "value"++collapsedListTests :: TestTree+collapsedListTests = testGroup "collapsedList"+  [ testCase "empty"     $ (decode "{}" :: Maybe V) @?= Just (V [])+  , testCase "null"      $ (decode "{\"value\": null}" :: Maybe V) @?= Just (V [])+  , testCase "singleton" $ (decode "{\"value\": 42}" :: Maybe V) @?= Just (V [42])+  , testCase "array"     $ (decode "{\"value\": [1, 2, 3, 4]}" :: Maybe V) @?= Just (V [1,2,3,4])+  , testProperty "decode .encode " $+      let prop :: [Int] -> Property+          prop l = let rhs = fmap getCollapsedList . decode . encode . CollapsedList $ l+                       lhs = Just l+                   in lhs === rhs+      in prop+  ]++------------------------------------------------------------------------------+-- Comparison (.:?) and (.:!)+------------------------------------------------------------------------------++newtype T1 = T1 (Maybe Int) deriving (Eq, Show)+newtype T2 = T2 (Maybe Int) deriving (Eq, Show)+newtype T3 = T3 (Maybe Int) deriving (Eq, Show)++instance FromJSON T1 where parseJSON = fmap T1 . withObject "T1" (.: "value")+instance FromJSON T2 where parseJSON = fmap T2 . withObject "T2" (.:? "value")+instance FromJSON T3 where parseJSON = fmap T3 . withObject "T3" (.:! "value")++dotColonMark :: TestTree+dotColonMark = testGroup "Operators" $ fmap t [+    assertEqual ".:  not-present" Nothing               (decode ex1 :: Maybe T1)+  , assertEqual ".:  42"          (Just (T1 (Just 42))) (decode ex2 :: Maybe T1)+  , assertEqual ".:  null"        (Just (T1 Nothing))   (decode ex3 :: Maybe T1)++  , assertEqual ".:? not-present" (Just (T2 (Nothing))) (decode ex1 :: Maybe T2)+  , assertEqual ".:? 42"          (Just (T2 (Just 42))) (decode ex2 :: Maybe T2)+  , assertEqual ".:? null"        (Just (T2 Nothing))   (decode ex3 :: Maybe T2)++  , assertEqual ".:! not-present" (Just (T3 (Nothing))) (decode ex1 :: Maybe T3)+  , assertEqual ".:! 42"          (Just (T3 (Just 42))) (decode ex2 :: Maybe T3)+  , assertEqual ".:! null"        Nothing               (decode ex3 :: Maybe T3)+  ]+  where ex1 = "{}"+        ex2 = "{\"value\": 42 }"+        ex3 = "{\"value\": null }"+        t   = testCase "-"