module Network.Starling
( open
, close
, Connection
, Key
, Value
, Result
, ResultM
, ResponseStatus(..)
, set
, get
, delete
, add
, replace
, update
, increment
, decrement
, flush
, stats
, version
) where
import Network.Starling.Connection
import Network.Starling.Core hiding
( get
, set
, delete
, add
, replace
, increment
, decrement
, flush
, stat
, version
, quit
)
import qualified Network.Starling.Core as Core
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BS
import qualified Data.Binary.Get as B
import Data.Word
import Control.Monad.Trans (liftIO, MonadIO)
type Result a = ResultM IO a
type ResultM m a = m (Either (ResponseStatus, ByteString) a)
set :: Connection -> Key -> Value -> Result ()
set con key value = simpleRequest con (Core.set key value) (const ())
add :: Connection -> Key -> Value -> Result ()
add con key value = simpleRequest con (Core.add key value) (const ())
replace :: Connection -> Key -> Value -> Result ()
replace con key value = simpleRequest con (Core.replace key value) (const ())
get :: Connection -> Key -> Result ByteString
get con key = simpleRequest con (Core.get key) rsBody
delete :: Connection -> Key -> Result ()
delete con key = simpleRequest con (Core.delete key) (const ())
update :: MonadIO m =>
Connection -> Key -> (Value -> m (Maybe Value)) -> ResultM m ()
update con key f
= do
response <- liftIO $ synchRequest con (Core.get key)
case rsStatus response of
NoError -> do
let oldVal = rsBody response
cas = rsCas response
res <- f oldVal
let baseRequest = case res of
Nothing -> Core.delete key
Just newVal -> Core.replace key newVal
request = addCAS cas $ baseRequest
liftIO $ simpleRequest con request (const ())
_ -> return . errorResult $ response
increment :: Connection -> Key -> Word64 -> Word64 -> Result Word64
increment con key amount init
= simpleRequest con (Core.increment key amount init) $ \response ->
B.runGet B.getWord64be (rsBody response)
decrement :: Connection -> Key -> Word64 -> Word64 -> Result Word64
decrement con key amount init
= simpleRequest con (Core.decrement key amount init) $ \response ->
B.runGet B.getWord64be (rsBody response)
flush :: Connection -> Result ()
flush con = simpleRequest con Core.flush (const ())
simpleRequest :: Connection -> Request -> (Response -> a) -> Result a
simpleRequest con req f
= do
response <- synchRequest con req
if rsStatus response == NoError
then return . Right . f $ response
else return . errorResult $ response
errorResult response = Left (rsStatus response, rsBody response)
stats :: Connection -> Result [(ByteString,ByteString)]
stats con
= do
resps <- synchRequestMulti con $ Core.stat Nothing
if null resps then error "fatal error in Network.Starling.stats"
else do
let resp = head resps
if rsStatus resp == NoError
then return . Right . unpackStats $ resps
else return $ errorResult resp
where
unpackStats
= filter (\(x,y) -> not (BS.null x && BS.null y)) .
map (\response -> (rsKey response, rsBody response))
oneStat :: Connection -> Key -> Result ByteString
oneStat con key = simpleRequest con (Core.stat $ Just key) rsBody
version :: Connection -> Result ByteString
version con = simpleRequest con Core.version rsBody