git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #589 from binarysunrise-io/embedded-json-string-helper

Add a helper for decoding embedded json strings

commitc638d1287cc6abd73b55abb3e956e6acf95604de authorAdam Bergmark <adam@bergmark.nl> dateFri 13 Oct 2017, 11:12 (9 years ago) parentf3495ecff1fc5a
7 files changed+49−1
compare with master
unifiedsplit
Data/Aeson.hs+1 Data/Aeson/Compat.hs+16 Data/Aeson/Types.hs+1 Data/Aeson/Types/Class.hs+1 Data/Aeson/Types/FromJSON.hs+13 aeson.cabal+1 tests/UnitTests.hs+16−1
Data/Aeson.hs+1
@@ -111,6 +111,7 @@ module Data.Aeson
111111 , withNumber
112112 , withScientific
113113 , withBool
114+ , withEmbeddedJSON
114115 -- * Constructors and accessors
115116 , Series
116117 , pairs
Data/Aeson/Compat.hsnew file+16
@@ -0,0 +1,16 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Data.Aeson.Compat
4+ (
5+ fromStrict
6+ ) where
7+
8+import qualified Data.ByteString as S
9+import qualified Data.ByteString.Lazy as L
10+
11+fromStrict :: S.ByteString -> L.ByteString
12+#if MIN_VERSION_bytestring(0, 9, 2)
13+fromStrict = L.fromChunks . (:[])
14+#else
15+fromStrict = L.fromStrict
16+#endif
Data/Aeson/Types.hs+1
@@ -84,6 +84,7 @@ module Data.Aeson.Types
8484 , withNumber
8585 , withScientific
8686 , withBool
87+ , withEmbeddedJSON
8788
8889 , pairs
8990 , foldable
Data/Aeson/Types/Class.hs+1
@@ -73,6 +73,7 @@ module Data.Aeson.Types.Class
7373 , withNumber
7474 , withScientific
7575 , withBool
76+ , withEmbeddedJSON
7677
7778 -- * Functions
7879 , fromJSON
Data/Aeson/Types/FromJSON.hs+13
@@ -55,6 +55,7 @@ module Data.Aeson.Types.FromJSON
5555 , withNumber
5656 , withScientific
5757 , withBool
58+ , withEmbeddedJSON
5859
5960 -- * Functions
6061 , fromJSON
@@ -82,6 +83,7 @@ import Prelude.Compat
8283import Control.Applicative ((<|>), Const(..))
8384import Control.Monad ((<=<), zipWithM)
8485import Data.Aeson.Internal.Functions (mapKey)
86+import Data.Aeson.Parser.Internal (eitherDecodeWith, jsonEOF)
8587import Data.Aeson.Types.Generic
8688import Data.Aeson.Types.Internal
8789import Data.Attoparsec.Number (Number(..))
@@ -114,6 +116,7 @@ import GHC.Generics
114116import Numeric.Natural (Natural)
115117import Text.ParserCombinators.ReadP (readP_to_S)
116118import Unsafe.Coerce (unsafeCoerce)
119+import qualified Data.Aeson.Compat as Compat
117120import qualified Data.Aeson.Parser.Time as Time
118121import qualified Data.Attoparsec.ByteString.Char8 as A (endOfInput, parseOnly, scientific)
119122import qualified Data.DList as DList
@@ -665,6 +668,16 @@ withBool _ f (Bool arr) = f arr
665668withBool expected _ v = typeMismatch expected v
666669{-# INLINE withBool #-}
667670
671+-- | Decode a nested JSON-encoded string.
672+withEmbeddedJSON :: (FromJSON a) => String -> (Value -> Parser a) -> Value -> Parser a
673+withEmbeddedJSON _ innerParser (String txt) =
674+ either fail innerParser $ eitherDecode (Compat.fromStrict $ T.encodeUtf8 txt)
675+ where
676+ eitherDecode = eitherFormatError . eitherDecodeWith jsonEOF ifromJSON
677+ eitherFormatError = either (Left . uncurry formatError) Right
678+withEmbeddedJSON name _ v = typeMismatch name v
679+{-# INLINE withEmbeddedJSON #-}
680+
668681-- | Convert a value from JSON, failing if the types do not match.
669682fromJSON :: (FromJSON a) => Value -> Result a
670683fromJSON = parse parseJSON
aeson.cabal+1
@@ -100,6 +100,7 @@ library
100100 Data.Aeson.Encode
101101
102102 other-modules:
103+ Data.Aeson.Compat
103104 Data.Aeson.Encoding.Builder
104105 Data.Aeson.Internal.Functions
105106 Data.Aeson.Parser.Unescape
tests/UnitTests.hs+16−1
@@ -16,13 +16,14 @@ module UnitTests
1616 (
1717 ioTests
1818 , tests
19+ , withEmbeddedJSONTest
1920 ) where
2021
2122import Prelude ()
2223import Prelude.Compat
2324
2425import Control.Monad (forM, forM_)
25−import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), FromJSONKeyFunction(..), FromJSONKey(..), ToJSON1(..), decode, eitherDecode, encode, fromJSON, genericParseJSON, genericToEncoding, genericToJSON, object, withObject)
26+import Data.Aeson ((.=), (.:), (.:?), (.:!), FromJSON(..), FromJSONKeyFunction(..), FromJSONKey(..), ToJSON1(..), decode, eitherDecode, encode, fromJSON, genericParseJSON, genericToEncoding, genericToJSON, object, withObject, withEmbeddedJSON)
2627import Data.Aeson.Internal (JSONPathElement(..), formatError)
2728import Data.Aeson.TH (deriveJSON, deriveToJSON, deriveToJSON1)
2829import Data.Aeson.Text (encodeToTextBuilder)
@@ -97,6 +98,7 @@ tests = testGroup "unit" [
9798 , testCase "Unescape string (PR #477)" unescapeString
9899 , testCase "Show Options" showOptions
99100 , testGroup "SingleMaybeField" singleMaybeField
101+ , testCase "withEmbeddedJSON" withEmbeddedJSONTest
100102 ]
101103
102104roundTripCamel :: String -> Assertion
@@ -519,6 +521,19 @@ singleMaybeField = do
519521 v = SingleMaybeField Nothing
520522 opts = defaultOptions{omitNothingFields=True,unwrapUnaryRecords=True}
521523
524+
525+newtype EmbeddedJSONTest = EmbeddedJSONTest Int
526+ deriving (Eq, Show)
527+
528+instance FromJSON EmbeddedJSONTest where
529+ parseJSON =
530+ withObject "Object" $ \o ->
531+ EmbeddedJSONTest <$> (o .: "prop" >>= withEmbeddedJSON "Quoted Int" parseJSON)
532+
533+withEmbeddedJSONTest :: Assertion
534+withEmbeddedJSONTest =
535+ assertEqual "Unquote embedded JSON" (Right $ EmbeddedJSONTest 1) (eitherDecode "{\"prop\":\"1\"}")
536+
522537deriveJSON defaultOptions{omitNothingFields=True} ''MyRecord
523538
524539deriveToJSON defaultOptions ''Foo