resp (empty) → 1.0.0

raw patch · 6 files changed

+846/−0 lines, 6 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, ghc-prim, resp, scanner, tasty, tasty-hunit, tasty-quickcheck, utf8-string

Files

CHANGELOG.md +5/−0
LICENSE +28/−0
README.md +10/−0
resp.cabal +59/−0
src/Data/RESP.hs +369/−0
test/Main.hs +375/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for resp++## 1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

+ LICENSE view

@@ -0,0 +1,28 @@+BSD 3-Clause License++Copyright (c) 2024, Owen Shepherd++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+   list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+   this list of conditions and the following disclaimer in the documentation+   and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its+   contributors may be used to endorse or promote products derived from+   this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,10 @@+# resp++[![GHC version badge](https://img.shields.io/badge/ghc-%3E%3D7.4.2-blue?logo=haskell)](https://www.haskell.org/) [![CI status badge](https://img.shields.io/github/actions/workflow/status/414owen/resp/haskell-ci.yml)](https://github.com/414owen/neresp/actions/workflows/haskell-ci.yml) [![Hackage version badge](https://img.shields.io/hackage/v/resp)](https://hackage.haskell.org/package/resp) [![license](https://img.shields.io/github/license/414owen/resp)](https://github.com/414owen/resp/blob/master/LICENSE)++This is a [RESP3](https://redis.io/docs/reference/protocol-spec/) parser,+implemented as a non-backtracking incremental scanner, using the+[`scanner`](https://hackage.haskell.org/package/scanner) library.++It aims to parse valid RESP3 messages as fast as possible, with+very little emphasis on error messages.

+ resp.cabal view

@@ -0,0 +1,59 @@+cabal-version:   3.0+name:            resp+version:         1.0.0+license:         BSD-3-Clause+license-file:    LICENSE+author:          Owen Shepherd+maintainer:      owen@owen.cafe+category:        Data+build-type:      Simple+synopsis   :     A fast, non-backtracking parser for the redis RESP3 protocol+description:     RESP is redis' serialization protocol. This package provides a+                 lightweight and correct parser for RESP3, which can be used+                 incrementally (eg. over a network connection).+extra-doc-files: CHANGELOG.md+               , README.md+tested-with:     GHC==9.6.2+               , GHC==9.4.5+               , GHC==9.2.8+               , GHC==9.0.2+               , GHC==8.10.7+               , GHC==8.8.4+               , GHC==8.6.5+               , GHC==8.4.4+               , GHC==8.2.2+               , GHC==8.0.2+               , GHC==7.10.3+               , GHC==7.8.4+               , GHC==7.6.3+               , GHC==7.4.2++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:  Data.RESP+    build-depends:    base >=4.3 && <5+                    , bytestring >= 0.9 && < 0.13+                    , scanner >= 0.1 && < 0.4+    if(impl(ghc < 7.6))+      build-depends:  ghc-prim > 0.1 && < 0.3+    hs-source-dirs:   src+    default-language: Haskell98++test-suite resp-test+    import:           warnings+    default-language: Haskell98+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:    base >=4.3 && <5+                    , bytestring >= 0.9 && < 0.13+                    , QuickCheck >= 2.1 && < 3+                    , resp+                    , scanner >= 0.1 && < 0.4+                    , tasty >= 0.1 && < 1.6+                    , tasty-hunit >= 0.1 && < 0.11+                    , tasty-quickcheck >= 0.1 && < 0.11+                    , utf8-string >= 0.3 && < 2

+ src/Data/RESP.hs view

