-- | Modified version of @"Database.Redis.Protocol"@
--
-- <https://github.com/informatikr/hedis/blob/master/src/Database/Redis/Protocol.hs>
--
-- Faktory takes a lot of inspiration from Redis, so the connection and
-- protocol-related code translated well with minor simplifications.
--
module Faktory.Protocol
  ( readReply
  , Reply(..)
  , reply
  ) where

import Prelude hiding (error)

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Text.Encoding as T
import qualified Data.Text.Read as T
import Scanner (Scanner)
import qualified Scanner

data Reply
  = SingleLine ByteString
  | Error ByteString
  | Bulk (Maybe ByteString)

readReply :: IO ByteString -> IO (Either String (Maybe ByteString))
readReply :: IO ByteString -> IO (Either String (Maybe ByteString))
readReply IO ByteString
getMore = Result Reply -> Either String (Maybe ByteString)
fromScanResult (Result Reply -> Either String (Maybe ByteString))
-> IO (Result Reply) -> IO (Either String (Maybe ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> Scanner Reply -> ByteString -> IO (Result Reply)
forall (m :: * -> *) a.
Monad m =>
m ByteString -> Scanner a -> ByteString -> m (Result a)
Scanner.scanWith IO ByteString
getMore Scanner Reply
reply ByteString
BS8.empty
 where
  fromScanResult :: Result Reply -> Either String (Maybe ByteString)
fromScanResult = \case
    Scanner.Fail ByteString
_ String
msg -> String -> Either String (Maybe ByteString)
forall a b. a -> Either a b
Left String
msg
    Scanner.More ByteString -> Result Reply
_ -> String -> Either String (Maybe ByteString)
forall a b. a -> Either a b
Left String
"Unexpected More"
    Scanner.Done ByteString
_ (SingleLine ByteString
bs) -> Maybe ByteString -> Either String (Maybe ByteString)
forall a b. b -> Either a b
Right (Maybe ByteString -> Either String (Maybe ByteString))
-> Maybe ByteString -> Either String (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
    Scanner.Done ByteString
_ (Error ByteString
bs) -> String -> Either String (Maybe ByteString)
forall a b. a -> Either a b
Left (String -> Either String (Maybe ByteString))
-> String -> Either String (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS8.unpack ByteString
bs
    Scanner.Done ByteString
_ (Bulk Maybe ByteString
mByteString) -> Maybe ByteString -> Either String (Maybe ByteString)
forall a b. b -> Either a b
Right Maybe ByteString
mByteString

{-# INLINE reply #-}
reply :: Scanner Reply
reply :: Scanner Reply
reply = do
  Char
c <- Scanner Char
Scanner.anyChar8
  case Char
c of
    Char
'+' -> Scanner Reply
string
    Char
'-' -> Scanner Reply
error
    Char
'$' -> Scanner Reply
bulk
    Char
_ -> String -> Scanner Reply
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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 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
< Int
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

{-# 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
T.signed Reader i
forall a. Integral a => Reader a
T.decimal (ByteString -> Text
T.decodeUtf8 ByteString
str) of
    Left String
err -> String -> Scanner i
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> String
forall a. Show a => a -> String
show String
err)
    Right (i
l, Text
_) -> 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
/= Char
'\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 Char
'\r'
  Char -> Scanner ()
Scanner.char8 Char
'\n'