Merge pull request #1072 from haskell/decoding-text

Add Data.Aeson.Decoding.Text, decodeStrictText :: Text -> ...

Author: phadej

aeson.cabal

@@ -59,6 +59,7 @@ library
     Data.Aeson.Decoding
     Data.Aeson.Decoding.ByteString
     Data.Aeson.Decoding.ByteString.Lazy
+    Data.Aeson.Decoding.Text
     Data.Aeson.Decoding.Tokens
     Data.Aeson.Encoding
     Data.Aeson.Encoding.Internal
@@ -81,7 +82,9 @@ library
     Data.Aeson.Internal.Text
     Data.Aeson.Internal.TH
     Data.Aeson.Internal.Unescape
+    Data.Aeson.Internal.UnescapeFromText
     Data.Aeson.Internal.Word8
+    Data.Aeson.Internal.Word16
     Data.Aeson.Parser.Time
     Data.Aeson.Types.Class
     Data.Aeson.Types.FromJSON

benchmarks/bench/CompareWithJSON.hs

@@ -16,6 +16,8 @@ import qualified Data.Aeson.Text as A
 import qualified Data.Aeson.Parser.Internal as I
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
 import qualified Data.Text.Lazy          as TL
 import qualified Data.Text.Lazy.Builder  as TLB
 import qualified Data.Text.Lazy.Encoding as TLE
@@ -52,6 +54,12 @@ decodeS s = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrict s
 decodeS' :: BS.ByteString -> A.Value
 decodeS' s = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrict' s
 
+decodeT :: T.Text -> A.Value
+decodeT t = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrictText t
+
+decodeTviaBS :: T.Text -> A.Value
+decodeTviaBS t = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrict $ TE.encodeUtf8 t
+
 decodeAtto :: BL.ByteString -> A.Value
 decodeAtto s = fromMaybe (error "fail to parse via Parser.decodeWith") $
     I.decodeWith I.jsonEOF A.fromJSON s
@@ -82,9 +90,11 @@ benchmark =
   env (readL enFile) $ \enA ->
   env (readS enFile) $ \enS ->
   env (readStr enFile) $ \enJ ->
+  env (readT enFile) $ \enT ->
   env (readL jpFile) $ \jpA ->
   env (readS jpFile) $ \jpS ->
   env (readStr jpFile) $ \jpJ ->
