@@ -19,7 +19,6 @@ import Blaze.ByteString.Builder (fromByteString, toByteString)
1919import Blaze.ByteString.Builder.Char.Utf8 (fromChar)
2020import Blaze.ByteString.Builder.Word (fromWord8)
2121import Control.Applicative as A
22−import Control.Monad (when)
2322import Data.Aeson.Types (Value(..))
2423import Data.Attoparsec.Char8
2524import Data.Bits ((.|.), shiftL)
@@ -103,8 +102,8 @@ reparse p s = case parse p s `feed` "" of
103102 _ -> fail "unexpected failure"
104103
105104unescape :: Parser ByteString
106−unescape = toByteString <$> go mempty where
107− go acc = do
105+unescape = toByteString <$> go (Right mempty) where
106+ go (Right acc) = do
108107 h <- A.takeWhile (/=backslash)
109108 let rest = do
110109 start <- A.take 2
@@ -113,24 +112,26 @@ unescape = toByteString <$> go mempty where
113112 escape = case B.findIndex (==t) "\"\\/ntbrfu" of
114113 Just i -> i
115114 _ -> 255
116− when (slash /= backslash || escape == 255) $
117− fail "invalid JSON escape sequence"
118− let continue m = go (acc `mappend` fromByteString h `mappend` m)
119− {-# INLINE continue #-}
120− if t /= 117 -- 'u'
121− then continue (fromWord8 (B.unsafeIndex mapping escape))
122− else do
123− a <- hexQuad
124− if a < 0xd800 || a > 0xdfff
125− then continue (fromChar (chr a))
126− else do
127− b <- string "\\u" *> hexQuad
128− if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
129− then let !c = ((a - 0xd800) `shiftL` 10) + (b - 0xdc00) +
130− 0x10000
131− in continue (fromChar (chr c))
132− else fail "invalid UTF-16 surrogates"
115+ if slash /= backslash || escape == 255
116+ then go (Left "invalid JSON escape sequence")
117+ else flip (<|>) (go (Left "invalid Unicode escape sequence")) $ do
118+ let cont m = go (Right (acc `mappend` fromByteString h `mappend` m))
119+ {-# INLINE cont #-}
120+ if t /= 117 -- 'u'
121+ then cont (fromWord8 (B.unsafeIndex mapping escape))
122+ else do
123+ a <- hexQuad
124+ if a < 0xd800 || a > 0xdfff
125+ then cont (fromChar (chr a))
126+ else do
127+ b <- string "\\u" *> hexQuad
128+ if a <= 0xdbff && b >= 0xdc00 && b <= 0xdfff
129+ then let !c = ((a - 0xd800) `shiftL` 10) +
130+ (b - 0xdc00) + 0x10000
131+ in cont (fromChar (chr c))
132+ else fail "invalid UTF-16 surrogates"
133133 rest <|> return (acc `mappend` fromByteString h)
134+ go (Left err) = fail err
134135 mapping = "\"\\/\n\t\b\r\f"
135136
136137hexQuad :: Parser Int