@@ -0,0 +1,369 @@+{-# LANGUAGE CPP               #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE ApplicativeDo     #-}+#endif+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections     #-}+{-# LANGUAGE DeriveGeneric #-}++module Data.RESP+  ( RespReply(..)+  , RespExpr(..)+  , parseReply+  , parseExpression+  ) where++import qualified Data.ByteString       as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy  as BSL+import qualified Scanner               as Scanner++#if !MIN_VERSION_base(4,8,0)+import Data.Functor+import Control.Applicative+#endif++#if !MIN_VERSION_base(4,11,0)+# if MIN_VERSION_base(4,9,0)+import Data.Semigroup+import Data.Monoid (mempty)+# else+import Data.Monoid ((<>), mempty)+# endif+#endif++import Data.ByteString      (ByteString)+import Data.Char            (digitToInt)+import Data.Int             (Int64)+import Scanner              (Scanner)+import Control.Monad        (when, replicateM)+import GHC.Generics         (Generic)++-- This type synonym was introduced in bytestring 0.11.2.0+type LazyByteString = BSL.ByteString++#if MIN_VERSION_bytestring(0,10,0)+lazyBsToStrict :: LazyByteString -> ByteString+lazyBsToStrict = BSL.toStrict+#else+lazyBsToStrict :: LazyByteString -> ByteString+lazyBsToStrict = BS.concat . BSL.toChunks+#endif++-- | Top-level resp reply.+-- Cannot be nested.+data RespReply+  = RespPush !ByteString ![RespExpr]+  | RespExpr !RespExpr+  deriving (Show, Eq, Ord, Generic)++-- | RESP3 Expression.+--+-- This descriminates the difference between RespString and RespBlob,+-- even though both contain bytestrings, in order to not throw away+-- information. A caller might care whether the response was delivered+-- with "+", or "$".+--+-- We do not, however descriminate between the different encodings of+-- null. As far as I can tell, these are considered a mistake in the+-- previous versions of the RESP spec, and clients should treat the+-- different encodings the same.+--+-- Why don't we parse `RespString` into `Text`? Well, the caller might+-- not actually need to decode it into text, and so we let the caller+-- decide. This way, we don't have to deal with encoding errors.+--+-- Similarly, we don't parse a `RespMap` into a `HashMap`, because+-- that would involve imposing our choice of data structure on the caller.+-- They might want to use `HashMap`, `Map`, or just use the `lookup`+-- function.+--+-- Given these choices, our purview is simple: Parse the text protocol+-- into a Haskell datatype, maintaining all useful information, and not+-- imposing our taste onto the caller.+data RespExpr+  = RespString !ByteString+  | RespBlob !ByteString+  | RespStreamingBlob !LazyByteString+  | RespStringError !ByteString+  | RespBlobError !ByteString+  | RespArray ![RespExpr]+  | RespInteger !Int64+  | RespNull+  | RespBool !Bool+  | RespDouble !Double+  | RespVerbatimString !ByteString+  | RespVerbatimMarkdown !ByteString+  | RespBigInteger !Integer+  | RespMap ![(RespExpr, RespExpr)]+  | RespSet ![RespExpr]+  | RespAttribute ![(RespExpr, RespExpr)] RespExpr+  deriving (Show, Eq, Ord, Generic)++data MessageSize+  = MSVariable+  | MSFixed Int++data NullableMessageSize+  = NMSVariable+  | NMSMinusOne+  | NMSFixed Int++-- Top level RESP item+parseReply :: Scanner RespReply+parseReply = do+  c <- Scanner.anyChar8+  case c of+    '>' -> parsePush+    _ -> RespExpr <$> parseExpression' c++-- Non-top-level resp item+parseExpression :: Scanner RespExpr+parseExpression = Scanner.anyChar8 >>= parseExpression'++-- Non-top-level resp item, taking its first char as a parameter+parseExpression' :: Char -> Scanner RespExpr+parseExpression' c = case c of+  '$' -> parseBlob+  '+' -> parseString+  '-' -> parseStringError+  ':' -> RespInteger <$> parseInteger+  '*' -> parseArray RespArray+  '_' -> RespNull <$ parseEol +  '#' -> RespBool . (== 't') <$> Scanner.anyChar8 <* parseEol+  ',' -> parseDouble+  '!' -> parseBlobError+  '=' -> parseVerbatimString+  '(' -> RespBigInteger <$> parseInteger+  '%' -> RespMap <$> parseMap+  '~' -> parseArray RespSet+  '|' -> RespAttribute <$> parseMap <*> parseExpression+  _ -> fail $ "Unknown expression prefix: " <> show c++parsePush :: Scanner RespReply+parsePush = do+  len <- parseMessageSize+  RespPush <$> parsePushType <*> replicateM (pred len) parseExpression++parsePushType :: Scanner ByteString+parsePushType = do+  c <- Scanner.anyChar8+  -- No idea whether this can be a simple string or not,+  -- the spec isn't specific enough.+  --+  -- The spec doesn't say that the push type *can't* be a+  -- streamed blob string (or null), but let's face it, only a sadist would+  -- return one of those. I'll try to get these possibilities excluded from+  -- the spec, but in the meantime, we're going to have to parse all the+  -- blobstrings.+  case c of+    '$' -> parseBlob' id lazyBsToStrict $ fail "Push message type can't be null"+    '+' -> parseLine+    _ -> fail "Invalid push message type"++parseMap :: Scanner [(RespExpr, RespExpr)]+parseMap = do+  len <- parseComplexMessageSize+  case len of+    MSFixed n -> replicateM n parseTwoEls+    MSVariable -> parseVarMapPairs++-- See https://github.com/redis/redis-specifications/blob/master/protocol/RESP3.md#streamed-aggregated-data-types+parseVarMapPairs :: Scanner [(RespExpr, RespExpr)]+parseVarMapPairs = do+  c <- Scanner.anyChar8+  case c of+    '.' -> [] <$ parseEol+    _ -> (:) <$> ((,) <$> parseExpression' c <*> parseExpression) <*> parseVarMapPairs++parseTwoEls :: Scanner (RespExpr, RespExpr)+parseTwoEls = (,) <$> parseExpression <*> parseExpression++-- See: https://github.com/redis/redis-specifications/issues/25+--    , https://github.com/redis/redis-specifications/issues/23+parseVerbatimString :: Scanner RespExpr+parseVerbatimString = do+  len <- parseMessageSize+  entireBlob <- Scanner.take len+  let body = BS8.drop 4 entireBlob+  parseEol+  case BS8.take 3 entireBlob of+    "txt" -> pure $ RespVerbatimString body+    "mkd" -> pure $ RespVerbatimMarkdown body+    _ -> fail "Unknown verbatim string type"++-- I suspect that this can't be streamed, or null+-- See: https://github.com/redis/redis-specifications/issues/23+parseBlobError :: Scanner RespExpr+parseBlobError = do+  len <- parseMessageSize+  RespBlobError <$> Scanner.take len <* parseEol++bsContains :: Char -> ByteString -> Bool+bsContains c = BS8.any (== c)++-- Scanning to NaN is a function so that we don't+-- feel guilty about inlining the patterns+parseLineAsNaN :: Scanner Double+parseLineAsNaN = (0 / 0) <$ parseLine++parseLineAsInf :: Scanner Double+parseLineAsInf = (1 / 0) <$ parseLine++-- (inf|-inf|nan|(+|-)?\d+(\.\d+)?([eE](+|-)?\d+))+--+-- Due to Redis bugs prior to 7.2, we also have to deal with+-- /(-)?nan(\(.*\))?/i, even though they're not part of the+-- RESP spec...+parseDouble :: Scanner RespExpr+parseDouble = do+  c <- Scanner.anyChar8+  RespDouble <$> case c of+    '+' -> go1 =<< Scanner.anyChar8+    '-' -> fmap negate $ go1 =<< Scanner.anyChar8+    'i' -> do+      -- Note: We're not validating that the rest of the line+      -- is actually "nf", because `,i` uniquely determines the+      -- set of valid responses.+      parseLineAsInf+    'n' -> parseLineAsNaN+    'N' -> parseLineAsNaN+    _ -> go1 c++  where+    -- takes first non-sign char of the significand+    go1 :: Char -> Scanner Double+    go1 'i' = parseLineAsInf+    go1 'n' = parseLineAsNaN+    go1 'N' = parseLineAsNaN+    go1 c1 = fromRational <$> do+      decStr <- Scanner.takeWhileChar8 $ not . (`bsContains` ".\reE")+      let dec = parseNatural1 c1 decStr :: Integer+      c2 <- Scanner.anyChar8+      case c2 of+        '\r' -> fromIntegral dec <$ expectChar '\n' +        '.' -> do+          decStr1 <- Scanner.takeWhileChar8 $ not . (`bsContains` "\reE")+          let dec1 = fromIntegral (parseNatural' dec decStr1) / (10 ^ BS.length decStr1) :: Rational+          c3 <- Scanner.anyChar8+          case c3 of+            '\r' -> dec1 <$ expectChar '\n'+            _ {- c3 `elem` "eE" -} -> go2 dec1+        _ {- c3 `elem` "eE" -} -> go2 $ fromIntegral dec++    -- from first char of exponent (after [eE])+    go2 :: Rational -> Scanner Rational+    go2 n = do+      c <- Scanner.anyChar8+      (negExp, exponent') <- case c of+        '-' -> (True,) . parseNatural <$> parseLine+        '+' -> (False,) . parseNatural <$> parseLine+        _ {- isDigit c -} -> (False,) . parseNatural1 c <$> parseLine+      let expMul = fromIntegral (10 ^ (exponent' :: Integer) :: Integer) :: Rational+      pure $ if negExp then n / expMul else n * expMul++parseNatural :: Integral a => ByteString -> a+parseNatural = parseNatural' 0++parseNatural' :: Integral a => a -> ByteString -> a+parseNatural' = BS8.foldl' (\a b -> a * 10 + fromIntegral (digitToInt b))++parseNatural1 :: Integral a => Char -> ByteString -> a+parseNatural1 = parseNatural' . fromIntegral . digitToInt++-- RESP2 calls these 'multi bulk'+-- RESP3 calls it an 'array'+--+-- This is used to parse arrays and sets, meaning that we parse+-- "~-1\r\n" as RespNull, although this isn't a valid form in the spec.+parseArray :: ([RespExpr] -> RespExpr) -> Scanner RespExpr+parseArray construct = do+  messageSize <- parseComplexNullableMessageSize+  case messageSize of+    NMSFixed n -> construct <$> replicateM n parseExpression+    NMSMinusOne -> pure RespNull+    NMSVariable -> construct <$> parseVarArrayItems++-- See https://github.com/redis/redis-specifications/blob/master/protocol/RESP3.md#streamed-aggregated-data-types+parseVarArrayItems :: Scanner [RespExpr]+parseVarArrayItems = do+  c <- Scanner.anyChar8+  case c of+    '.' -> [] <$ parseEol+    _ -> (:) <$> parseExpression' c <*> parseVarArrayItems++-- RESP2 calls these 'bulk strings'+-- RESP3 calls them 'blob strings' (in the markdown, on the website they're still 'bulk strings')+parseBlob :: Scanner RespExpr+parseBlob = parseBlob' RespBlob RespStreamingBlob $ pure RespNull++-- general case for something that's pretty blobstring-like+parseBlob'+  :: (ByteString -> a)+  -> (LazyByteString -> a)+  -> Scanner a+  -> Scanner a+parseBlob' strictConstr lazyConstr nullConstr = do+  ms <- parseComplexNullableMessageSize+  case ms of+    NMSFixed n -> strictConstr <$> Scanner.take n <* parseEol+    NMSVariable -> lazyConstr . BSL.fromChunks <$> streamingBlobParts+    NMSMinusOne -> nullConstr++parseMessageSize :: Scanner Int+parseMessageSize = parseNatural <$> parseLine++-- Used for blobs and arrays+parseComplexNullableMessageSize :: Scanner NullableMessageSize+parseComplexNullableMessageSize = do+  line <- parseLine+  case line of+    "?" -> pure NMSVariable+    "-1" -> pure NMSMinusOne+    _ -> pure $ NMSFixed $ parseNatural line++-- Used for maps, attributes, sets+parseComplexMessageSize :: Scanner MessageSize+parseComplexMessageSize = do+  line <- parseLine+  case line of+    "?" -> pure MSVariable+    _ -> pure $ MSFixed $ parseNatural line++streamingBlobParts :: Scanner [ByteString]+streamingBlobParts = do+  expectChar ';'+  ms <- parseMessageSize+  case ms of+    0 -> pure mempty+    n -> (:) <$> Scanner.take n <* parseEol <*> streamingBlobParts++parseString :: Scanner RespExpr+parseString = RespString <$> parseLine++-- Cautious interpretation, until we can clarify that the+-- error tag is mandatory.+-- https://github.com/redis/redis-specifications/issues/24+parseStringError :: Scanner RespExpr+parseStringError = RespStringError <$> parseLine++parseInteger :: Integral a => Scanner a+parseInteger = do+  c <- Scanner.anyChar8+  case c of+    '+' -> parseNatural <$> parseLine+    '-' -> negate . parseNatural <$> parseLine+    _ -> parseNatural1 c <$> parseLine++parseLine :: Scanner ByteString+parseLine = Scanner.takeWhileChar8 (/= '\r') <* parseEol++expectChar :: Char -> Scanner ()+expectChar c = do+  d <- Scanner.anyChar8+  when (c /= d) $ fail $ "Expected " <> show c <> ", but got " <> show d++parseEol :: Scanner ()+parseEol = do+  expectChar '\r'+  expectChar '\n'

+ test/Main.hs view

@@ -0,0 +1,375 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++#if !MIN_VERSION_base(4,8,0)+import Data.Functor+import Control.Applicative+#endif++#if !MIN_VERSION_base(4,11,0)+# if MIN_VERSION_base(4,9,0)+import Data.Semigroup+import Data.Monoid (mempty)+# else+import Data.Monoid ((<>), mempty)+# endif+#endif++import Data.ByteString                 (ByteString)+import Data.RESP                       (RespReply(..), RespExpr(..))+import qualified Data.ByteString.UTF8  as BSU+import qualified Data.RESP             as R3+-- import qualified Data.Text.Encoding    as T+-- import qualified Data.Text             as T+-- import Data.Text                       (Text)+import qualified Data.ByteString       as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy  as BSL+import Scanner+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck           (testProperty, Arbitrary(..), Gen, (===))+import qualified Test.Tasty.QuickCheck as QC++arbText :: Gen ByteString+arbText = BSU.fromString <$> arbitrary++arbBs :: Gen ByteString+arbBs = BS.pack <$> arbitrary++arbBsl :: Gen BSL.ByteString+arbBsl = BSL.pack <$> arbitrary++shrinkBs :: ByteString -> [ByteString]+shrinkBs = fmap BS.pack . shrink . BS.unpack++shrinkBsl :: BSL.ByteString -> [BSL.ByteString]+shrinkBsl = fmap BSL.pack . shrink . BSL.unpack++halfArbitrary :: Arbitrary a => Int -> Gen a+halfArbitrary n = QC.resize (n `div` 2) arbitrary++genLine :: Gen ByteString+genLine = fmap BSU.fromString $ QC.listOf $ QC.suchThat arbitrary (not . (`elem` ("\r\n" :: String)))++-- If you want access to this instance, please make a PR+-- to create a cabal sublibrary called `resp-quickcheck`.+-- This will avoid adding `quickcheck` as a dependency of+-- the main `resp` library.+instance Arbitrary RespExpr where+  arbitrary = QC.sized $ \n -> case n of+    _ | n <= 1 -> QC.oneof+      [ RespString <$> genLine+      , RespBlob <$> arbBs+      , RespStreamingBlob <$> arbBsl+      , RespStringError <$> genLine+      , RespBlobError <$> arbBs+      , RespInteger <$> arbitrary+      , pure RespNull+      , RespBool <$> arbitrary+      , RespDouble <$> arbitrary+      , RespVerbatimString <$> arbText+      , RespVerbatimMarkdown <$> arbText+      , RespBigInteger <$> arbitrary+      ]+    _ -> QC.oneof+      [ RespString <$> genLine+      , RespBlob <$> arbBs+      , RespStreamingBlob <$> arbBsl+      , RespStringError <$> genLine+      , RespBlobError <$> arbBs+      , RespInteger <$> arbitrary+      , pure RespNull+      , RespBool <$> arbitrary+      , RespDouble <$> arbitrary+      , RespVerbatimString <$> arbText+      , RespVerbatimMarkdown <$> arbText+      , RespBigInteger <$> arbitrary+      , RespArray <$> halfArbitrary n+      , RespMap <$> halfArbitrary n+      , RespSet <$> halfArbitrary n+      , RespAttribute <$> halfArbitrary n <*> halfArbitrary n+      ]++  shrink expr = case expr of+    RespString a -> RespString <$> shrinkBs a+    RespBlob a -> RespBlob <$> shrinkBs a+    RespStreamingBlob a -> RespStreamingBlob <$> shrinkBsl a+    RespStringError a -> RespStringError <$> shrinkBs a+    RespBlobError a -> RespBlobError <$> shrinkBs a+    RespArray a -> RespArray <$> shrink a+    RespInteger a -> RespInteger <$> shrink a+    RespBool a -> RespBool <$> shrink a+    RespDouble a -> RespDouble <$> shrink a+    RespVerbatimString a -> RespVerbatimString <$> shrinkBs a+    RespVerbatimMarkdown a -> RespVerbatimMarkdown <$> shrinkBs a+    RespBigInteger a -> RespBigInteger <$> shrink a+    RespMap a -> RespMap <$> shrink a+    RespSet a -> RespSet <$> shrink a+    RespNull -> []+    RespAttribute a b -> RespAttribute <$> shrink a <*> shrink b++instance Arbitrary RespReply where+  arbitrary = QC.oneof+    [ RespPush <$> arbBs <*> arbitrary+    , RespExpr <$> arbitrary+    ]+  shrink reply = case reply of+    RespPush a b -> RespPush <$> shrinkBs a <*> shrink b+    RespExpr a -> RespExpr <$> shrink a++showBs :: Show a => a -> ByteString+showBs = BSU.fromString . show++eol :: ByteString+eol = "\r\n"++toStrictBs :: BSL.ByteString -> ByteString+toStrictBs = BS.concat . BSL.toChunks++encodeExpr :: RespExpr -> ByteString+encodeExpr = BS.concat . encodeExpr'++encodeExpr' :: RespExpr -> [ByteString]+encodeExpr' e = case e of +  RespString txt -> ["+", txt, eol]+  RespBlob bs -> ["$", showBs $ BS.length bs, eol, bs, eol]+  RespStreamingBlob bs+    | BSL.null bs -> ["$?\r\n;0\r\n"]+    | otherwise -> ["$?\r\n", ";", showBs $ BSL.length bs, eol, toStrictBs bs, "\r\n;0\r\n"]+  RespStringError txt -> ["-", txt, eol]+  RespBlobError bs -> ["!", showBs $ BS.length bs, eol, bs, eol]+  RespArray els -> ["*", showBs $ length els, eol] <> concatMap encodeExpr' els+  RespInteger n -> [":", showBs $ n, eol]+  RespNull -> ["_\r\n"]+  RespBool True -> ["#t\r\n"]+  RespBool False -> ["#f\r\n"]+  RespDouble n -> [",", showBs n, eol]+  RespVerbatimString txt -> let bs = txt in+    ["=", showBs $ 4 + BS.length bs, eol, "txt:", bs, eol]+  RespVerbatimMarkdown txt -> let bs = txt in+    ["=", showBs $ 4 + BS.length bs, eol, "mkd:", bs, eol]+  RespBigInteger n -> ["(", showBs n, eol]+  RespMap els -> ["%", showBs $ length els, eol] <> concatMap encodeTup els+  RespSet els -> ["~", showBs $ length els, eol] <> concatMap encodeExpr' els+  RespAttribute attrs expr ->+    ["|", showBs $ length attrs, eol] <> concatMap encodeTup attrs <> encodeExpr' expr++encodeTup :: (RespExpr, RespExpr) -> [ByteString]+encodeTup (a, b) = concatMap encodeExpr' [a, b]++encodeReply :: RespReply -> ByteString+encodeReply repl = BS.concat $ case repl of+  RespPush t msgs -> [">", showBs $ succ $ length msgs, eol, "$", showBs $ BS.length t, eol, t, eol]+    <> concatMap encodeExpr' msgs+  RespExpr e -> encodeExpr' e++parseExpr :: ByteString -> Either String RespExpr+parseExpr = scanOnly R3.parseExpression++parseReply :: ByteString -> Either String RespReply+parseReply = scanOnly R3.parseReply++testStr :: ByteString -> ByteString -> Assertion+testStr bs expected = parseExpr bs @?= Right (RespString expected)++testStreamingBlob :: ByteString -> ByteString -> Assertion+testStreamingBlob bs expected = parseExpr bs @?= Right (RespStreamingBlob $ BSL.fromChunks [expected])++testArray :: ByteString -> [RespExpr] -> Assertion+testArray bs expected = parseExpr bs @?= Right (RespArray expected)++testDouble :: ByteString -> Double -> Assertion+testDouble bs d = parseExpr bs @?= Right (RespDouble d)++testDouble' :: ByteString -> (Double -> Assertion) -> Assertion+testDouble' bs f = case parseExpr bs of+  Right (RespDouble d) -> f d+  _ -> assertFailure "Expected to parse into a double"++blobProperties :: ByteString -> String -> (ByteString -> RespExpr) -> TestTree+blobProperties leader prefix constr = testProperty "quickcheck" $ \str -> let bs = BSU.fromString $ prefix <> str in+  parseExpr (leader <> BS8.pack (show $ BS8.length bs) <> "\r\n" <> bs <> "\r\n") === Right (constr $ BS8.drop (length prefix) bs)++blobTestCases :: ByteString -> (ByteString -> RespExpr) -> [TestTree]+blobTestCases leader constr =+  [ testCase "empty" $ parseExpr (leader <> "0\r\n\r\n") @?= Right (constr "")+  , testCase "simple" $ parseExpr (leader <> "7\r\ntest me\r\n") @?= Right (constr "test me")+  , testCase "multiline" $ parseExpr (leader <> "15\r\ntest me\r\nline 2\r\n") @?= Right (constr "test me\r\nline 2")+  , testCase "unicode" $ parseExpr (leader <> "11\r\n( ͡° ͜ʖ ͡°)\r\n") @?= Right (constr "( ͡° ͜ʖ ͡°)")+  , testCase "not enough bytes" $ parseExpr (leader <> "10\r\nhello\r\n") @?= Left "No more input"+  , testCase "too many bytes" $ parseExpr (leader <> "2\r\nhello\r\n") @?= Left "Expected '\\r', but got 'l'"+  , blobProperties leader "" constr+  ]++integerTestCases :: (Arbitrary a, Num a, Show a) => ByteString -> (a -> RespExpr) -> [TestTree]+integerTestCases prefix constr =+  -- We currently parse a zero-digit integer as 0,+  -- even though it's technically an invalid response+  -- in the spec. Sometimes being lenient is efficient.+  [ testCase "empty" $ parseExpr (prefix <> "\r\n") @?= Left "No more input"+  , testCase "zero" $ parseExpr (prefix <> "0\r\n") @?= Right (constr 0)+  , testCase "one" $ parseExpr (prefix <> "1\r\n") @?= Right (constr 1)+  , testCase "forty-two" $ parseExpr (prefix <> "42\r\n") @?= Right (constr 42)+  , testCase "forty-two" $ parseExpr (prefix <> "-42\r\n") @?= Right (constr (-42))+  , testProperty "quickcheck" $ \i -> parseExpr (prefix <> BS8.pack (show i) <> "\r\n") == Right (constr i)+  ]++main :: IO ()+main = defaultMain $ testGroup "Tests"+  [ testGroup "simple string"+    [ testCase "empty string" $ testStr "+\r\n" ""+    , testCase "nonempty string" $ testStr "+test me\r\n" "test me"+    ]++  , testGroup "simple blobs" $ blobTestCases "$" RespBlob+  , testGroup "blob errors" $ blobTestCases "!" RespBlobError++  , testGroup "verbatim strings"+    [ testGroup "text" $ pure $ blobProperties "=" "txt:" RespVerbatimString+    , testGroup "markdown" $ pure $ blobProperties "=" "mkd:" RespVerbatimMarkdown+    ]++  , testGroup "streaming blob parts"+    [ testCase "empty" $ testStreamingBlob "$?\r\n;0\r\n\r\n" ""+    , testCase "one-part" $ testStreamingBlob "$?\r\n;3\r\nwow\r\n;0\r\n" "wow"+    , testCase "two-part" $ testStreamingBlob "$?\r\n;4\r\nhell\r\n;7\r\no world\r\n;0\r\n" "hello world"+    , testCase "three-part" $ testStreamingBlob "$?\r\n;4\r\nhell\r\n;3\r\no w\r\n;4\r\norld\r\n;0\r\n" "hello world"+    ]++  , testGroup "integer" $ integerTestCases ":" RespInteger+  , testGroup "big integer" $ integerTestCases "(" RespBigInteger++  , testGroup "null"+    [ testCase "RESP2 bulk string null" $ parseExpr "$-1\r\n" @?= Right RespNull+    ]++  , testGroup "array"+    [ testCase "empty" $ parseExpr "*0\r\n" @?= Right (RespArray [])+    , testCase "[hello, world]"+      $ testArray+        "*2\r\n$5\r\nhello\r\n$5\r\nworld\r\n"+        [RespBlob "hello", RespBlob "world"]+    , testCase "[1 .. 3]"+      $ testArray+        "*3\r\n:1\r\n:2\r\n:3\r\n"+        $ RespInteger <$> [1..3]+    , testCase "heterogeneous"+      $ testArray+        "*5\r\n:1\r\n:2\r\n:3\r\n:4\r\n$5\r\nhello\r\n"+        $ map RespInteger [1..4] <> [RespBlob "hello"]++    -- from website+    , testCase "nested"+      $ testArray+        "*2\r\n*3\r\n:1\r\n:2\r\n:3\r\n*2\r\n+Hello\r\n-World\r\n"+        $ RespArray <$> [RespInteger <$> [1..3], [RespString "Hello", RespStringError "World"]]++    -- from markdown+    , testCase "nested 2"+      $ testArray+        "*2\r\n*3\r\n:1\r\n$5\r\nhello\r\n:2\r\n#f\r\n"+        [RespArray [RespInteger 1, RespBlob "hello", RespInteger 2], RespBool False]+++    -- website: "Null arrays"+    , testCase "null" $ parseExpr "*-1\r\n" @?= Right RespNull++    -- website: "Null elements in arrays"+    , testCase "null element"+      $ testArray+        "*3\r\n$5\r\nhello\r\n$-1\r\n$5\r\nworld\r\n"+        [RespBlob "hello", RespNull, RespBlob "world"]++    -- from markdown spec+    , testCase "streaming"+      $ testArray+        "*?\r\n:1\r\n:2\r\n:3\r\n.\r\n"+        $ RespInteger <$> [1..3]++    ]++  , testCase "null" $ parseExpr "_\r\n" @?= Right RespNull++  , testGroup "boolean"+    [ testCase "true" $ parseExpr "#t\r\n" @?= Right (RespBool True)+    , testCase "false" $ parseExpr "#f\r\n" @?= Right (RespBool False)+    ]++  , testGroup "double"+    [ testCase "from int" $ testDouble ",42\r\n" 42+    , testCase "with decimal pt" $ testDouble ",42.12\r\n" 42.12+    , testCase "with exponent" $ testDouble ",42.12e2\r\n" 4212+    , testCase "with positive exponent" $ testDouble ",42.12e+2\r\n" 4212+    , testCase "negative with negative exponent" $ testDouble ",-42.12e-2\r\n" (-0.4212)++    , testCase "inf" $ testDouble' ",inf\r\n" $ assertBool "is infinite" . isInfinite+    , testCase "-inf" $ testDouble' ",-inf\r\n" $ \d -> do+        assertBool "is infinite" $ isInfinite d+        assertBool "== negate (1/0)" $ d == negate (1 / 0)+    , testCase "nan" $ testDouble' ",nan\r\n" $ assertBool "is NaN" . isNaN++    -- Looks like we can also parse all `show`n doubles+    , testProperty "quickcheck" $ \d -> parseExpr ("," <> BS8.pack (show d) <> "\r\n") == Right (RespDouble d)+    ]++  , testGroup "map"+    [ testCase "empty" $ parseExpr "%0\r\n" @?= Right (RespMap [])+    , testCase "simple" $ parseExpr "%2\r\n+first\r\n:1\r\n+second\r\n:2\r\n"+        @?= Right (RespMap [(RespString "first", RespInteger 1), (RespString "second", RespInteger 2)])++    , testGroup "streamed"+      [ testCase "empty" $ parseExpr "%?\r\n.\r\n" @?= Right (RespMap [])+      , testCase "streamed" $ parseExpr "%?\r\n+a\r\n:1\r\n+b\r\n:2\r\n.\r\n"+          @?= Right (RespMap [(RespString "a", RespInteger 1), (RespString "b", RespInteger 2)])+      ]+    ]+  , testGroup "set"+    [ testCase "empty" $ parseExpr "~0\r\n" @?= Right (RespSet [])+    , testCase "nonempty" $ parseExpr "~5\r\n+orange\r\n+apple\r\n#t\r\n:100\r\n:999\r\n"+        @?= Right (RespSet [RespString "orange", RespString "apple", RespBool True, RespInteger 100, RespInteger 999])+    , testGroup "streamed"+      [ testCase "empty" $ parseExpr "~?\r\n.\r\n" @?= Right (RespSet [])+      , testCase "streamed" $ parseExpr "~?\r\n+a\r\n:1\r\n+b\r\n:2\r\n.\r\n"+          @?= Right (RespSet [RespString "a", RespInteger 1, RespString "b", RespInteger 2])+      ]+    ]++  , testGroup "attribute"+    [ testCase "empty" $ parseExpr "~0\r\n" @?= Right (RespSet [])+    -- from markdown spec+    , testCase "nonempty" $ parseExpr "|1\r\n+key-popularity\r\n%2\r\n$1\r\na\r\n,0.1923\r\n$1\r\nb\r\n,0.0012\r\n*2\r\n:2039123\r\n:9543892\r\n"+        @?= Right (+          RespAttribute+            [ ( RespString "key-popularity"+              , RespMap+                [ ( RespBlob "a"+                  , RespDouble 0.1923+                  )+                , ( RespBlob "b"+                  , RespDouble 0.0012+                  )+                ]+              )+            ]+          (RespArray+            [ RespInteger 2039123+            , RespInteger 9543892+            ])+        )+    ]++  , testGroup "push"+    -- from markdown spec+    [ testCase "empty" $ parseReply ">1\r\n+test\r\n\r\n" @?= Right (RespPush "test" [])+    , testCase "simple message type" $ parseReply ">3\r\n+message\r\n+somechannel\r\n+this is the message\r\n"+        @?= Right (RespPush "message" [RespString "somechannel", RespString "this is the message"])+    , testCase "blob string els" $ parseReply ">3\r\n$7\r\nmessage\r\n$6\r\nsecond\r\n$5\r\nHello\r\n"+        @?= Right (RespPush "message" [RespBlob "second", RespBlob "Hello"])+    ]++  , testProperty "roundtrip expr" $ \ex -> parseExpr (encodeExpr ex) === Right ex+  , testProperty "roundtrip reply" $ \reply -> parseReply (encodeReply reply) === Right reply+  ]