aeson-extra-0.5.1.3/0000755000000000000000000000000007346545000012275 5ustar0000000000000000aeson-extra-0.5.1.3/CHANGELOG.md0000644000000000000000000000347707346545000014121 0ustar0000000000000000# 0.5.1.3 (2023-07-09) - Support `aeson-2.2.0.0` # 0.5.1.1 (2022-06-15) - Support `aeson-2.1.0.0` - Drop unused package dependencies # 0.5.1 (2021-09-10) - Support `aeson-2.0.0.0` # 0.5 (2021-03-22) - Trim lower bounds - Remove `Data.Aeson.Extra.Map` (use recent `aeson`). - Remove `Data.Aeson.Time` (use recent `aeson`) # 0.4.1.3 (2019-10-21) - support semialign-1.1 - drop spurious dependency from test-suite # 0.4.1.2 (2019-06-02) - these-1 support # 0.4.1.1 (2018-04-11) - base-compat-0.10 support # 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: - `SingObject` and `CollapsedList` changes - deprecated `Map` module # 0.3.2.0 - Add `Data.Aeson.Extra.Stream` with `streamDecode` # 0.3.1.1 (2016-02-09) - Support aeson-0.11 # 0.3.1.0 (2015-12-27) - Add `Data.Aeson.Extra.TH` - Add `Data.Aeson.Extra.Foldable` - Add `Data.Aeson.Extra.Merge` # 0.3.0.1 (2016-01-26) - Support `quickcheck-instances >=0.3.12` # 0.3.0.0 (2015-12-25) - `Data.Time.TH` moved to [`time-parsers`](http://hackage.haskell.org/package/time-parsers) - `Data.Aeson.Compat` moved to [`aeson-compat`](http://hackage.haskell.org/package/aeson-compat) - The modules aren't re-exported, as that would require `Cabal >= 1.21` restriction # 0.2.3.0 (2015-12-08) - `Data.Time.TH` module with `mkUTCTime` - `encodeStrict` in `Data.Aeson.Extra` # 0.2.2.0 (2015-11-10) - `U` and `Z` to parse `UTCTime` and `ZonedTime` compatibly - Orphans `FromJSON` for `Day` and `LocalTime` # 0.2.1.0 (2015-10-05) GHC 7.6 Support - No `SymTag` or `SingObject` support # 0.2.0.0 (2015-09-29) No ListLike - Make `CollapsedList` use typeclasses in `base` # 0.1.0.0 (2015-09-29) Initial release aeson-extra-0.5.1.3/LICENSE0000644000000000000000000000276207346545000013311 0ustar0000000000000000Copyright (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. aeson-extra-0.5.1.3/README.md0000644000000000000000000000123007346545000013550 0ustar0000000000000000# 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) [![Stackage LTS 3](http://stackage.org/package/aeson-extra/badge/lts-3)](http://stackage.org/lts-3/package/aeson-extra) [![Stackage Nightly](http://stackage.org/package/aeson-extra/badge/nightly)](http://stackage.org/nightly/package/aeson-extra) Package provides extra funcitonality on top of [`aeson`](https://hackage.haskell.org/package/aeson) and [`aeson-compat`](https://hackage.haskell.org/package/aeson-compat) aeson-extra-0.5.1.3/Setup.hs0000644000000000000000000000005607346545000013732 0ustar0000000000000000import Distribution.Simple main = defaultMain aeson-extra-0.5.1.3/aeson-extra.cabal0000644000000000000000000000512607346545000015513 0ustar0000000000000000cabal-version: >=1.10 name: aeson-extra version: 0.5.1.3 synopsis: Extra goodies for aeson description: Package provides extra functionality on top of @aeson@ and @aeson-compat@ category: Data, Aeson homepage: https://github.com/phadej/aeson-extra#readme bug-reports: https://github.com/phadej/aeson-extra/issues author: Oleg Grenrus maintainer: Oleg Grenrus license: BSD3 license-file: LICENSE tested-with: GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.5 || ==9.6.2 build-type: Simple 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: aeson >=1.5.4.1 && <1.6 || >=2.0 && <2.3 , attoparsec >=0.11.3.4 && <0.15 , attoparsec-aeson >=2.1.0.0 && <2.3 , base >=4.7 && <4.19 , base-compat-batteries >=0.11.2 && <0.14 , bytestring >=0.10 && <0.12 , deepseq >=1.3 && <1.5 , recursion-schemes >=4.1.2 && <5.3 , scientific >=0.3 && <0.4 , semialign >=1 && <1.4 , template-haskell >=2.8 && <2.21 , text >=1.2 && <1.3 || >=2.0 && <2.1 , these >=1 && <1.3 , unordered-containers >=0.2 && <0.3 , vector >=0.10 && <0.14 -- if !impl(ghc >=8.2) -- build-depends: bifunctors >=5.5.2 && <5.7 exposed-modules: Data.Aeson.Extra Data.Aeson.Extra.CollapsedList Data.Aeson.Extra.Foldable Data.Aeson.Extra.Merge Data.Aeson.Extra.Recursive Data.Aeson.Extra.SingObject Data.Aeson.Extra.Stream Data.Aeson.Extra.SymTag Data.Aeson.Extra.TH 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: aeson , aeson-extra , base , base-compat-batteries , containers , quickcheck-instances >=0.3 && <0.4 , tasty >=0.10 && <1.5 , tasty-hunit >=0.9 && <0.11 , tasty-quickcheck >=0.8 && <0.11 , unordered-containers , vector other-modules: Orphans default-language: Haskell2010 aeson-extra-0.5.1.3/src/Data/Aeson/0000755000000000000000000000000007346545000015002 5ustar0000000000000000aeson-extra-0.5.1.3/src/Data/Aeson/Extra.hs0000644000000000000000000000257307346545000016430 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra -- Copyright : (C) 2015-2016 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- More or less useful newtypes for writing 'FromJSON' & 'ToJSON' instances module Data.Aeson.Extra ( -- * Strict encoding encodeStrict, -- * Symbol tag SymTag(..), -- * Singleton object SingObject(..), mkSingObject, getSingObject, -- * CollapsedList CollapsedList(..), getCollapsedList, parseCollapsedList, -- * Algebra ValueF(..), ObjectF, ArrayF, -- * Merge merge, lodashMerge, -- * Stream streamDecode, -- * Template Haskell mkValue, mkValue', ) where import Prelude () import Prelude.Compat import Data.Aeson import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Aeson.Extra.CollapsedList import Data.Aeson.Extra.Merge import Data.Aeson.Extra.Recursive () import Data.Aeson.Extra.SingObject import Data.Aeson.Extra.Stream import Data.Aeson.Extra.SymTag import Data.Aeson.Extra.TH -- | Like 'encode', but produces strict 'BS.ByteString'. -- -- /Since: 0.2.3.0/ encodeStrict :: ToJSON a => a -> BS.ByteString encodeStrict = LBS.toStrict . encode aeson-extra-0.5.1.3/src/Data/Aeson/Extra/0000755000000000000000000000000007346545000016065 5ustar0000000000000000aeson-extra-0.5.1.3/src/Data/Aeson/Extra/CollapsedList.hs0000644000000000000000000001113607346545000021165 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra.CollapsedList -- Copyright : (C) 2015-2016 Oleg Grenrus -- 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.Compat import Control.Applicative (Alternative (..)) import Data.Aeson.Types hiding ((.:?)) import Data.Text (Text) #if __GLASGOW_HASKELL__ >= 708 import Data.Typeable (Typeable) #endif import qualified Data.Foldable as Foldable import qualified Data.Text as T #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KM #else import qualified Data.HashMap.Strict as KM #endif -- | 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]" -- -- Documentation rely on @f@ 'Alternative' instance behaving like lists'. newtype CollapsedList f a = CollapsedList (f a) deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable #if __GLASGOW_HASKELL__ >= 708 , Typeable #endif ) getCollapsedList :: CollapsedList f a -> f a getCollapsedList (CollapsedList l) = l instance (FromJSON1 f, Alternative f) => FromJSON1 (CollapsedList f) where #if MIN_VERSION_aeson(2,2,0) liftParseJSON o p _ v = CollapsedList <$> case v of Null -> pure Control.Applicative.empty Array _ -> liftParseJSON o p (listParser p) v x -> pure <$> p x #else liftParseJSON p _ v = CollapsedList <$> case v of Null -> pure Control.Applicative.empty Array _ -> liftParseJSON p (listParser p) v x -> pure <$> p x #endif instance (ToJSON1 f, Foldable f) => ToJSON1 (CollapsedList f) where #if MIN_VERSION_aeson(2,2,0) liftToEncoding o to _ (CollapsedList l) = case l' of [] -> toEncoding Null [x] -> to x _ -> liftToEncoding o to (listEncoding to) l where l' = Foldable.toList l liftToJSON o to _ (CollapsedList l) = case l' of [] -> toJSON Null [x] -> to x _ -> liftToJSON o to (listValue to) l where l' = Foldable.toList l #else 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 #endif 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 KM.lookup key obj of Nothing -> pure Control.Applicative.empty Just v -> modifyFailure addKeyName $ (getCollapsedList <$> parseJSON v) -- Key key where #if MIN_VERSION_aeson(2,0,0) key = Key.fromText key' #else key = key' #endif addKeyName = (mappend ("failed to parse field " `mappend` T.unpack key' `mappend`": ")) aeson-extra-0.5.1.3/src/Data/Aeson/Extra/Foldable.hs0000644000000000000000000000026107346545000020130 0ustar0000000000000000module Data.Aeson.Extra.Foldable {-# DEPRECATED "Use Data.Aeson.Extra.Recursive module" #-} (module Data.Aeson.Extra.Recursive) where import Data.Aeson.Extra.Recursive aeson-extra-0.5.1.3/src/Data/Aeson/Extra/Merge.hs0000644000000000000000000000333507346545000017464 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra.Merge -- Copyright : (C) 2015-2016 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- module Data.Aeson.Extra.Merge ( merge, mergeA, lodashMerge, ValueF(..), ObjectF, ArrayF, ) where import Prelude () import Prelude.Compat import Data.Aeson import Data.Aeson.Extra.Recursive import Data.Align (alignWith) import Data.Functor.Foldable (embed, project) import Data.These (These (..)) -- | Generic merge. -- -- For example see 'lodashMerge'. -- -- /Since: aeson-extra-0.3.1.0/ merge :: (forall a. (a -> a -> a) -> ValueF a -> ValueF a -> ValueF a) -> Value -> Value -> Value merge f a b = embed $ f (merge f) (project a) (project b) -- | Generic merge, in arbitrary context. -- -- /Since: aeson-extra-0.3.1.0/ mergeA :: Functor f => (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 aeson-extra-0.5.1.3/src/Data/Aeson/Extra/Recursive.hs0000644000000000000000000000500207346545000020365 0ustar0000000000000000{-# 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 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 #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.KeyMap as KM #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 #if MIN_VERSION_aeson(2,0,0) project (Object o) = ObjectF (KM.toHashMapText o) #else project (Object o) = ObjectF o #endif 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 #if MIN_VERSION_aeson(2,0,0) embed (ObjectF o) = Object (KM.fromHashMapText o) #else embed (ObjectF o) = Object o #endif embed (ArrayF a) = Array a embed (StringF s) = String s embed (NumberF n) = Number n embed (BoolF b) = Bool b embed NullF = Null aeson-extra-0.5.1.3/src/Data/Aeson/Extra/SingObject.hs0000644000000000000000000000667707346545000020470 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra.SymTag -- Copyright : (C) 2015-2016 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- module Data.Aeson.Extra.SingObject ( SingObject(..), mkSingObject, getSingObject, ) where import Prelude () import Prelude.Compat import Control.DeepSeq (NFData (..)) import Data.Aeson import Data.Aeson.Encoding (pair) import Data.Proxy (Proxy (..)) import Data.String (fromString) import Data.Typeable (Typeable) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import qualified Data.Text as T #if MIN_VERSION_aeson(2,0,0) import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KM #else import qualified Data.HashMap.Strict as KM #endif #if MIN_VERSION_aeson(2,2,0) import Data.Aeson.Types (JSONPathElement (Key)) #else import Data.Aeson.Internal (JSONPathElement (Key)) #endif -- | Singleton value object -- -- > λ > decode "{\"value\": 42 }" :: Maybe (SingObject "value" Int) -- > Just (SingObject 42) -- -- > λ > encode (SingObject 42 :: SingObject "value" Int) -- > "{\"value\":42}" -- -- /Available with: base >=4.7/ newtype SingObject (s :: Symbol) a = SingObject a deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, Typeable) mkSingObject :: Proxy s -> a -> SingObject s a mkSingObject _ = SingObject getSingObject :: Proxy s -> SingObject s a -> a getSingObject _ (SingObject x) = x instance KnownSymbol s => FromJSON1 (SingObject s) where #if MIN_VERSION_aeson(2,2,0) liftParseJSON _ p _ = withObject ("SingObject "<> show key) $ \obj -> case KM.lookup key obj of Nothing -> fail $ "key " ++ show key ++ " not present" Just v -> SingObject <$> p v Key key where key = fromString $ symbolVal (Proxy :: Proxy s) #else liftParseJSON p _ = withObject ("SingObject "<> show key) $ \obj -> case KM.lookup key obj of Nothing -> fail $ "key " ++ show key ++ " not present" Just v -> SingObject <$> p v Key key where key = fromString $ symbolVal (Proxy :: Proxy s) #endif instance KnownSymbol s => ToJSON1 (SingObject s) where #if MIN_VERSION_aeson(2,2,0) liftToJSON _ to _ (SingObject x) = object [ key .= to x] where key = fromString $ symbolVal (Proxy :: Proxy s) liftToEncoding _ to _ (SingObject x) = pairs $ pair key $ to x where key = fromString $ symbolVal (Proxy :: Proxy s) #else liftToJSON to _ (SingObject x) = object [ key .= to x] where key = fromString $ symbolVal (Proxy :: Proxy s) liftToEncoding to _ (SingObject x) = pairs $ pair key $ to x where key = fromString $ symbolVal (Proxy :: Proxy s) #endif 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 -- | @since 0.4.1.0 instance NFData a => NFData (SingObject s a) where rnf (SingObject x) = rnf x aeson-extra-0.5.1.3/src/Data/Aeson/Extra/Stream.hs0000644000000000000000000000404507346545000017657 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra.Stream -- Copyright : (C) 2015-2016 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- module Data.Aeson.Extra.Stream ( streamDecode, ) where import Prelude () import Prelude.Compat import Control.Applicative (many, (<|>)) import Data.Aeson (FromJSON, Result (..), Value, fromJSON) import Data.Aeson.Parser (value) import qualified Data.Attoparsec.ByteString.Char8 as A8 import qualified Data.Attoparsec.ByteString.Lazy as A import qualified Data.ByteString.Lazy as LBS streamParse :: LBS.ByteString -> ([Value], Maybe String) streamParse = start where start bs = case A.parse (lexemeChar '[') bs of A.Done bs' _ -> first bs' A.Fail _ _ err -> ([], Just err) first bs = case A.parse (lexemeChar ']') bs of A.Done {} -> ([], Nothing) A.Fail {} -> go bs go bs = case A.parse valueEnd bs of A.Done _ (r, False) -> ([r], Nothing) A.Done bs' (r, True) -> case go bs' of ~(rs, end) -> (r:rs, end) A.Fail _ _ err -> ([], Just err) valueEnd = do v <- value c <- True <$ lexemeChar ',' <|> False <$ lexemeChar ']' return (v, c) lexemeChar c = many A8.space *> A8.char c <* many A8.space -- | Lazyly parse 'LBS.ByteString' with top-level JSON array. -- -- /Note:/ inspecting result's second field will force the list! -- -- @ -- let ~(values, err) = 'streamDecode' bs -- traverse_ processValue values -- maybe (pure ()) printError err -- @ -- -- @since 0.3.2.0 streamDecode :: forall a. FromJSON a => LBS.ByteString -> ([a], Maybe String) streamDecode bs = go values where (values, err) = streamParse bs go :: [Value] -> ([a], Maybe String) go [] = ([], err) go (v:vs) = case fromJSON v of Error err' -> ([], Just err') Success x -> case go vs of ~(xs, err') -> (x:xs, err') aeson-extra-0.5.1.3/src/Data/Aeson/Extra/SymTag.hs0000644000000000000000000000307107346545000017626 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra.SymTag -- Copyright : (C) 2015-2018 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- module Data.Aeson.Extra.SymTag ( SymTag(..), ) where import Prelude () import Prelude.Compat import Control.DeepSeq (NFData (..)) import Data.Aeson import Data.Aeson.Types hiding ((.:?)) import Data.Proxy (Proxy (..)) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal) import qualified Data.Text as T -- | Singleton string encoded and decoded as ifself. -- -- > λ> encode (SymTag :: SymTag "foobar") -- > "\"foobar\"" -- -- > decode "\"foobar\"" :: Maybe (SymTag "foobar") -- > Just SymTag -- -- > decode "\"foobar\"" :: Maybe (SymTag "barfoo") -- > Nothing -- -- /Available with: base >=4.7/ 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 ("SymTag " ++ 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)) -- | @since 0.4.1.0 instance NFData (SymTag s) where rnf SymTag = () aeson-extra-0.5.1.3/src/Data/Aeson/Extra/TH.hs0000644000000000000000000000236107346545000016736 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Aeson.Extra.TH -- Copyright : (C) 2015-2016 Oleg Grenrus -- License : BSD3 -- Maintainer : Oleg Grenrus -- -- In addition to 'mkValue' and 'mkValue'' helpers, -- this module exports 'Lift' 'Value' orphan instance for aeson <0.11 module Data.Aeson.Extra.TH ( mkValue, mkValue', ) where import Language.Haskell.TH import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Aeson -- | Create a 'Value' from string representation. -- -- This is useful in tests. -- -- /Since: aeson-extra-0.3.1.0/ mkValue :: String -> Q Exp mkValue s = case eitherDecodeStrict' bs :: Either String Value of Left err -> fail $ "mkValue: " ++ err Right v -> [| v |] where bs = TE.encodeUtf8 $ T.pack s -- | Like 'mkValue', but replace single quotes with double quotes before. -- -- > > $(mkValue' "{'a': 2 }") -- > Object (fromList [("a",Number 2.0)]) -- -- /Since: aeson-extra-0.3.1.0/ mkValue' :: String -> Q Exp mkValue' = mkValue . map f where f '\'' = '"' f x = x aeson-extra-0.5.1.3/test/0000755000000000000000000000000007346545000013254 5ustar0000000000000000aeson-extra-0.5.1.3/test/Orphans.hs0000644000000000000000000000062307346545000015223 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Orphans where #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif #if !MIN_VERSION_quickcheck_instances(0,3,12) import Data.Vector as V import Test.Tasty.QuickCheck instance Arbitrary a => Arbitrary (Vector a) where arbitrary = V.fromList <$> arbitrary shrink = fmap V.fromList . shrink . V.toList #endif aeson-extra-0.5.1.3/test/Tests.hs0000644000000000000000000001631207346545000014715 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-deprecations #-} module Main (main) where import Prelude () import Prelude.Compat import Data.Aeson import Data.Aeson.Extra import Data.Maybe (isJust) import Data.Proxy import Data.Vector (Vector) import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Orphans () main :: IO () main = defaultMain $ testGroup "Tests" [ dotColonMark , encodeStrictTests , symTests , singObjectTests , collapsedListTests , mergeTests , streamTests ] ------------------------------------------------------------------------------ -- encodeStrict ------------------------------------------------------------------------------ encodeStrictTests :: TestTree encodeStrictTests = testGroup "encodeStrict" [ testProperty "decodeStrict . encodeStrict" prop ] where prop :: Int -> Property prop i = let lhs = decodeStrict . encodeStrict $ i rhs = Just i in lhs === rhs ------------------------------------------------------------------------------ -- 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 , testProperty "Vector decode . encode" $ let prop :: Vector Int -> Property prop l = let rhs = fmap getCollapsedList . decode . encode . CollapsedList $ l lhs = Just l in lhs === rhs in prop ] ------------------------------------------------------------------------------- -- Stream ------------------------------------------------------------------------------- streamTests :: TestTree streamTests = testGroup "stream" [ streamDecodeTests ] where streamDecodeTests = testGroup "decode" $ map (uncurry validTestCase) valids ++ [ testCase "ws: empty" $ streamDecode " [ ] " @?= ([] :: [Int], Nothing) , testCase "ws: singleton" $ streamDecode " [ 1 ]" @?= ([1] :: [Int], Nothing) , testCase "ws: many" $ streamDecode " [ 1 , 2, 3 ] " @?= ([1,2,3] :: [Int], Nothing) -- Errors: , testCase "error begin" $ streamDecode' "," @?= ([] :: [Int], True) , testCase "parses first" $ streamDecode' "[1,2,3[" @?= ([1,2] :: [Int], True) , testCase "error begin" $ streamDecode' "[1,2,'a']" @?= ([1,2] :: [Int], True) ] validTestCase name v = testCase ("valid " ++ name) $ streamDecode (encode v) @?= (v, Nothing) streamDecode' = fmap isJust . streamDecode valids :: [(String, [Int])] valids = [ (,) "empty" [] , (,) "singleton" [1] , (,) "many" [1..200] ] ------------------------------------------------------------------------------ -- 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 "-" ------------------------------------------------------------------------------ -- Merge tests ------------------------------------------------------------------------------ mergeTests :: TestTree mergeTests = testGroup "Lodash merge examples" $ map f examples where f (x, y, z) = testCase "-" $ assertBool "should be equal" $ lodashMerge x y == z examples = [ (,,) $(mkValue "[1, 2, 3]") $(mkValue "[4, 5, 6, 7, 8]") $(mkValue "[4, 5, 6, 7, 8]") , (,,) $(mkValue' "{'a': 1}") $(mkValue' "{'b': 2}") $(mkValue' "{'a': 1, 'b': 2}") , (,,) $(mkValue' "{ 'data': [{ 'user': 'barney' }, { 'user': 'fred' }] }") $(mkValue' "{ 'data': [{ 'age': 36 }, { 'age': 40 }] }") $(mkValue' "{ 'data': [{ 'user': 'barney', 'age': 36 }, { 'user': 'fred', 'age': 40 }] }") ]