+  env (readT jpFile) $ \jpT ->
   bgroup "compare-json" [
       bgroup "decode" [
         bgroup "whnf" [
@@ -94,6 +104,8 @@ benchmark =
         , bench "aeson/normal'"     $ whnf decode' enA
         , bench "aeson/strict"      $ whnf decodeS enS
         , bench "aeson/strict'"     $ whnf decodeS' enS
+        , bench "aeson/text"        $ whnf decodeT enT
+        , bench "aeson/text-via-bs" $ whnf decodeTviaBS enT
 
           -- attoparsec-aeson package
         , bench "aeson/atto"        $ whnf decodeAtto enA
@@ -123,6 +135,8 @@ benchmark =
       , bgroup "jp" [
           bench "aeson/normal"      $ whnf decode jpA
         , bench "aeson/strict"      $ whnf decodeS jpS
+        , bench "aeson/text"        $ whnf decodeT jpT
+        , bench "aeson/text-via-bs" $ whnf decodeTviaBS jpT
         , bench "json"              $ whnf decodeJ jpJ
         ]
       ]

benchmarks/bench/Utils.hs

@@ -13,21 +13,25 @@ import qualified Data.Aeson            as A
 import qualified Data.ByteString       as BS
 import qualified Data.ByteString.Char8 as BS8
 import qualified Data.ByteString.Lazy  as LBS
+import qualified Data.Text             as T
+import qualified Data.Text.Encoding    as TE
 
 readStr :: FilePath -> IO String
 readStr fp = do
-    dataDir <- lookupEnv "AESON_BENCH_DATADIR"
-    fmap BS8.unpack $ BS.readFile $ fromMaybe "json-data" dataDir </> fp
+    fmap BS8.unpack $ readS fp
 
 readS :: FilePath -> IO BS.ByteString
 readS fp = do
     dataDir <- lookupEnv "AESON_BENCH_DATADIR"
-    BS.readFile $ fromMaybe "json-data" dataDir </> fp
+    BS.readFile $ fromMaybe "benchmarks/json-data" dataDir </> fp
 
 readL :: FilePath -> IO LBS.ByteString
 readL fp = do
     dataDir <- lookupEnv "AESON_BENCH_DATADIR"
-    LBS.readFile $ fromMaybe "json-data" dataDir </> fp
+    LBS.readFile $ fromMaybe "benchmarks/json-data" dataDir </> fp
+
+readT :: FilePath -> IO T.Text
+readT fp = fmap TE.decodeUtf8 $ readS fp
 
 readV :: A.FromJSON a => FilePath -> IO a
 readV fileName = do

src/Data/Aeson.hs

@@ -55,10 +55,14 @@ module Data.Aeson
     , eitherDecodeFileStrict
     , eitherDecodeStrict'
     , eitherDecodeFileStrict'
+    -- ** Variants for strict text
+    , decodeStrictText
+    , eitherDecodeStrictText
     -- ** Exception throwing variants
     , AesonException (..)
     , throwDecode
     , throwDecodeStrict
+    , throwDecodeStrictText
     , throwDecode'
     , throwDecodeStrict'
     -- * Core JSON types
@@ -171,6 +175,7 @@ import Data.Aeson.Types
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
 import Data.Aeson.Decoding (decode, eitherDecode, throwDecode, decodeStrict, eitherDecodeStrict, throwDecodeStrict)
+import Data.Aeson.Decoding (decodeStrictText, eitherDecodeStrictText, throwDecodeStrictText)
 
 -- $setup
 -- >>> :set -XOverloadedStrings

src/Data/Aeson/Decoding.hs

@@ -9,6 +9,9 @@ module Data.Aeson.Decoding (
     decodeStrict,
     eitherDecodeStrict,
     throwDecodeStrict,
+    decodeStrictText,
+    eitherDecodeStrictText,
+    throwDecodeStrictText,
     toEitherValue,
     unescapeText,
 ) where
@@ -17,11 +20,13 @@ import           Control.Monad.Catch                 (MonadThrow (..))
 import           Data.Aeson.Types.Internal           (AesonException (..), formatError)
 
 import qualified Data.Aeson.Types                    as A
-import qualified Data.ByteString                     as B
-import qualified Data.ByteString.Lazy                as L
+import qualified Data.ByteString                     as BS
+import qualified Data.ByteString.Lazy                as LBS
+import qualified Data.Text                           as T
 
 import           Data.Aeson.Decoding.ByteString
 import           Data.Aeson.Decoding.ByteString.Lazy
+import           Data.Aeson.Decoding.Text
 import           Data.Aeson.Decoding.Conversion
 import           Data.Aeson.Internal.Unescape        (unescapeText)
 
@@ -32,23 +37,23 @@ import           Data.Aeson.Internal.Unescape        (unescapeText)
 -- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
 -- If this fails due to incomplete or invalid input, 'Nothing' is
 -- returned.
-decodeStrict :: (A.FromJSON a) => B.ByteString -> Maybe a
+decodeStrict :: (A.FromJSON a) => BS.ByteString -> Maybe a
 decodeStrict bs = unResult (toResultValue (bsToTokens bs)) (\_ -> Nothing) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | bsSpace bs' -> Just x
         | otherwise   -> Nothing
     A.IError _ _      -> Nothing
 
 -- | Like 'decodeStrict' but returns an error message when decoding fails.
-eitherDecodeStrict :: (A.FromJSON a) => B.ByteString -> Either String a
+eitherDecodeStrict :: (A.FromJSON a) => BS.ByteString -> Either String a
 eitherDecodeStrict bs = unResult (toResultValue (bsToTokens bs)) Left $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | bsSpace bs' -> Right x
         | otherwise   -> Left "Trailing garbage"
     A.IError path msg -> Left $ formatError path msg
 
 -- | Like 'decodeStrict' but throws an 'AesonException' when decoding fails.
-throwDecodeStrict :: forall a m. (A.FromJSON a, MonadThrow m) => B.ByteString -> m a
+throwDecodeStrict :: forall a m. (A.FromJSON a, MonadThrow m) => BS.ByteString -> m a
 throwDecodeStrict bs = unResult (toResultValue (bsToTokens bs)) (throwM . AesonException) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | bsSpace bs' -> pure x
@@ -62,15 +67,15 @@ throwDecodeStrict bs = unResult (toResultValue (bsToTokens bs)) (throwM . AesonE
 -- | Efficiently deserialize a JSON value from a lazy 'L.ByteString'.
 -- If this fails due to incomplete or invalid input, 'Nothing' is
 -- returned.
-decode :: (A.FromJSON a) => L.ByteString -> Maybe a
+decode :: (A.FromJSON a) => LBS.ByteString -> Maybe a
 decode bs = unResult (toResultValue (lbsToTokens bs)) (\_ -> Nothing) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | lbsSpace bs' -> Just x
         | otherwise    -> Nothing
     A.IError _ _       -> Nothing
 
 -- | Like 'decode' but returns an error message when decoding fails.
-eitherDecode :: (A.FromJSON a) => L.ByteString -> Either String a
+eitherDecode :: (A.FromJSON a) => LBS.ByteString -> Either String a
 eitherDecode bs = unResult (toResultValue (lbsToTokens bs)) Left $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | lbsSpace bs' -> Right x
@@ -80,9 +85,45 @@ eitherDecode bs = unResult (toResultValue (lbsToTokens bs)) Left $ \v bs' -> cas
 -- | Like 'decode' but throws an 'AesonException' when decoding fails.
 --
 -- 'throwDecode' is in @aeson@ since 2.1.2.0, but this variant is added later.
-throwDecode :: forall a m. (A.FromJSON a, MonadThrow m) => L.ByteString -> m a
+throwDecode :: forall a m. (A.FromJSON a, MonadThrow m) => LBS.ByteString -> m a
 throwDecode bs = unResult (toResultValue (lbsToTokens bs)) (throwM . AesonException) $ \v bs' -> case A.ifromJSON v of
     A.ISuccess x
         | lbsSpace bs'  -> pure x
         | otherwise    -> throwM $ AesonException "Trailing garbage"
     A.IError path msg  -> throwM $ AesonException $ formatError path msg
+
+-------------------------------------------------------------------------------
+-- Decoding: strict text
+-------------------------------------------------------------------------------
+
+-- | Efficiently deserialize a JSON value from a strict 'B.ByteString'.
+-- If this fails due to incomplete or invalid input, 'Nothing' is
+-- returned.
+--
+-- @since 2.2.1.0
+decodeStrictText :: (A.FromJSON a) => T.Text -> Maybe a
+decodeStrictText bs = unResult (toResultValue (textToTokens bs)) (\_ -> Nothing) $ \v bs' -> case A.ifromJSON v of
+    A.ISuccess x
+        | textSpace bs' -> Just x
+        | otherwise     -> Nothing
+    A.IError _ _        -> Nothing
+
+-- | Like 'decodeStrictText' but returns an error message when decoding fails.
+--
+-- @since 2.2.1.0
+eitherDecodeStrictText :: (A.FromJSON a) => T.Text -> Either String a
+eitherDecodeStrictText bs = unResult (toResultValue (textToTokens bs)) Left $ \v bs' -> case A.ifromJSON v of
+    A.ISuccess x
+        | textSpace bs' -> Right x
+        | otherwise     -> Left "Trailing garbage"
+    A.IError path msg   -> Left $ formatError path msg
+
+-- | Like 'decodeStrictText' but throws an 'AesonException' when decoding fails.
+--
+-- @since 2.2.1.0
+throwDecodeStrictText :: forall a m. (A.FromJSON a, MonadThrow m) => T.Text -> m a
+throwDecodeStrictText bs = unResult (toResultValue (textToTokens bs)) (throwM . AesonException) $ \v bs' -> case A.ifromJSON v of
+    A.ISuccess x
+        | textSpace bs' -> pure x
+        | otherwise     -> throwM $ AesonException "Trailing garbage"
+    A.IError path msg   -> throwM $ AesonException $ formatError path msg

src/Data/Aeson/Decoding/Conversion.hs

@@ -3,6 +3,8 @@
 module Data.Aeson.Decoding.Conversion (
     bsSpace,
     lbsSpace,
+    textSpace,
+    ltextSpace,
     toEitherValue,
     toResultValue,
     Result (..),
@@ -16,6 +18,8 @@ import qualified Data.Aeson.Types.Internal  as A
 import qualified Data.ByteString            as B
 import qualified Data.ByteString.Lazy       as L
 import qualified Data.Vector                as V
+import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT
 
 import           Data.Aeson.Decoding.Tokens
 
@@ -25,6 +29,12 @@ bsSpace = B.all (\w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09)
 lbsSpace :: L.ByteString -> Bool
 lbsSpace = L.all (\w -> w == 0x20 || w == 0x0a || w == 0x0d || w == 0x09)
 
+textSpace :: T.Text -> Bool
+textSpace = T.all (\c -> c == ' ' || c == '\r' || c == '\n' || c == '\t')
+
+ltextSpace :: LT.Text -> Bool
+ltextSpace = LT.all (\c -> c == ' ' || c == '\r' || c == '\n' || c == '\t')
+
 -- | Convert 'Tokens' to 'A.Value'.
 --
 -- The resulting value will be in normal form if its forced.