git.iko.soy/typeable/aeson
on master help sign in
Capture and report failure properly during unescaping
70cd4b7Bryan O'Sullivan
Data/Aeson/Parser.hs+21−20
compare with master
unifiedsplit
@@ -19,7 +19,6 @@ import Blaze.ByteString.Builder (fromByteString, toByteString)
19import Blaze.ByteString.Builder.Char.Utf8 (fromChar)
19import Blaze.ByteString.Builder.Char.Utf8 (fromChar)
20import Blaze.ByteString.Builder.Word (fromWord8)
20import Blaze.ByteString.Builder.Word (fromWord8)
21import Control.Applicative as A
21import Control.Applicative as A
22−import Control.Monad (when)
23import Data.Aeson.Types (Value(..))
22import Data.Aeson.Types (Value(..))
24import Data.Attoparsec.Char8
23import Data.Attoparsec.Char8
25import Data.Bits ((.|.), shiftL)
24import Data.Bits ((.|.), shiftL)
@@ -103,8 +102,8 @@ reparse p s = case parse p s `feed` "" of
103 _ -> fail "unexpected failure"
102 _ -> fail "unexpected failure"
104
103
105unescape :: Parser ByteString
104unescape :: Parser ByteString
106−unescape = toByteString <$> go mempty where
105+unescape = toByteString <$> go (Right mempty) where
107− go acc = do
106+ go (Right acc) = do
108 h <- A.takeWhile (/=backslash)
107 h <- A.takeWhile (/=backslash)
109 let rest = do
108 let rest = do
110 start <- A.take 2
109 start <- A.take 2
@@ -113,24 +112,26 @@ unescape = toByteString <$> go mempty where
113 escape = case B.findIndex (==t) "\"\\/ntbrfu" of
112 escape = case B.findIndex (==t) "\"\\/ntbrfu" of
114 Just i -> i
113 Just i -> i
115 _ -> 255
114 _ -> 255
116− when (slash /= backslash || escape == 255) $
115+ if slash /= backslash || escape == 255
117− fail "invalid JSON escape sequence"
116+ then go (Left "invalid JSON escape sequence")
117+ else flip (<|>) (go (Left "invalid Unicode escape sequence")) $ do
118− let continue m = go (acc `mappend` fromByteString h `mappend` m)
118+ let cont m = go (Right (acc `mappend` fromByteString h `mappend` m))
119− {-# INLINE continue #-}
119+ {-# INLINE cont #-}
120− if t /= 117 -- 'u'
120+ if t /= 117 -- 'u'
121− then continue (fromWord8 (B.unsafeIndex mapping escape))
121+ then cont (fromWord8 (B.unsafeIndex mapping escape))
122− else do
122+ else do
123− a <- hexQuad
123+ a <- hexQuad
124− if a < 0xd800 || a > 0xdfff
124+ if a < 0xd800 || a > 0xdfff
125− then continue (fromChar (chr a))
125+ then cont (fromChar (chr a))
126− else do
126+ else do
127− b <- string "\\u" *> hexQuad
127+ b <- string "\\u" *> hexQuad
128− if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
128+ if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
129− then let !c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
129+ then let !c = ((a - 0xd800) `shiftL` 10) +
130− 0x10000
130+ (b - 0xdc00) + 0x10000
131− in continue (fromChar (chr c))
131+ in cont (fromChar (chr c))
132− else fail "invalid UTF-16 surrogates"
132+ else fail "invalid UTF-16 surrogates"
133 rest <|> return (acc `mappend` fromByteString h)
133 rest <|> return (acc `mappend` fromByteString h)
134+ go (Left err) = fail err
134 mapping = "\"\\/\n\t\b\r\f"
135 mapping = "\"\\/\n\t\b\r\f"
135
136
136hexQuad :: Parser Int
137hexQuad :: Parser Int