{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE ApplicativeDo #-}
#endif
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveGeneric #-}
module Data.RESP
( RespMessage(..)
, RespExpr(..)
, parseMessage
, 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)
#if MIN_VERSION_bytestring(0,10,0)
lazyBsToStrict :: BSL.ByteString -> ByteString
lazyBsToStrict :: ByteString -> ByteString
lazyBsToStrict = ByteString -> ByteString
BSL.toStrict
#else
lazyBsToStrict :: BSL.ByteString -> ByteString
lazyBsToStrict = BS.concat . BSL.toChunks
#endif
data RespMessage
= RespPush !ByteString ![RespExpr]
| RespReply !RespExpr
deriving (Int -> RespMessage -> ShowS
[RespMessage] -> ShowS
RespMessage -> String
(Int -> RespMessage -> ShowS)
-> (RespMessage -> String)
-> ([RespMessage] -> ShowS)
-> Show RespMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RespMessage -> ShowS
showsPrec :: Int -> RespMessage -> ShowS
$cshow :: RespMessage -> String
show :: RespMessage -> String
$cshowList :: [RespMessage] -> ShowS
showList :: [RespMessage] -> ShowS
Show, RespMessage -> RespMessage -> Bool
(RespMessage -> RespMessage -> Bool)
-> (RespMessage -> RespMessage -> Bool) -> Eq RespMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RespMessage -> RespMessage -> Bool
== :: RespMessage -> RespMessage -> Bool
$c/= :: RespMessage -> RespMessage -> Bool
/= :: RespMessage -> RespMessage -> Bool
Eq, Eq RespMessage
Eq RespMessage
-> (RespMessage -> RespMessage -> Ordering)
-> (RespMessage -> RespMessage -> Bool)
-> (RespMessage -> RespMessage -> Bool)
-> (RespMessage -> RespMessage -> Bool)
-> (RespMessage -> RespMessage -> Bool)
-> (RespMessage -> RespMessage -> RespMessage)
-> (RespMessage -> RespMessage -> RespMessage)
-> Ord RespMessage
RespMessage -> RespMessage -> Bool
RespMessage -> RespMessage -> Ordering
RespMessage -> RespMessage -> RespMessage
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RespMessage -> RespMessage -> Ordering
compare :: RespMessage -> RespMessage -> Ordering
$c< :: RespMessage -> RespMessage -> Bool
< :: RespMessage -> RespMessage -> Bool
$c<= :: RespMessage -> RespMessage -> Bool
<= :: RespMessage -> RespMessage -> Bool
$c> :: RespMessage -> RespMessage -> Bool
> :: RespMessage -> RespMessage -> Bool
$c>= :: RespMessage -> RespMessage -> Bool
>= :: RespMessage -> RespMessage -> Bool
$cmax :: RespMessage -> RespMessage -> RespMessage
max :: RespMessage -> RespMessage -> RespMessage
$cmin :: RespMessage -> RespMessage -> RespMessage
min :: RespMessage -> RespMessage -> RespMessage
Ord, (forall x. RespMessage -> Rep RespMessage x)
-> (forall x. Rep RespMessage x -> RespMessage)
-> Generic RespMessage
forall x. Rep RespMessage x -> RespMessage
forall x. RespMessage -> Rep RespMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RespMessage -> Rep RespMessage x
from :: forall x. RespMessage -> Rep RespMessage x
$cto :: forall x. Rep RespMessage x -> RespMessage
to :: forall x. Rep RespMessage x -> RespMessage
Generic)
data RespExpr
= RespString !ByteString
| RespBlob !ByteString
| RespStreamingBlob !BSL.ByteString
| 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 (Int -> RespExpr -> ShowS
[RespExpr] -> ShowS
RespExpr -> String
(Int -> RespExpr -> ShowS)
-> (RespExpr -> String) -> ([RespExpr] -> ShowS) -> Show RespExpr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RespExpr -> ShowS
showsPrec :: Int -> RespExpr -> ShowS
$cshow :: RespExpr -> String
show :: RespExpr -> String
$cshowList :: [RespExpr] -> ShowS
showList :: [RespExpr] -> ShowS
Show, RespExpr -> RespExpr -> Bool
(RespExpr -> RespExpr -> Bool)
-> (RespExpr -> RespExpr -> Bool) -> Eq RespExpr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RespExpr -> RespExpr -> Bool
== :: RespExpr -> RespExpr -> Bool
$c/= :: RespExpr -> RespExpr -> Bool
/= :: RespExpr -> RespExpr -> Bool
Eq, Eq RespExpr
Eq RespExpr
-> (RespExpr -> RespExpr -> Ordering)
-> (RespExpr -> RespExpr -> Bool)
-> (RespExpr -> RespExpr -> Bool)
-> (RespExpr -> RespExpr -> Bool)
-> (RespExpr -> RespExpr -> Bool)
-> (RespExpr -> RespExpr -> RespExpr)
-> (RespExpr -> RespExpr -> RespExpr)
-> Ord RespExpr
RespExpr -> RespExpr -> Bool
RespExpr -> RespExpr -> Ordering
RespExpr -> RespExpr -> RespExpr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RespExpr -> RespExpr -> Ordering
compare :: RespExpr -> RespExpr -> Ordering
$c< :: RespExpr -> RespExpr -> Bool
< :: RespExpr -> RespExpr -> Bool
$c<= :: RespExpr -> RespExpr -> Bool
<= :: RespExpr -> RespExpr -> Bool
$c> :: RespExpr -> RespExpr -> Bool
> :: RespExpr -> RespExpr -> Bool
$c>= :: RespExpr -> RespExpr -> Bool
>= :: RespExpr -> RespExpr -> Bool
$cmax :: RespExpr -> RespExpr -> RespExpr
max :: RespExpr -> RespExpr -> RespExpr
$cmin :: RespExpr -> RespExpr -> RespExpr
min :: RespExpr -> RespExpr -> RespExpr
Ord, (forall x. RespExpr -> Rep RespExpr x)
-> (forall x. Rep RespExpr x -> RespExpr) -> Generic RespExpr
forall x. Rep RespExpr x -> RespExpr
forall x. RespExpr -> Rep RespExpr x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RespExpr -> Rep RespExpr x
from :: forall x. RespExpr -> Rep RespExpr x
$cto :: forall x. Rep RespExpr x -> RespExpr
to :: forall x. Rep RespExpr x -> RespExpr
Generic)
data MessageSize
= MSVariable
| MSFixed Int
data NullableMessageSize
= NMSVariable
| NMSMinusOne
| NMSFixed Int
parseMessage :: Scanner RespMessage
parseMessage :: Scanner RespMessage
parseMessage = do
Char
c <- Scanner Char
Scanner.anyChar8
case Char
c of
Char
'>' -> Scanner RespMessage
parsePush
Char
_ -> RespExpr -> RespMessage
RespReply (RespExpr -> RespMessage)
-> Scanner RespExpr -> Scanner RespMessage
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Scanner RespExpr
parseExpression' Char
c
parseExpression :: Scanner RespExpr
parseExpression :: Scanner RespExpr
parseExpression = Scanner Char
Scanner.anyChar8 Scanner Char -> (Char -> Scanner RespExpr) -> Scanner RespExpr
forall a b. Scanner a -> (a -> Scanner b) -> Scanner b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Char -> Scanner RespExpr
parseExpression'
parseExpression' :: Char -> Scanner RespExpr
parseExpression' :: Char -> Scanner RespExpr
parseExpression' Char
c = case Char
c of
Char
'$' -> Scanner RespExpr
parseBlob
Char
'+' -> Scanner RespExpr
parseString
Char
'-' -> Scanner RespExpr
parseStringError
Char
':' -> Int64 -> RespExpr
RespInteger (Int64 -> RespExpr) -> Scanner Int64 -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner Int64
forall a. Integral a => Scanner a
parseInteger
Char
'*' -> ([RespExpr] -> RespExpr) -> Scanner RespExpr
parseArray [RespExpr] -> RespExpr
RespArray
Char
'_' -> RespExpr
RespNull RespExpr -> Scanner () -> Scanner RespExpr
forall a b. a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner ()
parseEol
Char
'#' -> Bool -> RespExpr
RespBool (Bool -> RespExpr) -> (Char -> Bool) -> Char -> RespExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
't') (Char -> RespExpr) -> Scanner Char -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner Char
Scanner.anyChar8 Scanner RespExpr -> Scanner () -> Scanner RespExpr
forall a b. Scanner a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Scanner ()
parseEol
Char
',' -> Scanner RespExpr
parseDouble
Char
'!' -> Scanner RespExpr
parseBlobError
Char
'=' -> Scanner RespExpr
parseVerbatimString
Char
'(' -> Integer -> RespExpr
RespBigInteger (Integer -> RespExpr) -> Scanner Integer -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner Integer
forall a. Integral a => Scanner a
parseInteger
Char
'%' -> [(RespExpr, RespExpr)] -> RespExpr
RespMap ([(RespExpr, RespExpr)] -> RespExpr)
-> Scanner [(RespExpr, RespExpr)] -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner [(RespExpr, RespExpr)]
parseMap
Char
'~' -> ([RespExpr] -> RespExpr) -> Scanner RespExpr
parseArray [RespExpr] -> RespExpr
RespSet
Char
'|' -> [(RespExpr, RespExpr)] -> RespExpr -> RespExpr
RespAttribute ([(RespExpr, RespExpr)] -> RespExpr -> RespExpr)
-> Scanner [(RespExpr, RespExpr)] -> Scanner (RespExpr -> RespExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner [(RespExpr, RespExpr)]
parseMap Scanner (RespExpr -> RespExpr)
-> Scanner RespExpr -> Scanner RespExpr
forall a b. Scanner (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scanner RespExpr
parseExpression
Char
_ -> String -> Scanner RespExpr
forall a. String -> Scanner a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Scanner RespExpr) -> String -> Scanner RespExpr
forall a b. (a -> b) -> a -> b
$ String
"Unknown expression prefix: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c
parsePush :: Scanner RespMessage
parsePush :: Scanner RespMessage
parsePush = do
Int
len <- Scanner Int
parseMessageSize
ByteString -> [RespExpr] -> RespMessage
RespPush (ByteString -> [RespExpr] -> RespMessage)
-> Scanner ByteString -> Scanner ([RespExpr] -> RespMessage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parsePushType Scanner ([RespExpr] -> RespMessage)
-> Scanner [RespExpr] -> Scanner RespMessage
forall a b. Scanner (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Scanner RespExpr -> Scanner [RespExpr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
forall a. Enum a => a -> a
pred Int
len) Scanner RespExpr
parseExpression
parsePushType :: Scanner ByteString
parsePushType :: Scanner ByteString
parsePushType = do
Char
c <- Scanner Char
Scanner.anyChar8
case Char
c of
Char
'$' -> (ByteString -> ByteString)
-> (ByteString -> ByteString)
-> Scanner ByteString
-> Scanner ByteString
forall a.
(ByteString -> a) -> (ByteString -> a) -> Scanner a -> Scanner a
parseBlob' ByteString -> ByteString
forall a. a -> a
id ByteString -> ByteString
lazyBsToStrict (Scanner ByteString -> Scanner ByteString)
-> Scanner ByteString -> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ String -> Scanner ByteString
forall a. String -> Scanner a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Push message type can't be null"
Char
'+' -> Scanner ByteString
parseLine
Char
_ -> String -> Scanner ByteString
forall a. String -> Scanner a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid push message type"
parseMap :: Scanner [(RespExpr, RespExpr)]
parseMap :: Scanner [(RespExpr, RespExpr)]
parseMap = do
MessageSize
len <- Scanner MessageSize
parseComplexMessageSize
case MessageSize
len of
MSFixed Int
n -> Int
-> Scanner (RespExpr, RespExpr) -> Scanner [(RespExpr, RespExpr)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Scanner (RespExpr, RespExpr)
parseTwoEls
MessageSize
MSVariable -> Scanner [(RespExpr, RespExpr)]
parseVarMapPairs
parseVarMapPairs :: Scanner [(RespExpr, RespExpr)]
parseVarMapPairs :: Scanner [(RespExpr, RespExpr)]
parseVarMapPairs = do
Char
c <- Scanner Char
Scanner.anyChar8
case Char
c of
Char
'.' -> [] [(RespExpr, RespExpr)]
-> Scanner () -> Scanner [(RespExpr, RespExpr)]
forall a b. a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner ()
parseEol
Char
_ -> (:) ((RespExpr, RespExpr)
-> [(RespExpr, RespExpr)] -> [(RespExpr, RespExpr)])
-> Scanner (RespExpr, RespExpr)
-> Scanner ([(RespExpr, RespExpr)] -> [(RespExpr, RespExpr)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((,) (RespExpr -> RespExpr -> (RespExpr, RespExpr))
-> Scanner RespExpr -> Scanner (RespExpr -> (RespExpr, RespExpr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Scanner RespExpr
parseExpression' Char
c Scanner (RespExpr -> (RespExpr, RespExpr))
-> Scanner RespExpr -> Scanner (RespExpr, RespExpr)
forall a b. Scanner (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scanner RespExpr
parseExpression) Scanner ([(RespExpr, RespExpr)] -> [(RespExpr, RespExpr)])
-> Scanner [(RespExpr, RespExpr)] -> Scanner [(RespExpr, RespExpr)]
forall a b. Scanner (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scanner [(RespExpr, RespExpr)]
parseVarMapPairs
parseTwoEls :: Scanner (RespExpr, RespExpr)
parseTwoEls :: Scanner (RespExpr, RespExpr)
parseTwoEls = (,) (RespExpr -> RespExpr -> (RespExpr, RespExpr))
-> Scanner RespExpr -> Scanner (RespExpr -> (RespExpr, RespExpr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner RespExpr
parseExpression Scanner (RespExpr -> (RespExpr, RespExpr))
-> Scanner RespExpr -> Scanner (RespExpr, RespExpr)
forall a b. Scanner (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scanner RespExpr
parseExpression
parseVerbatimString :: Scanner RespExpr
parseVerbatimString :: Scanner RespExpr
parseVerbatimString = do
Int
len <- Scanner Int
parseMessageSize
ByteString
entireBlob <- Int -> Scanner ByteString
Scanner.take Int
len
let body :: ByteString
body = Int -> ByteString -> ByteString
BS8.drop Int
4 ByteString
entireBlob
Scanner ()
parseEol
case Int -> ByteString -> ByteString
BS8.take Int
3 ByteString
entireBlob of
ByteString
"txt" -> RespExpr -> Scanner RespExpr
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RespExpr -> Scanner RespExpr) -> RespExpr -> Scanner RespExpr
forall a b. (a -> b) -> a -> b
$ ByteString -> RespExpr
RespVerbatimString ByteString
body
ByteString
"mkd" -> RespExpr -> Scanner RespExpr
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RespExpr -> Scanner RespExpr) -> RespExpr -> Scanner RespExpr
forall a b. (a -> b) -> a -> b
$ ByteString -> RespExpr
RespVerbatimMarkdown ByteString
body
ByteString
_ -> String -> Scanner RespExpr
forall a. String -> Scanner a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unknown verbatim string type"
parseBlobError :: Scanner RespExpr
parseBlobError :: Scanner RespExpr
parseBlobError = do
Int
len <- Scanner Int
parseMessageSize
ByteString -> RespExpr
RespBlobError (ByteString -> RespExpr) -> Scanner ByteString -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Scanner ByteString
Scanner.take Int
len Scanner RespExpr -> Scanner () -> Scanner RespExpr
forall a b. Scanner a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Scanner ()
parseEol
bsContains :: Char -> ByteString -> Bool
bsContains :: Char -> ByteString -> Bool
bsContains Char
c = (Char -> Bool) -> ByteString -> Bool
BS8.any (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
parseLineAsNaN :: Scanner Double
parseLineAsNaN :: Scanner Double
parseLineAsNaN = (Double
0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0) Double -> Scanner ByteString -> Scanner Double
forall a b. a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner ByteString
parseLine
parseLineAsInf :: Scanner Double
parseLineAsInf :: Scanner Double
parseLineAsInf = (Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0) Double -> Scanner ByteString -> Scanner Double
forall a b. a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner ByteString
parseLine
parseDouble :: Scanner RespExpr
parseDouble :: Scanner RespExpr
parseDouble = do
Char
c <- Scanner Char
Scanner.anyChar8
Double -> RespExpr
RespDouble (Double -> RespExpr) -> Scanner Double -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Char
c of
Char
'+' -> Char -> Scanner Double
go1 (Char -> Scanner Double) -> Scanner Char -> Scanner Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Scanner Char
Scanner.anyChar8
Char
'-' -> (Double -> Double) -> Scanner Double -> Scanner Double
forall a b. (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Double
forall a. Num a => a -> a
negate (Scanner Double -> Scanner Double)
-> Scanner Double -> Scanner Double
forall a b. (a -> b) -> a -> b
$ Char -> Scanner Double
go1 (Char -> Scanner Double) -> Scanner Char -> Scanner Double
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Scanner Char
Scanner.anyChar8
Char
'i' -> do
Scanner Double
parseLineAsInf
Char
'n' -> Scanner Double
parseLineAsNaN
Char
'N' -> Scanner Double
parseLineAsNaN
Char
_ -> Char -> Scanner Double
go1 Char
c
where
go1 :: Char -> Scanner Double
go1 :: Char -> Scanner Double
go1 Char
'i' = Scanner Double
parseLineAsInf
go1 Char
'n' = Scanner Double
parseLineAsNaN
go1 Char
'N' = Scanner Double
parseLineAsNaN
go1 Char
c1 = Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (Rational -> Double) -> Scanner Rational -> Scanner Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
ByteString
decStr <- (Char -> Bool) -> Scanner ByteString
Scanner.takeWhileChar8 ((Char -> Bool) -> Scanner ByteString)
-> (Char -> Bool) -> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ByteString -> Bool
`bsContains` ByteString
".\reE")
let dec :: Integer
dec = Char -> ByteString -> Integer
forall a. Integral a => Char -> ByteString -> a
parseNatural1 Char
c1 ByteString
decStr :: Integer
Char
c2 <- Scanner Char
Scanner.anyChar8
case Char
c2 of
Char
'\r' -> Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
dec Rational -> Scanner () -> Scanner Rational
forall a b. a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Scanner ()
expectChar Char
'\n'
Char
'.' -> do
ByteString
decStr1 <- (Char -> Bool) -> Scanner ByteString
Scanner.takeWhileChar8 ((Char -> Bool) -> Scanner ByteString)
-> (Char -> Bool) -> Scanner ByteString
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> ByteString -> Bool
`bsContains` ByteString
"\reE")
let dec1 :: Rational
dec1 = Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> ByteString -> Integer
forall a. Integral a => a -> ByteString -> a
parseNatural' Integer
dec ByteString
decStr1) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ (Rational
10 Rational -> Int -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ ByteString -> Int
BS.length ByteString
decStr1) :: Rational
Char
c3 <- Scanner Char
Scanner.anyChar8
case Char
c3 of
Char
'\r' -> Rational
dec1 Rational -> Scanner () -> Scanner Rational
forall a b. a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Char -> Scanner ()
expectChar Char
'\n'
Char
_ -> Rational -> Scanner Rational
go2 Rational
dec1
Char
_ -> Rational -> Scanner Rational
go2 (Rational -> Scanner Rational) -> Rational -> Scanner Rational
forall a b. (a -> b) -> a -> b
$ Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
dec
go2 :: Rational -> Scanner Rational
go2 :: Rational -> Scanner Rational
go2 Rational
n = do
Char
c <- Scanner Char
Scanner.anyChar8
(Bool
negExp, Integer
exponent') <- case Char
c of
Char
'-' -> (Bool
True,) (Integer -> (Bool, Integer))
-> (ByteString -> Integer) -> ByteString -> (Bool, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
forall a. Integral a => ByteString -> a
parseNatural (ByteString -> (Bool, Integer))
-> Scanner ByteString -> Scanner (Bool, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
Char
'+' -> (Bool
False,) (Integer -> (Bool, Integer))
-> (ByteString -> Integer) -> ByteString -> (Bool, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer
forall a. Integral a => ByteString -> a
parseNatural (ByteString -> (Bool, Integer))
-> Scanner ByteString -> Scanner (Bool, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
Char
_ -> (Bool
False,) (Integer -> (Bool, Integer))
-> (ByteString -> Integer) -> ByteString -> (Bool, Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> Integer
forall a. Integral a => Char -> ByteString -> a
parseNatural1 Char
c (ByteString -> (Bool, Integer))
-> Scanner ByteString -> Scanner (Bool, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
let expMul :: Rational
expMul = Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
10 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
exponent' :: Integer) :: Integer) :: Rational
Rational -> Scanner Rational
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rational -> Scanner Rational) -> Rational -> Scanner Rational
forall a b. (a -> b) -> a -> b
$ if Bool
negExp then Rational
n Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
expMul else Rational
n Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
expMul
parseNatural :: Integral a => ByteString -> a
parseNatural :: forall a. Integral a => ByteString -> a
parseNatural = a -> ByteString -> a
forall a. Integral a => a -> ByteString -> a
parseNatural' a
0
parseNatural' :: Integral a => a -> ByteString -> a
parseNatural' :: forall a. Integral a => a -> ByteString -> a
parseNatural' = (a -> Char -> a) -> a -> ByteString -> a
forall a. (a -> Char -> a) -> a -> ByteString -> a
BS8.foldl' (\a
a Char
b -> a
a a -> a -> a
forall a. Num a => a -> a -> a
* a
10 a -> a -> a
forall a. Num a => a -> a -> a
+ Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
b))
parseNatural1 :: Integral a => Char -> ByteString -> a
parseNatural1 :: forall a. Integral a => Char -> ByteString -> a
parseNatural1 = a -> ByteString -> a
forall a. Integral a => a -> ByteString -> a
parseNatural' (a -> ByteString -> a) -> (Char -> a) -> Char -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> (Char -> Int) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
digitToInt
parseArray :: ([RespExpr] -> RespExpr) -> Scanner RespExpr
parseArray :: ([RespExpr] -> RespExpr) -> Scanner RespExpr
parseArray [RespExpr] -> RespExpr
construct = do
NullableMessageSize
messageSize <- Scanner NullableMessageSize
parseComplexNullableMessageSize
case NullableMessageSize
messageSize of
NMSFixed Int
n -> [RespExpr] -> RespExpr
construct ([RespExpr] -> RespExpr) -> Scanner [RespExpr] -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Scanner RespExpr -> Scanner [RespExpr]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
n Scanner RespExpr
parseExpression
NullableMessageSize
NMSMinusOne -> RespExpr -> Scanner RespExpr
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RespExpr
RespNull
NullableMessageSize
NMSVariable -> [RespExpr] -> RespExpr
construct ([RespExpr] -> RespExpr) -> Scanner [RespExpr] -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner [RespExpr]
parseVarArrayItems
parseVarArrayItems :: Scanner [RespExpr]
parseVarArrayItems :: Scanner [RespExpr]
parseVarArrayItems = do
Char
c <- Scanner Char
Scanner.anyChar8
case Char
c of
Char
'.' -> [] [RespExpr] -> Scanner () -> Scanner [RespExpr]
forall a b. a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Scanner ()
parseEol
Char
_ -> (:) (RespExpr -> [RespExpr] -> [RespExpr])
-> Scanner RespExpr -> Scanner ([RespExpr] -> [RespExpr])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Scanner RespExpr
parseExpression' Char
c Scanner ([RespExpr] -> [RespExpr])
-> Scanner [RespExpr] -> Scanner [RespExpr]
forall a b. Scanner (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scanner [RespExpr]
parseVarArrayItems
parseBlob :: Scanner RespExpr
parseBlob :: Scanner RespExpr
parseBlob = (ByteString -> RespExpr)
-> (ByteString -> RespExpr) -> Scanner RespExpr -> Scanner RespExpr
forall a.
(ByteString -> a) -> (ByteString -> a) -> Scanner a -> Scanner a
parseBlob' ByteString -> RespExpr
RespBlob ByteString -> RespExpr
RespStreamingBlob (Scanner RespExpr -> Scanner RespExpr)
-> Scanner RespExpr -> Scanner RespExpr
forall a b. (a -> b) -> a -> b
$ RespExpr -> Scanner RespExpr
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure RespExpr
RespNull
parseBlob'
:: (ByteString -> a)
-> (BSL.ByteString -> a)
-> Scanner a
-> Scanner a
parseBlob' :: forall a.
(ByteString -> a) -> (ByteString -> a) -> Scanner a -> Scanner a
parseBlob' ByteString -> a
strictConstr ByteString -> a
lazyConstr Scanner a
nullConstr = do
NullableMessageSize
ms <- Scanner NullableMessageSize
parseComplexNullableMessageSize
case NullableMessageSize
ms of
NMSFixed Int
n -> ByteString -> a
strictConstr (ByteString -> a) -> Scanner ByteString -> Scanner a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Scanner ByteString
Scanner.take Int
n Scanner a -> Scanner () -> Scanner a
forall a b. Scanner a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Scanner ()
parseEol
NullableMessageSize
NMSVariable -> ByteString -> a
lazyConstr (ByteString -> a)
-> ([ByteString] -> ByteString) -> [ByteString] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> a) -> Scanner [ByteString] -> Scanner a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner [ByteString]
streamingBlobParts
NullableMessageSize
NMSMinusOne -> Scanner a
nullConstr
parseMessageSize :: Scanner Int
parseMessageSize :: Scanner Int
parseMessageSize = ByteString -> Int
forall a. Integral a => ByteString -> a
parseNatural (ByteString -> Int) -> Scanner ByteString -> Scanner Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
parseComplexNullableMessageSize :: Scanner NullableMessageSize
parseComplexNullableMessageSize :: Scanner NullableMessageSize
parseComplexNullableMessageSize = do
ByteString
line <- Scanner ByteString
parseLine
case ByteString
line of
ByteString
"?" -> NullableMessageSize -> Scanner NullableMessageSize
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NullableMessageSize
NMSVariable
ByteString
"-1" -> NullableMessageSize -> Scanner NullableMessageSize
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NullableMessageSize
NMSMinusOne
ByteString
_ -> NullableMessageSize -> Scanner NullableMessageSize
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NullableMessageSize -> Scanner NullableMessageSize)
-> NullableMessageSize -> Scanner NullableMessageSize
forall a b. (a -> b) -> a -> b
$ Int -> NullableMessageSize
NMSFixed (Int -> NullableMessageSize) -> Int -> NullableMessageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall a. Integral a => ByteString -> a
parseNatural ByteString
line
parseComplexMessageSize :: Scanner MessageSize
parseComplexMessageSize :: Scanner MessageSize
parseComplexMessageSize = do
ByteString
line <- Scanner ByteString
parseLine
case ByteString
line of
ByteString
"?" -> MessageSize -> Scanner MessageSize
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MessageSize
MSVariable
ByteString
_ -> MessageSize -> Scanner MessageSize
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MessageSize -> Scanner MessageSize)
-> MessageSize -> Scanner MessageSize
forall a b. (a -> b) -> a -> b
$ Int -> MessageSize
MSFixed (Int -> MessageSize) -> Int -> MessageSize
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
forall a. Integral a => ByteString -> a
parseNatural ByteString
line
streamingBlobParts :: Scanner [ByteString]
streamingBlobParts :: Scanner [ByteString]
streamingBlobParts = do
Char -> Scanner ()
expectChar Char
';'
Int
ms <- Scanner Int
parseMessageSize
case Int
ms of
Int
0 -> [ByteString] -> Scanner [ByteString]
forall a. a -> Scanner a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ByteString]
forall a. Monoid a => a
mempty
Int
n -> (:) (ByteString -> [ByteString] -> [ByteString])
-> Scanner ByteString -> Scanner ([ByteString] -> [ByteString])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Scanner ByteString
Scanner.take Int
n Scanner ([ByteString] -> [ByteString])
-> Scanner () -> Scanner ([ByteString] -> [ByteString])
forall a b. Scanner a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Scanner ()
parseEol Scanner ([ByteString] -> [ByteString])
-> Scanner [ByteString] -> Scanner [ByteString]
forall a b. Scanner (a -> b) -> Scanner a -> Scanner b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scanner [ByteString]
streamingBlobParts
parseString :: Scanner RespExpr
parseString :: Scanner RespExpr
parseString = ByteString -> RespExpr
RespString (ByteString -> RespExpr) -> Scanner ByteString -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
parseStringError :: Scanner RespExpr
parseStringError :: Scanner RespExpr
parseStringError = ByteString -> RespExpr
RespStringError (ByteString -> RespExpr) -> Scanner ByteString -> Scanner RespExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
parseInteger :: Integral a => Scanner a
parseInteger :: forall a. Integral a => Scanner a
parseInteger = do
Char
c <- Scanner Char
Scanner.anyChar8
case Char
c of
Char
'+' -> ByteString -> a
forall a. Integral a => ByteString -> a
parseNatural (ByteString -> a) -> Scanner ByteString -> Scanner a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
Char
'-' -> a -> a
forall a. Num a => a -> a
negate (a -> a) -> (ByteString -> a) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> a
forall a. Integral a => ByteString -> a
parseNatural (ByteString -> a) -> Scanner ByteString -> Scanner a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
Char
_ -> Char -> ByteString -> a
forall a. Integral a => Char -> ByteString -> a
parseNatural1 Char
c (ByteString -> a) -> Scanner ByteString -> Scanner a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Scanner ByteString
parseLine
parseLine :: Scanner ByteString
parseLine :: Scanner ByteString
parseLine = (Char -> Bool) -> Scanner ByteString
Scanner.takeWhileChar8 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') Scanner ByteString -> Scanner () -> Scanner ByteString
forall a b. Scanner a -> Scanner b -> Scanner a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Scanner ()
parseEol
expectChar :: Char -> Scanner ()
expectChar :: Char -> Scanner ()
expectChar Char
c = do
Char
d <- Scanner Char
Scanner.anyChar8
Bool -> Scanner () -> Scanner ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
d) (Scanner () -> Scanner ()) -> Scanner () -> Scanner ()
forall a b. (a -> b) -> a -> b
$ String -> Scanner ()
forall a. String -> Scanner a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Scanner ()) -> String -> Scanner ()
forall a b. (a -> b) -> a -> b
$ String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", but got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
d
parseEol :: Scanner ()
parseEol :: Scanner ()
parseEol = do
Char -> Scanner ()
expectChar Char
'\r'
Char -> Scanner ()
expectChar Char
'\n'