    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE OverloadedStrings #-}

    module Database.Redis.Protocol (Reply(..), reply, renderRequest) where

    import Prelude hiding (error, take)
    #if __GLASGOW_HASKELL__ < 710
    import Control.Applicative
    #endif
    import Control.DeepSeq
    import Scanner (Scanner)
    import qualified Scanner
    import Data.ByteString.Char8 (ByteString)
    import GHC.Generics
    import qualified Data.ByteString.Char8 as B
    import qualified Data.Text.Encoding as Text
    import qualified Data.Text.Read as Text
    import Control.Monad (replicateM)

    -- |Low-level representation of replies from the Redis server.
    data Reply = SingleLine ByteString
               | Error ByteString
               | Integer Integer
               | Bulk (Maybe ByteString)
               | MultiBulk (Maybe [Reply])
             deriving (Reply -> Reply -> Bool
    (Reply -> Reply -> Bool) -> (Reply -> Reply -> Bool) -> Eq Reply
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Reply -> Reply -> Bool
    $c/= :: Reply -> Reply -> Bool
    == :: Reply -> Reply -> Bool
    $c== :: Reply -> Reply -> Bool
    Eq, Int -> Reply -> ShowS
    [Reply] -> ShowS
    Reply -> String
    (Int -> Reply -> ShowS)
    -> (Reply -> String) -> ([Reply] -> ShowS) -> Show Reply
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Reply] -> ShowS
    $cshowList :: [Reply] -> ShowS
    show :: Reply -> String
    $cshow :: Reply -> String
    showsPrec :: Int -> Reply -> ShowS
    $cshowsPrec :: Int -> Reply -> ShowS
    Show, (forall x. Reply -> Rep Reply x)
    -> (forall x. Rep Reply x -> Reply) -> Generic Reply
    forall x. Rep Reply x -> Reply
    forall x. Reply -> Rep Reply x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cto :: forall x. Rep Reply x -> Reply
    $cfrom :: forall x. Reply -> Rep Reply x
    Generic)

    instance NFData Reply

    ------------------------------------------------------------------------------
    -- Request
    --
    renderRequest :: [ByteString] -> ByteString
    renderRequest :: [ByteString] -> ByteString
    renderRequest req :: [ByteString]
    req = [ByteString] -> ByteString
    B.concat (ByteString
    argCntByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[ByteString]
    args)
      where
        argCnt :: ByteString
    argCnt = [ByteString] -> ByteString
    B.concat ["*", Int -> ByteString
    forall a. Show a => a -> ByteString
    showBS ([ByteString] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ByteString]
    req), ByteString
    crlf]
        args :: [ByteString]
    args   = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
    forall a b. (a -> b) -> [a] -> [b]
    map ByteString -> ByteString
    renderArg [ByteString]
    req

    renderArg :: ByteString -> ByteString
    renderArg :: ByteString -> ByteString
    renderArg arg :: ByteString
    arg = [ByteString] -> ByteString
    B.concat ["$",  ByteString -> ByteString
    argLen ByteString
    arg, ByteString
    crlf, ByteString
    arg, ByteString
    crlf]
      where
        argLen :: ByteString -> ByteString
    argLen = Int -> ByteString
    forall a. Show a => a -> ByteString
    showBS (Int -> ByteString)
    -> (ByteString -> Int) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Int
    B.length

    showBS :: (Show a) => a -> ByteString
    showBS :: a -> ByteString
    showBS = String -> ByteString
    B.pack (String -> ByteString) -> (a -> String) -> a -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    crlf :: ByteString
    crlf :: ByteString
    crlf = "\r\n"

    ------------------------------------------------------------------------------
    -- Reply parsers
    --
    {-# INLINE reply #-}
    reply :: Scanner Reply
    reply :: Scanner Reply
    reply = do
      Char
    c <- Scanner Char
    Scanner.anyChar8
      case Char
    c of
        '+' -> Scanner Reply
    string
        '-' -> Scanner Reply
    error
        ':' -> Scanner Reply
    integer
        '$' -> Scanner Reply
    bulk
        '*' -> Scanner Reply
    multi
        _ -> String -> Scanner Reply
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Unknown reply type"

    {-# INLINE string #-}
    string :: Scanner Reply
    string :: Scanner Reply
    string = ByteString -> Reply
    SingleLine (ByteString -> Reply) -> Scanner ByteString -> Scanner Reply
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Scanner ByteString
    line

    {-# INLINE error #-}
    error :: Scanner Reply
    error :: Scanner Reply
    error = ByteString -> Reply
    Error (ByteString -> Reply) -> Scanner ByteString -> Scanner Reply
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Scanner ByteString
    line

    {-# INLINE integer #-}
    integer :: Scanner Reply
    integer :: Scanner Reply
    integer = Integer -> Reply
    Integer (Integer -> Reply) -> Scanner Integer -> Scanner Reply
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Scanner Integer
    forall i. Integral i => Scanner i
    integral

    {-# INLINE bulk #-}
    bulk :: Scanner Reply
    bulk :: Scanner Reply
    bulk = Maybe ByteString -> Reply
    Bulk (Maybe ByteString -> Reply)
    -> Scanner (Maybe ByteString) -> Scanner Reply
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
      Int
    len <- Scanner Int
    forall i. Integral i => Scanner i
    integral
      if Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0
        then Maybe ByteString -> Scanner (Maybe ByteString)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ByteString
    forall a. Maybe a
    Nothing
        else ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just (ByteString -> Maybe ByteString)
    -> Scanner ByteString -> Scanner (Maybe ByteString)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Scanner ByteString
    Scanner.take Int
    len Scanner (Maybe ByteString)
    -> Scanner () -> Scanner (Maybe ByteString)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Scanner ()
    eol

    -- don't inline it to break the circle between reply and multi
    {-# NOINLINE multi #-}
    multi :: Scanner Reply
    multi :: Scanner Reply
    multi = Maybe [Reply] -> Reply
    MultiBulk (Maybe [Reply] -> Reply)
    -> Scanner (Maybe [Reply]) -> Scanner Reply
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> do
      Int
    len <- Scanner Int
    forall i. Integral i => Scanner i
    integral
      if Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < 0
        then Maybe [Reply] -> Scanner (Maybe [Reply])
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe [Reply]
    forall a. Maybe a
    Nothing
        else [Reply] -> Maybe [Reply]
    forall a. a -> Maybe a
    Just ([Reply] -> Maybe [Reply])
    -> Scanner [Reply] -> Scanner (Maybe [Reply])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Scanner Reply -> Scanner [Reply]
    forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
    replicateM Int
    len Scanner Reply
    reply

    {-# INLINE integral #-}
    integral :: Integral i => Scanner i
    integral :: Scanner i
    integral = do
      ByteString
    str <- Scanner ByteString
    line
      case Reader i -> Reader i
    forall a. Num a => Reader a -> Reader a
    Text.signed Reader i
    forall a. Integral a => Reader a
    Text.decimal (ByteString -> Text
    Text.decodeUtf8 ByteString
    str) of
        Left err :: String
    err -> String -> Scanner i
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (ShowS
    forall a. Show a => a -> String
    show String
    err)
        Right (l :: i
    l, _) -> i -> Scanner i
    forall (m :: * -> *) a. Monad m => a -> m a
    return i
    l

    {-# INLINE line #-}
    line :: Scanner ByteString
    line :: Scanner ByteString
    line = (Char -> Bool) -> Scanner ByteString
    Scanner.takeWhileChar8 (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= '\r') Scanner ByteString -> Scanner () -> Scanner ByteString
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Scanner ()
    eol

    {-# INLINE eol #-}
    eol :: Scanner ()
    eol :: Scanner ()
    eol = do
      Char -> Scanner ()
    Scanner.char8 '\r'
      Char -> Scanner ()
    Scanner.char8 '\n'