module Network.Riak.Basic
(
ClientID
, Client(..)
, defaultClient
, Connection(..)
, connect
, disconnect
, ping
, getClientID
, setClientID
, getServerInfo
, Quorum(..)
, get
, put
, put_
, delete
, listBuckets
, foldKeys
, getBucket
, setBucket
, mapReduce
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Monad.IO.Class
import Data.Maybe (fromMaybe)
import Network.Riak.Connection.Internal
import Network.Riak.Escape (unescape)
import Network.Riak.Protocol.BucketProps
import Network.Riak.Protocol.Content
import Network.Riak.Protocol.ListKeysResponse
import Network.Riak.Protocol.MapReduce as MapReduce
import Network.Riak.Protocol.ServerInfo
import Network.Riak.Types.Internal hiding (MessageTag(..))
import qualified Data.Foldable as F
import qualified Data.Sequence as Seq
import qualified Network.Riak.Request as Req
import qualified Network.Riak.Response as Resp
import qualified Network.Riak.Types.Internal as T
ping :: Connection -> IO ()
ping conn = exchange_ conn Req.ping
getClientID :: Connection -> IO ClientID
getClientID conn = Resp.getClientID <$> exchange conn Req.getClientID
getServerInfo :: Connection -> IO ServerInfo
getServerInfo conn = exchange conn Req.getServerInfo
get :: Connection -> T.Bucket -> T.Key -> R
-> IO (Maybe (Seq.Seq Content, VClock))
get conn bucket key r = Resp.get <$> exchangeMaybe conn (Req.get bucket key r)
put :: Connection -> T.Bucket -> T.Key -> Maybe T.VClock
-> Content -> W -> DW
-> IO (Seq.Seq Content, VClock)
put conn bucket key mvclock cont w dw =
Resp.put <$> exchange conn (Req.put bucket key mvclock cont w dw True)
put_ :: Connection -> T.Bucket -> T.Key -> Maybe T.VClock
-> Content -> W -> DW
-> IO ()
put_ conn bucket key mvclock cont w dw =
exchange_ conn (Req.put bucket key mvclock cont w dw False)
delete :: Connection -> T.Bucket -> T.Key -> RW -> IO ()
delete conn bucket key rw = exchange_ conn $ Req.delete bucket key rw
listBuckets :: Connection -> IO (Seq.Seq T.Bucket)
listBuckets conn = Resp.listBuckets <$> exchange conn Req.listBuckets
foldKeys :: (MonadIO m) => Connection -> T.Bucket -> (a -> Key -> m a) -> a -> m a
foldKeys conn bucket f z0 = do
liftIO $ sendRequest conn $ Req.listKeys bucket
let g z = f z . unescape
loop z = do
ListKeysResponse{..} <- liftIO $ recvResponse conn
z1 <- F.foldlM g z keys
if fromMaybe False done
then return z1
else loop z1
loop z0
getBucket :: Connection -> T.Bucket -> IO BucketProps
getBucket conn bucket = Resp.getBucket <$> exchange conn (Req.getBucket bucket)
setBucket :: Connection -> T.Bucket -> BucketProps -> IO ()
setBucket conn bucket props = exchange_ conn $ Req.setBucket bucket props
mapReduce :: Connection -> Job -> (a -> MapReduce -> a) -> a -> IO a
mapReduce conn job f z0 = loop z0 =<< (exchange conn . Req.mapReduce $ job)
where
loop z mr = do
let !z' = f z mr
if fromMaybe False . MapReduce.done $ mr
then return z'
else loop z' =<< recvResponse conn