module Database.Redis.Core (
Connection(..),
Redis(),runRedis,runRedisInternal,
send,
recv,
sendRequest
) where
import Control.Applicative
import Control.Arrow
import Control.Monad.Reader
import Control.Concurrent
import qualified Data.ByteString as B
import Data.IORef
import Data.Pool
import System.IO (Handle, hFlush)
import Database.Redis.Reply
import Database.Redis.Request
import Database.Redis.Types
newtype Connection = Conn (Pool (MVar (Handle, IORef [Reply])))
newtype Redis a = Redis (ReaderT RedisEnv IO a)
deriving (Monad, MonadIO, Functor, Applicative)
type RedisEnv = (Handle, IORef [Reply])
askHandle :: ReaderT RedisEnv IO Handle
askHandle = asks fst
askReplies :: ReaderT RedisEnv IO (IORef [Reply])
askReplies = asks snd
runRedis :: Connection -> Redis a -> IO a
runRedis (Conn pool) redis =
withResource pool $ \conn ->
withMVar conn $ \conn' -> runRedisInternal conn' redis
runRedisInternal :: RedisEnv -> Redis a -> IO a
runRedisInternal env (Redis redis) = runReaderT redis env
send :: [B.ByteString] -> Redis ()
send req = Redis $ do
h <- askHandle
liftIO $ do
B.hPut h $ renderRequest req
hFlush h
recv :: Redis Reply
recv = Redis $ do
rs <- askReplies
liftIO $ atomicModifyIORef rs (tail &&& head)
sendRequest :: (RedisResult a) => [B.ByteString] -> Redis (Either Reply a)
sendRequest req = decode <$> (send req >> recv)