From d64dd4ffffae534068505b83986c8d95f8cbc3bb Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 22 Oct 2023 22:05:12 +0300 Subject: [PATCH] Use pattern synonyms from character-ps --- aeson.cabal | 12 +- attoparsec-aeson/attoparsec-aeson.cabal | 10 +- .../src/Data/Aeson/Parser/Internal.hs | 68 +++++------ changelog.md | 4 + src/Data/Aeson/Decoding/ByteString.hs | 92 +++++++------- src/Data/Aeson/Decoding/ByteString/Lazy.hs | 80 ++++++------ src/Data/Aeson/Decoding/Text.hs | 115 +++++++++--------- src/Data/Aeson/Internal/Word16.hs | 76 ------------ src/Data/Aeson/Internal/Word8.hs | 74 ----------- src/Data/Aeson/RFC8785.hs | 28 ++--- 10 files changed, 205 insertions(+), 354 deletions(-) delete mode 100644 src/Data/Aeson/Internal/Word16.hs delete mode 100644 src/Data/Aeson/Internal/Word8.hs diff --git a/aeson.cabal b/aeson.cabal index 0eb232a56..9f17d782f 100644 --- a/aeson.cabal +++ b/aeson.cabal @@ -1,7 +1,7 @@ +cabal-version: 2.2 name: aeson -version: 2.2.1.0 -x-revision: 1 -license: BSD3 +version: 2.2.2.0 +license: BSD-3-Clause license-file: LICENSE category: Text, Web, JSON copyright: @@ -24,7 +24,6 @@ tested-with: || ==9.8.1 synopsis: Fast JSON parsing and encoding -cabal-version: 1.12 homepage: https://github.com/haskell/aeson bug-reports: https://github.com/haskell/aeson/issues build-type: Simple @@ -85,8 +84,6 @@ library 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 @@ -119,7 +116,8 @@ library -- Other dependencies build-depends: - data-fix >=0.3.2 && <0.4 + , character-ps ^>=0.1 + , data-fix >=0.3.2 && <0.4 , dlist >=1.0 && <1.1 , hashable >=1.4.2.0 && <1.5 , indexed-traversable >=0.1.2 && <0.2 diff --git a/attoparsec-aeson/attoparsec-aeson.cabal b/attoparsec-aeson/attoparsec-aeson.cabal index dc24f3cf5..781559639 100644 --- a/attoparsec-aeson/attoparsec-aeson.cabal +++ b/attoparsec-aeson/attoparsec-aeson.cabal @@ -1,11 +1,11 @@ -cabal-version: 1.12 +cabal-version: 2.2 name: attoparsec-aeson -version: 2.2.0.1 +version: 2.2.1.0 synopsis: Parsing of aeson's Value with attoparsec description: Parsing of aeson's Value with attoparsec, originally from aeson. -license: BSD3 +license: BSD-3-Clause license-file: LICENSE category: Parsing copyright: @@ -41,13 +41,13 @@ library other-modules: Data.Aeson.Internal.ByteString Data.Aeson.Internal.Text - Data.Aeson.Internal.Word8 build-depends: - aeson >=2.2.0.0 && <2.3 + , aeson >=2.2.0.0 && <2.3 , attoparsec >=0.14.2 && <0.15 , base >=4.10.0.0 && <5 , bytestring >=0.10.8.2 && <0.13 + , character-ps ^>=0.1 , integer-conversion >=0.1 && <0.2 , primitive >=0.8.0.0 && <0.10 , scientific >=0.3.7.0 && <0.4 diff --git a/attoparsec-aeson/src/Data/Aeson/Parser/Internal.hs b/attoparsec-aeson/src/Data/Aeson/Parser/Internal.hs index c44f241e0..539d5f5f0 100644 --- a/attoparsec-aeson/src/Data/Aeson/Parser/Internal.hs +++ b/attoparsec-aeson/src/Data/Aeson/Parser/Internal.hs @@ -70,11 +70,11 @@ import qualified Data.ByteString.Lazy.Char8 as C import qualified Data.ByteString.Unsafe as B import qualified Data.Scientific as Sci import qualified Data.Vector as Vector (empty, fromList, fromListN, reverse) +import qualified Data.Word8.Patterns as W8 import Data.Aeson.Types (IResult(..), JSONPath, Object, Result(..), Value(..), Key) import Data.Aeson.Internal.Text import Data.Aeson.Decoding (unescapeText) -import Data.Aeson.Internal.Word8 -- $setup -- >>> :set -XOverloadedStrings @@ -142,7 +142,7 @@ objectValues :: ([(Key, Value)] -> Either String Object) objectValues mkObject str val = do skipSpace w <- A.peekWord8' - if w == W8_CLOSE_CURLY + if w == W8.RIGHT_CURLY then A.anyWord8 >> return KM.empty else loop [] where @@ -153,9 +153,9 @@ objectValues mkObject str val = do loop acc = do k <- (str A. "object key") <* skipSpace <* (char ':' A. "':'") v <- (val A. "object value") <* skipSpace - ch <- A.satisfy (\w -> w == W8_COMMA || w == W8_CLOSE_CURLY) A. "',' or '}'" + ch <- A.satisfy (\w -> w == W8.COMMA || w == W8.RIGHT_CURLY) A. "',' or '}'" let acc' = (k, v) : acc - if ch == W8_COMMA + if ch == W8.COMMA then skipSpace >> loop acc' else case mkObject acc' of Left err -> fail err @@ -176,14 +176,14 @@ arrayValues :: Parser Value -> Parser (Vector Value) arrayValues val = do skipSpace w <- A.peekWord8' - if w == W8_CLOSE_SQUARE + if w == W8.RIGHT_SQUARE then A.anyWord8 >> return Vector.empty else loop [] 1 where loop acc !len = do v <- (val A. "json list value") <* skipSpace - ch <- A.satisfy (\w -> w == W8_COMMA || w == W8_CLOSE_SQUARE) A. "',' or ']'" - if ch == W8_COMMA + ch <- A.satisfy (\w -> w == W8.COMMA || w == W8.RIGHT_SQUARE) A. "',' or ']'" + if ch == W8.COMMA then skipSpace >> loop (v:acc) (len+1) else return (Vector.reverse (Vector.fromListN len (v:acc))) {-# INLINE arrayValues #-} @@ -230,13 +230,13 @@ jsonWith mkObject = fix $ \value_ -> do skipSpace w <- A.peekWord8' case w of - W8_DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_) - W8_OPEN_CURLY -> A.anyWord8 *> object_ mkObject value_ - W8_OPEN_SQUARE -> A.anyWord8 *> array_ value_ - W8_f -> string "false" $> Bool False - W8_t -> string "true" $> Bool True - W8_n -> string "null" $> Null - _ | w >= W8_0 && w <= W8_9 || w == W8_MINUS + W8.DOUBLE_QUOTE -> A.anyWord8 *> (String <$> jstring_) + W8.LEFT_CURLY -> A.anyWord8 *> object_ mkObject value_ + W8.LEFT_SQUARE -> A.anyWord8 *> array_ value_ + W8.LOWER_F -> string "false" $> Bool False + W8.LOWER_T -> string "true" $> Bool True + W8.LOWER_N -> string "null" $> Null + _ | w >= W8.DIGIT_0 && w <= W8.DIGIT_9 || w == W8.HYPHEN -> Number <$> scientific | otherwise -> fail "not a valid json value" {-# INLINE jsonWith #-} @@ -282,15 +282,15 @@ jsonWith' mkObject = fix $ \value_ -> do skipSpace w <- A.peekWord8' case w of - W8_DOUBLE_QUOTE -> do + W8.DOUBLE_QUOTE -> do !s <- A.anyWord8 *> jstring_ return (String s) - W8_OPEN_CURLY -> A.anyWord8 *> object_' mkObject value_ - W8_OPEN_SQUARE -> A.anyWord8 *> array_' value_ - W8_f -> string "false" $> Bool False - W8_t -> string "true" $> Bool True - W8_n -> string "null" $> Null - _ | w >= W8_0 && w <= W8_9 || w == W8_MINUS + W8.LEFT_CURLY -> A.anyWord8 *> object_' mkObject value_ + W8.LEFT_SQUARE -> A.anyWord8 *> array_' value_ + W8.LOWER_F -> string "false" $> Bool False + W8.LOWER_T -> string "true" $> Bool True + W8.LOWER_N -> string "null" $> Null + _ | w >= W8.DIGIT_0 && w <= W8.DIGIT_9 || w == W8.HYPHEN -> do !n <- scientific return (Number n) @@ -312,7 +312,7 @@ jsonNoDup' = jsonWith' parseListNoDup -- | Parse a quoted JSON string. jstring :: Parser Text -jstring = A.word8 W8_DOUBLE_QUOTE *> jstring_ +jstring = A.word8 W8.DOUBLE_QUOTE *> jstring_ -- | Parse a JSON Key key :: Parser Key @@ -322,11 +322,11 @@ key = Key.fromText <$> jstring jstring_ :: Parser Text {-# INLINE jstring_ #-} jstring_ = do - s <- A.takeWhile (\w -> w /= W8_DOUBLE_QUOTE && w /= W8_BACKSLASH && w >= 0x20 && w < 0x80) + s <- A.takeWhile (\w -> w /= W8.DOUBLE_QUOTE && w /= W8.BACKSLASH && w >= 0x20 && w < 0x80) mw <- A.peekWord8 case mw of Nothing -> fail "string without end" - Just W8_DOUBLE_QUOTE -> A.anyWord8 $> unsafeDecodeASCII s + Just W8.DOUBLE_QUOTE -> A.anyWord8 $> unsafeDecodeASCII s Just w | w < 0x20 -> fail "unescaped control character" _ -> jstringSlow s @@ -341,8 +341,8 @@ jstringSlow s' = do startState = False go a c | a = Just False - | c == W8_DOUBLE_QUOTE = Nothing - | otherwise = let a' = c == W8_BACKSLASH + | c == W8.DOUBLE_QUOTE = Nothing + | otherwise = let a' = c == W8.BACKSLASH in Just a' decodeWith :: Parser Value -> (Value -> Result a) -> L.ByteString -> Maybe a @@ -438,7 +438,7 @@ jsonEOF' = json' <* skipSpace <* endOfInput -- | The only valid whitespace in a JSON document is space, newline, -- carriage return, and tab. skipSpace :: Parser () -skipSpace = A.skipWhile $ \w -> w == W8_SPACE || w == W8_NL || w == W8_CR || w == W8_TAB +skipSpace = A.skipWhile $ \w -> w == W8.SPACE || w == W8.LF || w == W8.CR || w == W8.TAB {-# INLINE skipSpace #-} ------------------ Copy-pasted and adapted from attoparsec ------------------ @@ -449,7 +449,7 @@ data SP = SP !Integer {-# UNPACK #-}!Int decimal0 :: Parser Integer decimal0 = do digits <- A.takeWhile1 isDigit_w8 - if B.length digits > 1 && B.unsafeHead digits == W8_0 + if B.length digits > 1 && B.unsafeHead digits == W8.DIGIT_0 then fail "leading zero" else return (byteStringToInteger digits) @@ -457,25 +457,25 @@ decimal0 = do scientific :: Parser Scientific scientific = do sign <- A.peekWord8' - let !positive = not (sign == W8_MINUS) - when (sign == W8_PLUS || sign == W8_MINUS) $ + let !positive = not (sign == W8.HYPHEN) + when (sign == W8.PLUS || sign == W8.HYPHEN) $ void A.anyWord8 n <- decimal0 let f fracDigits = SP (B.foldl' step n fracDigits) (negate $ B.length fracDigits) - step a w = a * 10 + fromIntegral (w - W8_0) + step a w = a * 10 + fromIntegral (w - W8.DIGIT_0) dotty <- A.peekWord8 SP c e <- case dotty of - Just W8_DOT -> A.anyWord8 *> (f <$> A.takeWhile1 isDigit_w8) - _ -> pure (SP n 0) + Just W8.PERIOD -> A.anyWord8 *> (f <$> A.takeWhile1 isDigit_w8) + _ -> pure (SP n 0) let !signedCoeff | positive = c | otherwise = -c - (A.satisfy (\ex -> case ex of W8_e -> True; W8_E -> True; _ -> False) *> + (A.satisfy (\ex -> case ex of W8.LOWER_E -> True; W8.UPPER_E -> True; _ -> False) *> fmap (Sci.scientific signedCoeff . (e +)) (signed decimal)) <|> return (Sci.scientific signedCoeff e) {-# INLINE scientific #-} diff --git a/changelog.md b/changelog.md index 5137e46af..41375d2fa 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,9 @@ For the latest version of this document, please see [https://github.com/haskell/aeson/blob/master/changelog.md](https://github.com/haskell/aeson/blob/master/changelog.md). +### next + +* Depend on `character-ps` instead of defining own Word8 pattern synonyms + ### 2.2.1.0 * Add `Data.Aeson.RFC8785`, a JSON Canonicalization Scheme implementation diff --git a/src/Data/Aeson/Decoding/ByteString.hs b/src/Data/Aeson/Decoding/ByteString.hs index d7a9582a5..6ba082bbe 100644 --- a/src/Data/Aeson/Decoding/ByteString.hs +++ b/src/Data/Aeson/Decoding/ByteString.hs @@ -18,12 +18,12 @@ import qualified Data.Aeson.Key as Key import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS.Unsafe import qualified Data.Scientific as Sci +import qualified Data.Word8.Patterns as W8 import Data.Aeson.Decoding.Internal import Data.Aeson.Decoding.Tokens import Data.Aeson.Internal.Text (unsafeDecodeASCII) import Data.Aeson.Internal.Unescape (unescapeText) -import Data.Aeson.Internal.Word8 -- | Lex (and parse) strict 'ByteString' into 'Tokens' stream. -- @@ -42,17 +42,17 @@ bsToTokens bs0 = goT bs0 id where -> ByteString -- whole input, needed for number parsing -> (ByteString -> k) -- continuation -> Tokens k String - tokenCase W8_OPEN_CURLY !bs !_ k = TkRecordOpen (goR bs k) - tokenCase W8_OPEN_SQUARE bs _ k = TkArrayOpen (goA bs k) - tokenCase W8_DOUBLE_QUOTE bs _ k = scanStringLiteral (\t bs' -> TkText t (k bs')) tkErr bs - tokenCase W8_MINUS bs _ k = scanNumberLiteral (\n bs' -> TkNumber (negateNumber n) (k bs')) tkErr bs + tokenCase W8.LEFT_CURLY !bs !_ k = TkRecordOpen (goR bs k) + tokenCase W8.LEFT_SQUARE bs _ k = TkArrayOpen (goA bs k) + tokenCase W8.DOUBLE_QUOTE bs _ k = scanStringLiteral (\t bs' -> TkText t (k bs')) tkErr bs + tokenCase W8.HYPHEN bs _ k = scanNumberLiteral (\n bs' -> TkNumber (negateNumber n) (k bs')) tkErr bs tokenCase w _ wbs k - | W8_0 <= w, w <= W8_9 = scanNumberLiteral (\n bs' -> TkNumber n (k bs')) tkErr wbs - tokenCase W8_n bs _ k + | W8.DIGIT_0 <= w, w <= W8.DIGIT_9 = scanNumberLiteral (\n bs' -> TkNumber n (k bs')) tkErr wbs + tokenCase W8.LOWER_N bs _ k | Just bs1 <- stripPrefix "ull" 3 bs = TkLit LitNull (k bs1) - tokenCase W8_t bs _ k + tokenCase W8.LOWER_T bs _ k | Just bs1 <- stripPrefix "rue" 3 bs = TkLit LitTrue (k bs1) - tokenCase W8_f bs _ k + tokenCase W8.LOWER_F bs _ k | Just bs1 <- stripPrefix "alse" 4 bs = TkLit LitFalse (k bs1) tokenCase _ _ wbs _ = tkErr $ "Unexpected " ++ showBeginning wbs ++ ", expecting JSON value" @@ -60,33 +60,33 @@ bsToTokens bs0 = goT bs0 id where goA :: Parser TkArray k goA (skipSpace -> bs) k = case BS.uncons bs of Nothing -> tkErrEOF "JSON value or ]" - Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1) + Just (W8.RIGHT_SQUARE, !bs1) -> TkArrayEnd (k bs1) Just (w, !bs1) -> TkItem $ tokenCase w bs1 bs $ \bs2 -> goA1 bs2 k goA1 :: Parser TkArray k goA1 (skipSpace -> bs) k = case BS.uncons bs of Nothing -> tkErrEOF ", or ]" - Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1) - Just (W8_COMMA, !bs1) -> TkItem $ goT bs1 $ \bs2 -> goA1 bs2 k + Just (W8.RIGHT_SQUARE, !bs1) -> TkArrayEnd (k bs1) + Just (W8.COMMA, !bs1) -> TkItem $ goT bs1 $ \bs2 -> goA1 bs2 k _ -> tkErrBS bs ", or ]" -- Record goR :: Parser TkRecord k goR (skipSpace -> bs) k = case BS.uncons bs of Nothing -> tkErrEOF "record key literal or }" - Just (W8_DOUBLE_QUOTE, !bs1) -> goRK bs1 k -- " - Just (W8_CLOSE_CURLY, !bs1) -> TkRecordEnd (k bs1) -- } + Just (W8.DOUBLE_QUOTE, !bs1) -> goRK bs1 k -- " + Just (W8.RIGHT_CURLY, !bs1) -> TkRecordEnd (k bs1) -- } Just _ -> tkErrBS bs "record key literal or }" -- after record pair, expecting ," or } goR1 :: Parser TkRecord k goR1 (skipSpace -> bs) k = case BS.uncons bs of Nothing -> tkErr "Unexpected end-of-input, expecting , or }" - Just (W8_COMMA, !bs1) -> case BS.uncons (skipSpace bs1) of + Just (W8.COMMA, !bs1) -> case BS.uncons (skipSpace bs1) of Nothing -> tkErrEOF "key literal" - Just (W8_DOUBLE_QUOTE, !bs2) -> goRK bs2 k + Just (W8.DOUBLE_QUOTE, !bs2) -> goRK bs2 k Just _ -> tkErrBS bs "key literal" - Just (W8_CLOSE_CURLY, !bs1) -> TkRecordEnd (k bs1) + Just (W8.RIGHT_CURLY, !bs1) -> TkRecordEnd (k bs1) _ -> tkErr $ "Unexpected " ++ showBeginning bs ++ ", expecting , or }" -- key of record (after double quote) @@ -97,7 +97,7 @@ bsToTokens bs0 = goT bs0 id where goRK' :: Text -> Parser TkRecord k goRK' t (skipSpace -> bs) k = case BS.uncons bs of Nothing -> tkErrEOF ":" - Just (W8_COLON, !bs3) -> TkPair (Key.fromText t) $ goT bs3 $ \bs4 -> goR1 bs4 k + Just (W8.COLON, !bs3) -> TkPair (Key.fromText t) $ goT bs3 $ \bs4 -> goR1 bs4 k Just _ -> tkErrBS bs ":" stripPrefix :: ByteString -> Int -> ByteString -> Maybe ByteString @@ -187,27 +187,27 @@ scanNumberLiteral kont err bs0 = state_start bs0 where state_start !bs = case BS.uncons bs of Nothing -> errEnd Just (w8, bs') - | W8_0 < w8, w8 <= W8_9 -> state_i1 1 bs' - | W8_0 == w8 -> state_after0 bs' - | otherwise -> err $ "Unexpected " ++ show w8 ++ " while parsing number literal" + | W8.DIGIT_0 < w8, w8 <= W8.DIGIT_9 -> state_i1 1 bs' + | W8.DIGIT_0 == w8 -> state_after0 bs' + | otherwise -> err $ "Unexpected " ++ show w8 ++ " while parsing number literal" state_after0 :: ByteString -> r state_after0 !bs = case BS.uncons bs of Nothing -> kont (NumInteger 0) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> err "Number literal with leading zero" - | W8_DOT == w8 -> go_dec 0 bs' - | W8_e == w8 || W8_E == w8 -> go_sci 0 0 bs' - | otherwise -> kont (NumInteger 0) bs + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> err "Number literal with leading zero" + | W8.PERIOD == w8 -> go_dec 0 bs' + | W8.LOWER_E == w8 || W8.UPPER_E == w8 -> go_sci 0 0 bs' + | otherwise -> kont (NumInteger 0) bs state_i1 :: Int -> ByteString -> r state_i1 !n !bs = case BS.uncons bs of Nothing -> kont (NumInteger int) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_i1 (n + 1) bs' - | W8_DOT == w8 -> go_dec int bs' - | W8_e == w8 || W8_E == w8 -> go_sci int 0 bs' - | otherwise -> kont (NumInteger int) bs + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> state_i1 (n + 1) bs' + | W8.PERIOD == w8 -> go_dec int bs' + | W8.LOWER_E == w8 || W8.UPPER_E == w8 -> go_sci int 0 bs' + | otherwise -> kont (NumInteger int) bs where int = byteStringToInteger (BS.Unsafe.unsafeTake n bs0) @@ -215,16 +215,16 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_dec !int !bs1 = case BS.uncons bs1 of Nothing -> errEnd Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_dec 1 bs' - | otherwise -> err $ "Unexpected " ++ show w8 ++ " while parsing number literal" + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> state_dec 1 bs' + | otherwise -> err $ "Unexpected " ++ show w8 ++ " while parsing number literal" where state_dec :: Int -> ByteString -> r state_dec !n !bs = case BS.uncons bs of Nothing -> kont (NumDecimal dec) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_dec (n + 1) bs' - | W8_e == w8 || W8_E == w8 -> go_sci coef (negate n) bs' - | otherwise -> kont (NumDecimal dec) bs + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> state_dec (n + 1) bs' + | W8.LOWER_E == w8 || W8.UPPER_E == w8 -> go_sci coef (negate n) bs' + | otherwise -> kont (NumDecimal dec) bs where frac = byteStringToInteger (BS.Unsafe.unsafeTake n bs1) coef = int * 10 ^ n + frac @@ -234,25 +234,25 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci !coef !exp10 !bs2 = case BS.uncons bs2 of Nothing -> errEnd Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_pos coef exp10 bs2 1 bs' - | W8_PLUS == w8 -> case BS.uncons bs' of - Nothing -> errEnd + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs2 1 bs' + | W8.PLUS == w8 -> case BS.uncons bs' of + Nothing -> errEnd Just (w8', bs'') - | W8_0 <= w8', w8' <= W8_9 -> go_sci_pos coef exp10 bs' 1 bs'' - | otherwise -> errUnx w8' - | W8_MINUS == w8 -> case BS.uncons bs' of + | W8.DIGIT_0 <= w8', w8' <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs' 1 bs'' + | otherwise -> errUnx w8' + | W8.HYPHEN == w8 -> case BS.uncons bs' of Nothing -> errEnd Just (w8', bs'') - | W8_0 <= w8', w8' <= W8_9 -> go_sci_neg coef exp10 bs' 1 bs'' - | otherwise -> errUnx w8' - | otherwise -> errUnx w8 + | W8.DIGIT_0 <= w8', w8' <= W8.DIGIT_9 -> go_sci_neg coef exp10 bs' 1 bs'' + | otherwise -> errUnx w8' + | otherwise -> errUnx w8 go_sci_pos :: Integer -> Int -> ByteString -> Int -> ByteString -> r go_sci_pos !coef !exp10 !bs2 !n !bs = case BS.uncons bs of Nothing -> kont (NumScientific sci) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' + | otherwise -> kont (NumScientific sci) bs where exp10' = fromInteger (byteStringToInteger (BS.Unsafe.unsafeTake n bs2)) sci = Sci.scientific coef (exp10 + exp10') @@ -261,7 +261,7 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci_neg !coef !exp10 !bs2 !n !bs = case BS.uncons bs of Nothing -> kont (NumScientific sci) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' | otherwise -> kont (NumScientific sci) bs where exp10' = fromInteger (byteStringToInteger (BS.Unsafe.unsafeTake n bs2)) diff --git a/src/Data/Aeson/Decoding/ByteString/Lazy.hs b/src/Data/Aeson/Decoding/ByteString/Lazy.hs index 0f9215936..9e699d036 100644 --- a/src/Data/Aeson/Decoding/ByteString/Lazy.hs +++ b/src/Data/Aeson/Decoding/ByteString/Lazy.hs @@ -18,12 +18,12 @@ import qualified Data.Aeson.Key as Key import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Scientific as Sci +import qualified Data.Word8.Patterns as W8 import Data.Aeson.Decoding.Internal import Data.Aeson.Decoding.Tokens import Data.Aeson.Internal.Text (unsafeDecodeASCII) import Data.Aeson.Internal.Unescape (unescapeText) -import Data.Aeson.Internal.Word8 -- | Lex (and parse) lazy 'ByteString' into 'Tokens' stream. -- @@ -42,17 +42,17 @@ lbsToTokens bs0 = goT bs0 id where -> ByteString -- whole input, needed for number parsing -> (ByteString -> k) -- continuation -> Tokens k String - tokenCase W8_OPEN_CURLY !bs !_ k = TkRecordOpen (goR bs k) - tokenCase W8_OPEN_SQUARE bs _ k = TkArrayOpen (goA bs k) - tokenCase W8_DOUBLE_QUOTE bs _ k = scanStringLiteral (\t bs' -> TkText t (k bs')) tkErr bs - tokenCase W8_MINUS bs _ k = scanNumberLiteral (\n bs' -> TkNumber (negateNumber n) (k bs')) tkErr bs + tokenCase W8.LEFT_CURLY !bs !_ k = TkRecordOpen (goR bs k) + tokenCase W8.LEFT_SQUARE bs _ k = TkArrayOpen (goA bs k) + tokenCase W8.DOUBLE_QUOTE bs _ k = scanStringLiteral (\t bs' -> TkText t (k bs')) tkErr bs + tokenCase W8.HYPHEN bs _ k = scanNumberLiteral (\n bs' -> TkNumber (negateNumber n) (k bs')) tkErr bs tokenCase w _ wbs k - | W8_0 <= w, w <= W8_9 = scanNumberLiteral (\n bs' -> TkNumber n (k bs')) tkErr wbs - tokenCase W8_n bs _ k + | W8.DIGIT_0 <= w, w <= W8.DIGIT_9 = scanNumberLiteral (\n bs' -> TkNumber n (k bs')) tkErr wbs + tokenCase W8.LOWER_N bs _ k | Just bs1 <- stripPrefix "ull" 3 bs = TkLit LitNull (k bs1) - tokenCase W8_t bs _ k + tokenCase W8.LOWER_T bs _ k | Just bs1 <- stripPrefix "rue" 3 bs = TkLit LitTrue (k bs1) - tokenCase W8_f bs _ k + tokenCase W8.LOWER_F bs _ k | Just bs1 <- stripPrefix "alse" 4 bs = TkLit LitFalse (k bs1) tokenCase _ _ wbs _ = tkErr $ "Unexpected " ++ showBeginning wbs ++ ", expecting JSON value" @@ -60,33 +60,33 @@ lbsToTokens bs0 = goT bs0 id where goA :: Parser TkArray k goA (skipSpace -> bs) k = case LBS.uncons bs of Nothing -> tkErrEOF "JSON value or ]" - Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1) + Just (W8.RIGHT_SQUARE, !bs1) -> TkArrayEnd (k bs1) Just (w, !bs1) -> TkItem $ tokenCase w bs1 bs $ \bs2 -> goA1 bs2 k goA1 :: Parser TkArray k goA1 (skipSpace -> bs) k = case LBS.uncons bs of Nothing -> tkErrEOF ", or ]" - Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1) - Just (W8_COMMA, !bs1) -> TkItem $ goT bs1 $ \bs2 -> goA1 bs2 k + Just (W8.RIGHT_SQUARE, !bs1) -> TkArrayEnd (k bs1) + Just (W8.COMMA, !bs1) -> TkItem $ goT bs1 $ \bs2 -> goA1 bs2 k _ -> tkErrBS bs ", or ]" -- Record goR :: Parser TkRecord k goR (skipSpace -> bs) k = case LBS.uncons bs of Nothing -> tkErrEOF "record key literal or }" - Just (W8_DOUBLE_QUOTE, !bs1) -> goRK bs1 k -- " - Just (W8_CLOSE_CURLY, !bs1) -> TkRecordEnd (k bs1) -- } + Just (W8.DOUBLE_QUOTE, !bs1) -> goRK bs1 k -- " + Just (W8.RIGHT_CURLY, !bs1) -> TkRecordEnd (k bs1) -- } Just _ -> tkErrBS bs "record key literal or }" -- after record pair, expecting ," or } goR1 :: Parser TkRecord k goR1 (skipSpace -> bs) k = case LBS.uncons bs of Nothing -> tkErr "Unexpected end-of-input, expecting , or }" - Just (W8_COMMA, !bs1) -> case LBS.uncons (skipSpace bs1) of + Just (W8.COMMA, !bs1) -> case LBS.uncons (skipSpace bs1) of Nothing -> tkErrEOF "key literal" - Just (W8_DOUBLE_QUOTE, !bs2) -> goRK bs2 k + Just (W8.DOUBLE_QUOTE, !bs2) -> goRK bs2 k Just _ -> tkErrBS bs "key literal" - Just (W8_CLOSE_CURLY, !bs1) -> TkRecordEnd (k bs1) + Just (W8.RIGHT_CURLY, !bs1) -> TkRecordEnd (k bs1) _ -> tkErr $ "Unexpected " ++ showBeginning bs ++ ", expecting , or }" -- key of record (after double quote) @@ -97,7 +97,7 @@ lbsToTokens bs0 = goT bs0 id where goRK' :: Text -> Parser TkRecord k goRK' t (skipSpace -> bs) k = case LBS.uncons bs of Nothing -> tkErrEOF ":" - Just (W8_COLON, !bs3) -> TkPair (Key.fromText t) $ goT bs3 $ \bs4 -> goR1 bs4 k + Just (W8.COLON, !bs3) -> TkPair (Key.fromText t) $ goT bs3 $ \bs4 -> goR1 bs4 k Just _ -> tkErrBS bs ":" stripPrefix :: ByteString -> Int -> ByteString -> Maybe ByteString @@ -193,27 +193,27 @@ scanNumberLiteral kont err bs0 = state_start bs0 where state_start !bs = case LBS.uncons bs of Nothing -> errEnd Just (w8, bs') - | W8_0 < w8, w8 <= W8_9 -> state_i1 1 bs' - | W8_0 == w8 -> state_after0 bs' + | W8.DIGIT_0 < w8, w8 <= W8.DIGIT_9 -> state_i1 1 bs' + | W8.DIGIT_0 == w8 -> state_after0 bs' | otherwise -> err $ "Unexpected " ++ show w8 ++ " while parsing number literal" state_after0 :: ByteString -> r state_after0 !bs = case LBS.uncons bs of Nothing -> kont (NumInteger 0) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> err "Number literal with leading zero" - | W8_DOT == w8 -> go_dec 0 bs' - | W8_e == w8 || W8_E == w8 -> go_sci 0 0 bs' - | otherwise -> kont (NumInteger 0) bs + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> err "Number literal with leading zero" + | W8.PERIOD == w8 -> go_dec 0 bs' + | W8.LOWER_E == w8 || W8.UPPER_E == w8 -> go_sci 0 0 bs' + | otherwise -> kont (NumInteger 0) bs state_i1 :: Int -> ByteString -> r state_i1 !n !bs = case LBS.uncons bs of Nothing -> kont (NumInteger int) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_i1 (n + 1) bs' - | W8_DOT == w8 -> go_dec int bs' - | W8_e == w8 || W8_E == w8 -> go_sci int 0 bs' - | otherwise -> kont (NumInteger int) bs + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> state_i1 (n + 1) bs' + | W8.PERIOD == w8 -> go_dec int bs' + | W8.LOWER_E == w8 || W8.UPPER_E == w8 -> go_sci int 0 bs' + | otherwise -> kont (NumInteger int) bs where int = byteStringToInteger (lbsTake n bs0) @@ -221,16 +221,16 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_dec !int !bs1 = case LBS.uncons bs1 of Nothing -> errEnd Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_dec 1 bs' - | otherwise -> err $ "Unexpected " ++ show w8 ++ " while parsing number literal" + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> state_dec 1 bs' + | otherwise -> err $ "Unexpected " ++ show w8 ++ " while parsing number literal" where state_dec :: Int -> ByteString -> r state_dec !n !bs = case LBS.uncons bs of Nothing -> kont (NumDecimal dec) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_dec (n + 1) bs' - | W8_e == w8 || W8_E == w8 -> go_sci coef (negate n) bs' - | otherwise -> kont (NumDecimal dec) bs + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> state_dec (n + 1) bs' + | W8.LOWER_E == w8 || W8.UPPER_E == w8 -> go_sci coef (negate n) bs' + | otherwise -> kont (NumDecimal dec) bs where frac = byteStringToInteger (lbsTake n bs1) coef = int * 10 ^ n + frac @@ -240,16 +240,16 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci !coef !exp10 !bs2 = case LBS.uncons bs2 of Nothing -> errEnd Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_pos coef exp10 bs2 1 bs' - | W8_PLUS == w8 -> case LBS.uncons bs' of + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs2 1 bs' + | W8.PLUS == w8 -> case LBS.uncons bs' of Nothing -> errEnd Just (w8', bs'') - | W8_0 <= w8', w8' <= W8_9 -> go_sci_pos coef exp10 bs' 1 bs'' + | W8.DIGIT_0 <= w8', w8' <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs' 1 bs'' | otherwise -> errUnx w8' - | W8_MINUS == w8 -> case LBS.uncons bs' of + | W8.HYPHEN == w8 -> case LBS.uncons bs' of Nothing -> errEnd Just (w8', bs'') - | W8_0 <= w8', w8' <= W8_9 -> go_sci_neg coef exp10 bs' 1 bs'' + | W8.DIGIT_0 <= w8', w8' <= W8.DIGIT_9 -> go_sci_neg coef exp10 bs' 1 bs'' | otherwise -> errUnx w8' | otherwise -> errUnx w8 @@ -257,7 +257,7 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci_pos !coef !exp10 !bs2 !n !bs = case LBS.uncons bs of Nothing -> kont (NumScientific sci) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' | otherwise -> kont (NumScientific sci) bs where exp10' = fromInteger (byteStringToInteger (lbsTake n bs2)) @@ -267,7 +267,7 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci_neg !coef !exp10 !bs2 !n !bs = case LBS.uncons bs of Nothing -> kont (NumScientific sci) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' + | W8.DIGIT_0 <= w8, w8 <= W8.DIGIT_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' | otherwise -> kont (NumScientific sci) bs where exp10' = fromInteger (byteStringToInteger (lbsTake n bs2)) diff --git a/src/Data/Aeson/Decoding/Text.hs b/src/Data/Aeson/Decoding/Text.hs index 8eb127946..ca00e6e97 100644 --- a/src/Data/Aeson/Decoding/Text.hs +++ b/src/Data/Aeson/Decoding/Text.hs @@ -24,9 +24,9 @@ import Data.Aeson.Internal.Prelude import Data.Aeson.Internal.UnescapeFromText (unescapeFromText) #if MIN_VERSION_text(2,0,0) -import Data.Aeson.Internal.Word8 +import qualified Data.Word8.Patterns as W #else -import Data.Aeson.Internal.Word16 +import qualified Data.Word16.Patterns as W #endif #if MIN_VERSION_text(2,0,0) @@ -53,51 +53,50 @@ textToTokens bs0 = goT bs0 id where -> Text -- whole input, needed for number parsing -> (Text -> k) -- continuation -> Tokens k String - tokenCase W8_OPEN_CURLY !bs !_ k = TkRecordOpen (goR bs k) - tokenCase W8_OPEN_SQUARE bs _ k = TkArrayOpen (goA bs k) - tokenCase W8_DOUBLE_QUOTE bs _ k = scanStringLiteral (\t bs' -> TkText t (k bs')) tkErr bs - tokenCase W8_MINUS bs _ k = scanNumberLiteral (\n bs' -> TkNumber (negateNumber n) (k bs')) tkErr bs + tokenCase W.LEFT_CURLY !bs !_ k = TkRecordOpen (goR bs k) + tokenCase W.LEFT_SQUARE bs _ k = TkArrayOpen (goA bs k) + tokenCase W.DOUBLE_QUOTE bs _ k = scanStringLiteral (\t bs' -> TkText t (k bs')) tkErr bs + tokenCase W.HYPHEN bs _ k = scanNumberLiteral (\n bs' -> TkNumber (negateNumber n) (k bs')) tkErr bs tokenCase w _ wbs k - | W8_0 <= w, w <= W8_9 = scanNumberLiteral (\n bs' -> TkNumber n (k bs')) tkErr wbs - tokenCase W8_n bs _ k + | W.DIGIT_0 <= w, w <= W.DIGIT_9 = scanNumberLiteral (\n bs' -> TkNumber n (k bs')) tkErr wbs + tokenCase W.LOWER_N bs _ k | Just bs1 <- stripPrefix "ull" 3 bs = TkLit LitNull (k bs1) - tokenCase W8_t bs _ k + tokenCase W.LOWER_T bs _ k | Just bs1 <- stripPrefix "rue" 3 bs = TkLit LitTrue (k bs1) - tokenCase W8_f bs _ k + tokenCase W.LOWER_F bs _ k | Just bs1 <- stripPrefix "alse" 4 bs = TkLit LitFalse (k bs1) - tokenCase _ _ wbs _ = tkErr $ "Unexpected " ++ showBeginning wbs ++ ", expecting JSON value" - + tokenCase _ _ wbs _ = tkErr $ "Unexpected " ++ showBeginning wbs ++ ", expecting JSON value" -- Array goA :: Parser TkArray k goA (skipSpace -> bs) k = case unconsPoint bs of Nothing -> tkErrEOF "JSON value or ]" - Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1) + Just (W.RIGHT_SQUARE, !bs1) -> TkArrayEnd (k bs1) Just (w, !bs1) -> TkItem $ tokenCase w bs1 bs $ \bs2 -> goA1 bs2 k goA1 :: Parser TkArray k goA1 (skipSpace -> bs) k = case unconsPoint bs of Nothing -> tkErrEOF ", or ]" - Just (W8_CLOSE_SQUARE, !bs1) -> TkArrayEnd (k bs1) - Just (W8_COMMA, !bs1) -> TkItem $ goT bs1 $ \bs2 -> goA1 bs2 k + Just (W.RIGHT_SQUARE, !bs1) -> TkArrayEnd (k bs1) + Just (W.COMMA, !bs1) -> TkItem $ goT bs1 $ \bs2 -> goA1 bs2 k _ -> tkErrBS bs ", or ]" -- Record goR :: Parser TkRecord k goR (skipSpace -> bs) k = case unconsPoint bs of Nothing -> tkErrEOF "record key literal or }" - Just (W8_DOUBLE_QUOTE, !bs1) -> goRK bs1 k -- " - Just (W8_CLOSE_CURLY, !bs1) -> TkRecordEnd (k bs1) -- } + Just (W.DOUBLE_QUOTE, !bs1) -> goRK bs1 k -- " + Just (W.RIGHT_CURLY, !bs1) -> TkRecordEnd (k bs1) -- } Just _ -> tkErrBS bs "record key literal or }" -- after record pair, expecting ," or } goR1 :: Parser TkRecord k goR1 (skipSpace -> bs) k = case unconsPoint bs of Nothing -> tkErr "Unexpected end-of-input, expecting , or }" - Just (W8_COMMA, !bs1) -> case unconsPoint (skipSpace bs1) of + Just (W.COMMA, !bs1) -> case unconsPoint (skipSpace bs1) of Nothing -> tkErrEOF "key literal" - Just (W8_DOUBLE_QUOTE, !bs2) -> goRK bs2 k + Just (W.DOUBLE_QUOTE, !bs2) -> goRK bs2 k Just _ -> tkErrBS bs "key literal" - Just (W8_CLOSE_CURLY, !bs1) -> TkRecordEnd (k bs1) + Just (W.RIGHT_CURLY, !bs1) -> TkRecordEnd (k bs1) _ -> tkErr $ "Unexpected " ++ showBeginning bs ++ ", expecting , or }" -- key of record (after double quote) @@ -196,46 +195,46 @@ scanNumberLiteral scanNumberLiteral kont err bs0 = state_start bs0 where state_start :: Text -> r state_start !bs = case unconsPoint bs of - Nothing -> errEnd + Nothing -> errEnd Just (w8, bs') - | W8_0 < w8, w8 <= W8_9 -> state_i1 1 bs' - | W8_0 == w8 -> state_after0 bs' - | otherwise -> errUnx w8 + | W.DIGIT_0 < w8, w8 <= W.DIGIT_9 -> state_i1 1 bs' + | W.DIGIT_0 == w8 -> state_after0 bs' + | otherwise -> errUnx w8 state_after0 :: Text -> r state_after0 !bs = case unconsPoint bs of - Nothing -> kont (NumInteger 0) bs + Nothing -> kont (NumInteger 0) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> err "Number literal with leading zero" - | W8_DOT == w8 -> go_dec 0 bs' - | W8_e == w8 || W8_E == w8 -> go_sci 0 0 bs' - | otherwise -> kont (NumInteger 0) bs + | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> err "Number literal with leading zero" + | W.PERIOD == w8 -> go_dec 0 bs' + | W.LOWER_E == w8 || W.UPPER_E == w8 -> go_sci 0 0 bs' + | otherwise -> kont (NumInteger 0) bs state_i1 :: Int -> Text -> r state_i1 !n !bs = case unconsPoint bs of - Nothing -> kont (NumInteger int) bs + Nothing -> kont (NumInteger int) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_i1 (n + 1) bs' - | W8_DOT == w8 -> go_dec int bs' - | W8_e == w8 || W8_E == w8 -> go_sci int 0 bs' - | otherwise -> kont (NumInteger int) bs + | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> state_i1 (n + 1) bs' + | W.PERIOD == w8 -> go_dec int bs' + | W.LOWER_E == w8 || W.UPPER_E == w8 -> go_sci int 0 bs' + | otherwise -> kont (NumInteger int) bs where int = textToInteger (unsafeTakePoints n bs0) go_dec :: Integer -> Text -> r go_dec !int !bs1 = case unconsPoint bs1 of - Nothing -> errEnd + Nothing -> errEnd Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_dec 1 bs' - | otherwise -> errUnx w8 + | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> state_dec 1 bs' + | otherwise -> errUnx w8 where state_dec :: Int -> Text -> r state_dec !n !bs = case unconsPoint bs of - Nothing -> kont (NumDecimal dec) bs + Nothing -> kont (NumDecimal dec) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> state_dec (n + 1) bs' - | W8_e == w8 || W8_E == w8 -> go_sci coef (negate n) bs' - | otherwise -> kont (NumDecimal dec) bs + | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> state_dec (n + 1) bs' + | W.LOWER_E == w8 || W.UPPER_E == w8 -> go_sci coef (negate n) bs' + | otherwise -> kont (NumDecimal dec) bs where frac = textToInteger (unsafeTakePoints n bs1) coef = int * 10 ^ n + frac @@ -243,37 +242,37 @@ scanNumberLiteral kont err bs0 = state_start bs0 where go_sci :: Integer -> Int -> Text -> r go_sci !coef !exp10 !bs2 = case unconsPoint bs2 of - Nothing -> errEnd + Nothing -> errEnd Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_pos coef exp10 bs2 1 bs' - | W8_PLUS == w8 -> case unconsPoint bs' of - Nothing -> errEnd + | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> go_sci_pos coef exp10 bs2 1 bs' + | W.PLUS == w8 -> case unconsPoint bs' of + Nothing -> errEnd Just (w8', bs'') - | W8_0 <= w8', w8' <= W8_9 -> go_sci_pos coef exp10 bs' 1 bs'' - | otherwise -> errUnx w8' - | W8_MINUS == w8 -> case unconsPoint bs' of - Nothing -> errEnd + | W.DIGIT_0 <= w8', w8' <= W.DIGIT_9 -> go_sci_pos coef exp10 bs' 1 bs'' + | otherwise -> errUnx w8' + | W.HYPHEN == w8 -> case unconsPoint bs' of + Nothing -> errEnd Just (w8', bs'') - | W8_0 <= w8', w8' <= W8_9 -> go_sci_neg coef exp10 bs' 1 bs'' - | otherwise -> errUnx w8' - | otherwise -> errUnx w8 + | W.DIGIT_0 <= w8', w8' <= W.DIGIT_9 -> go_sci_neg coef exp10 bs' 1 bs'' + | otherwise -> errUnx w8' + | otherwise -> errUnx w8 go_sci_pos :: Integer -> Int -> Text -> Int -> Text -> r go_sci_pos !coef !exp10 !bs2 !n !bs = case unconsPoint bs of - Nothing -> kont (NumScientific sci) bs + Nothing -> kont (NumScientific sci) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> go_sci_pos coef exp10 bs2 (n + 1) bs' + | otherwise -> kont (NumScientific sci) bs where exp10' = fromInteger (textToInteger (unsafeTakePoints n bs2)) sci = Sci.scientific coef (exp10 + exp10') go_sci_neg :: Integer -> Int -> Text -> Int -> Text -> r go_sci_neg !coef !exp10 !bs2 !n !bs = case unconsPoint bs of - Nothing -> kont (NumScientific sci) bs + Nothing -> kont (NumScientific sci) bs Just (w8, bs') - | W8_0 <= w8, w8 <= W8_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' - | otherwise -> kont (NumScientific sci) bs + | W.DIGIT_0 <= w8, w8 <= W.DIGIT_9 -> go_sci_neg coef exp10 bs2 (n + 1) bs' + | otherwise -> kont (NumScientific sci) bs where exp10' = fromInteger (textToInteger (unsafeTakePoints n bs2)) sci = Sci.scientific coef (exp10 - exp10') diff --git a/src/Data/Aeson/Internal/Word16.hs b/src/Data/Aeson/Internal/Word16.hs deleted file mode 100644 index 5d31c2e4a..000000000 --- a/src/Data/Aeson/Internal/Word16.hs +++ /dev/null @@ -1,76 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} --- | This is s/Word8/Word16/g copy of .Word8 module. --- This module is used for low-bit working with text <2 (UTF-16) -module Data.Aeson.Internal.Word16 where - -import Data.Word (Word16) - -------------------------------------------------------------------------------- --- Word16 ASCII codes as patterns -------------------------------------------------------------------------------- - --- GHC-8.0 doesn't support giving multiple pattern synonyms type signature at once - --- spaces -pattern W8_SPACE :: Word16 -pattern W8_NL :: Word16 -pattern W8_CR :: Word16 -pattern W8_TAB :: Word16 - -pattern W8_SPACE = 0x20 -pattern W8_NL = 0x0a -pattern W8_CR = 0x0d -pattern W8_TAB = 0x09 - --- punctuation -pattern W8_BACKSLASH :: Word16 -pattern W8_DOUBLE_QUOTE :: Word16 -pattern W8_DOT :: Word16 -pattern W8_COMMA :: Word16 -pattern W8_COLON :: Word16 - -pattern W8_BACKSLASH = 92 -pattern W8_COMMA = 44 -pattern W8_DOT = 46 -pattern W8_DOUBLE_QUOTE = 34 -pattern W8_COLON = 58 - --- parentheses -pattern W8_CLOSE_CURLY :: Word16 -pattern W8_CLOSE_SQUARE :: Word16 -pattern W8_OPEN_SQUARE :: Word16 -pattern W8_OPEN_CURLY :: Word16 - -pattern W8_OPEN_CURLY = 123 -pattern W8_OPEN_SQUARE = 91 -pattern W8_CLOSE_CURLY = 125 -pattern W8_CLOSE_SQUARE = 93 - --- operators -pattern W8_MINUS :: Word16 -pattern W8_PLUS :: Word16 - -pattern W8_PLUS = 43 -pattern W8_MINUS = 45 - --- digits -pattern W8_0 :: Word16 -pattern W8_9 :: Word16 - -pattern W8_0 = 48 -pattern W8_9 = 57 - --- lower case -pattern W8_e :: Word16 -pattern W8_f :: Word16 -pattern W8_n :: Word16 -pattern W8_t :: Word16 - -pattern W8_e = 101 -pattern W8_f = 102 -pattern W8_n = 110 -pattern W8_t = 116 - --- upper case -pattern W8_E :: Word16 -pattern W8_E = 69 diff --git a/src/Data/Aeson/Internal/Word8.hs b/src/Data/Aeson/Internal/Word8.hs deleted file mode 100644 index 500167406..000000000 --- a/src/Data/Aeson/Internal/Word8.hs +++ /dev/null @@ -1,74 +0,0 @@ -{-# LANGUAGE PatternSynonyms #-} -module Data.Aeson.Internal.Word8 where - -import Data.Word (Word8) - -------------------------------------------------------------------------------- --- Word8 ASCII codes as patterns -------------------------------------------------------------------------------- - --- GHC-8.0 doesn't support giving multiple pattern synonyms type signature at once - --- spaces -pattern W8_SPACE :: Word8 -pattern W8_NL :: Word8 -pattern W8_CR :: Word8 -pattern W8_TAB :: Word8 - -pattern W8_SPACE = 0x20 -pattern W8_NL = 0x0a -pattern W8_CR = 0x0d -pattern W8_TAB = 0x09 - --- punctuation -pattern W8_BACKSLASH :: Word8 -pattern W8_DOUBLE_QUOTE :: Word8 -pattern W8_DOT :: Word8 -pattern W8_COMMA :: Word8 -pattern W8_COLON :: Word8 - -pattern W8_BACKSLASH = 92 -pattern W8_COMMA = 44 -pattern W8_DOT = 46 -pattern W8_DOUBLE_QUOTE = 34 -pattern W8_COLON = 58 - --- parentheses -pattern W8_CLOSE_CURLY :: Word8 -pattern W8_CLOSE_SQUARE :: Word8 -pattern W8_OPEN_SQUARE :: Word8 -pattern W8_OPEN_CURLY :: Word8 - -pattern W8_OPEN_CURLY = 123 -pattern W8_OPEN_SQUARE = 91 -pattern W8_CLOSE_CURLY = 125 -pattern W8_CLOSE_SQUARE = 93 - --- operators -pattern W8_MINUS :: Word8 -pattern W8_PLUS :: Word8 - -pattern W8_PLUS = 43 -pattern W8_MINUS = 45 - --- digits -pattern W8_0 :: Word8 -pattern W8_9 :: Word8 - -pattern W8_0 = 48 -pattern W8_9 = 57 - --- lower case -pattern W8_e :: Word8 -pattern W8_f :: Word8 -pattern W8_n :: Word8 -pattern W8_t :: Word8 - -pattern W8_e = 101 -pattern W8_f = 102 -pattern W8_n = 110 -pattern W8_t = 116 - --- upper case -pattern W8_E :: Word8 -pattern W8_E = 69 diff --git a/src/Data/Aeson/RFC8785.hs b/src/Data/Aeson/RFC8785.hs index 38b715aa6..8f8399b50 100644 --- a/src/Data/Aeson/RFC8785.hs +++ b/src/Data/Aeson/RFC8785.hs @@ -13,7 +13,6 @@ import Data.Aeson import Data.Aeson.Encoding import Data.Aeson.Encoding.Internal import Data.Aeson.Internal.Prelude -import Data.Aeson.Internal.Word8 import qualified Data.Aeson.Key as Key import qualified Data.Aeson.KeyMap as KM @@ -24,6 +23,7 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.Scientific as Sci import qualified Data.Text.Encoding as TE import qualified Data.Vector as V +import qualified Data.Word8.Patterns as W8 -- $setup -- >>> import Data.Aeson @@ -94,8 +94,8 @@ canonicalString = text -- RFC8785 Appendix D says "don't use bignums". canonicalNumber :: Scientific -> Encoding canonicalNumber m = case compare m 0 of - EQ -> Encoding (B.word8 W8_0) - LT -> Encoding (B.word8 W8_MINUS <> fromEncoding (canonicalNumber' (negate m))) + EQ -> Encoding (B.word8 W8.DIGIT_0) + LT -> Encoding (B.word8 W8.HYPHEN <> fromEncoding (canonicalNumber' (negate m))) GT -> canonicalNumber' m -- input: Positive number @@ -104,36 +104,36 @@ canonicalNumber' m | k <= n, n <= 21 = Encoding $ BP.primMapListFixed BP.word8 ds <> - BP.primMapListFixed BP.word8 (replicate (n - k) W8_0) + BP.primMapListFixed BP.word8 (replicate (n - k) W8.DIGIT_0) | 0 < n, n <= 21 , let (pfx, sfx) = splitAt n ds = Encoding $ BP.primMapListFixed BP.word8 pfx <> - B.word8 W8_DOT <> + B.word8 W8.PERIOD <> BP.primMapListFixed BP.word8 sfx | -6 < n, n <= 0 = Encoding $ - B.word8 W8_0 <> - B.word8 W8_DOT <> - BP.primMapListFixed BP.word8 (replicate (negate n) W8_0) <> + B.word8 W8.DIGIT_0 <> + B.word8 W8.PERIOD <> + BP.primMapListFixed BP.word8 (replicate (negate n) W8.DIGIT_0) <> BP.primMapListFixed BP.word8 ds | k == 1, [d] <- ds = Encoding $ B.word8 d <> - B.word8 W8_e <> - B.word8 (if (n - 1) >= 0 then W8_PLUS else W8_MINUS) <> + B.word8 W8.LOWER_E <> + B.word8 (if (n - 1) >= 0 then W8.PLUS else W8.HYPHEN) <> BP.primMapListFixed BP.word8 (integerToDecimalDigits (abs (toInteger n - 1))) | (d:ds') <- ds = Encoding $ B.word8 d <> - B.word8 W8_DOT <> + B.word8 W8.PERIOD <> BP.primMapListFixed BP.word8 ds' <> - B.word8 W8_e <> - B.word8 (if (n - 1) >= 0 then W8_PLUS else W8_MINUS) <> + B.word8 W8.LOWER_E <> + B.word8 (if (n - 1) >= 0 then W8.PLUS else W8.HYPHEN) <> BP.primMapListFixed BP.word8 (integerToDecimalDigits (abs (toInteger n - 1))) | otherwise @@ -166,4 +166,4 @@ integerToDecimalDigits :: Integer -> [Word8] integerToDecimalDigits = go [] where go acc 0 = acc go acc i = case quotRemInteger i 10 of - (# q, r #) -> go (d:acc) q where !d = fromIntegral r + W8_0 + (# q, r #) -> go (d:acc) q where !d = fromIntegral r + W8.DIGIT_0