module Database.Redis.Internal (
HostName,PortID(..), defaultPort,
RedisConn(), connect, disconnect,
Redis(),runRedis,
send,
recv,
sendRequest
) where
import Control.Applicative
import Control.Monad.RWS
import Control.Concurrent
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Network (HostName, PortID(..), connectTo)
import System.IO (Handle, hFlush, hClose, hIsOpen)
import Database.Redis.Reply
import Database.Redis.Request
import Database.Redis.Types
data RedisConn = Conn (MVar (Handle, [Reply]))
withConn :: RedisConn
-> (Handle -> [Reply] -> IO ([Reply], a))
-> IO a
withConn (Conn conn) f = do
(h,rs) <- takeMVar conn
(rs',a) <- f h rs
putMVar conn (h,rs')
return a
connect :: HostName -> PortID -> IO RedisConn
connect host port = do
h <- connectTo host port
replies <- parseReply <$> LB.hGetContents h
Conn <$> newMVar (h, replies)
disconnect :: RedisConn -> IO ()
disconnect conn = withConn conn $ \h rs -> do
open <- hIsOpen h
when open (hClose h)
return (rs, ())
defaultPort :: PortID
defaultPort = PortNumber 6379
newtype Redis a = Redis (RWST Handle () [Reply] IO a)
deriving (Monad, MonadIO, Functor, Applicative)
runRedis :: RedisConn -> Redis a -> IO a
runRedis conn (Redis redis) = withConn conn $ \h rs -> do
open <- hIsOpen h
if open
then do
(a,rs',_) <- runRWST redis h rs
return (rs',a)
else error "Redis: disconnected"
send :: [B.ByteString] -> Redis ()
send req = Redis $ do
h <- ask
liftIO $ do
B.hPut h $ renderRequest req
hFlush h
recv :: Redis Reply
recv = Redis $ do
rs <- get
put (tail rs)
return (head rs)
sendRequest :: (RedisResult a) => [B.ByteString] -> Redis (Either Reply a)
sendRequest req = decode <$> (send req >> recv)