{-# LANGUAGE BangPatterns, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP #-}
-- |
-- Module:      Network.Riak.Resolvable.Internal
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>
-- Stability:   experimental
-- Portability: portable
--
-- Storage and retrieval of data with automatic conflict resolution.
--
-- The 'put' and 'putMany' functions will attempt to perform automatic
-- conflict resolution a large number of times.  If they give up due
-- to apparently being stuck in a loop, they will throw a
-- 'ResolutionFailure' exception.

module Network.Riak.Resolvable.Internal
    (
      Resolvable(..)
    , ResolvableMonoid(..)
    , ResolutionFailure(..)
    , get
    , getMany
    , modify
    , modify_
    , put
    , put_
    , putMany
    , putMany_
    ) where

#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import Control.Arrow (first)
import Control.Exception (Exception, throwIO)
import Control.Monad (unless)
import Control.Monad.IO.Class
import Data.Aeson.Types (FromJSON, ToJSON)
import Data.Data (Data)
import Data.Either (partitionEithers)
import Data.Function (on)
import Data.List (foldl', sortBy)
import Data.Maybe (isJust)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (Monoid(mappend))
#endif
import Data.Semigroup (Semigroup)
import Data.Typeable (Typeable)
import Network.Riak.Debug (debugValues)
import Network.Riak.Types.Internal hiding (MessageTag(..))

-- | Automated conflict resolution failed.
data ResolutionFailure = RetriesExceeded
    -- ^ Too many attempts were made to resolve a conflict, with each
    -- attempt resulting in another conflict.
    --
    -- The number of retries that the library will attempt is high
    -- (64). This makes it extremely unlikely that this exception will
    -- be thrown during normal application operation.  Instead, this
    -- exception is most likely to be thrown as a result of a bug in
    -- your application code, for example if your 'resolve' function
    -- is misbehaving.
                         deriving (ResolutionFailure -> ResolutionFailure -> Bool
(ResolutionFailure -> ResolutionFailure -> Bool)
-> (ResolutionFailure -> ResolutionFailure -> Bool)
-> Eq ResolutionFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolutionFailure -> ResolutionFailure -> Bool
$c/= :: ResolutionFailure -> ResolutionFailure -> Bool
== :: ResolutionFailure -> ResolutionFailure -> Bool
$c== :: ResolutionFailure -> ResolutionFailure -> Bool
Eq, Int -> ResolutionFailure -> ShowS
[ResolutionFailure] -> ShowS
ResolutionFailure -> String
(Int -> ResolutionFailure -> ShowS)
-> (ResolutionFailure -> String)
-> ([ResolutionFailure] -> ShowS)
-> Show ResolutionFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolutionFailure] -> ShowS
$cshowList :: [ResolutionFailure] -> ShowS
show :: ResolutionFailure -> String
$cshow :: ResolutionFailure -> String
showsPrec :: Int -> ResolutionFailure -> ShowS
$cshowsPrec :: Int -> ResolutionFailure -> ShowS
Show, Typeable)

instance Exception ResolutionFailure

-- | A type that can automatically resolve a vector clock conflict
-- between two or more versions of a value.
--
-- Instances must be symmetric in their behaviour, such that the
-- following law is obeyed:
--
-- > resolve a b == resolve b a
--
-- Otherwise, there are no restrictions on the behaviour of 'resolve'.
-- The result may be @a@, @b@, a value derived from @a@ and @b@, or
-- something else.
--
-- If several conflicting siblings are found, 'resolve' will be
-- applied over all of them using a fold, to yield a single
-- \"winner\".
class (Show a) => Resolvable a where
    -- | Resolve a conflict between two values.
    resolve :: a -> a -> a

-- | A newtype wrapper that uses the 'mappend' method of a type's
-- 'Monoid' instance to perform vector clock conflict resolution.
newtype ResolvableMonoid a = RM { ResolvableMonoid a -> a
unRM :: a }
    deriving (ResolvableMonoid a -> ResolvableMonoid a -> Bool
(ResolvableMonoid a -> ResolvableMonoid a -> Bool)
-> (ResolvableMonoid a -> ResolvableMonoid a -> Bool)
-> Eq (ResolvableMonoid a)
forall a. Eq a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolvableMonoid a -> ResolvableMonoid a -> Bool
$c/= :: forall a. Eq a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
== :: ResolvableMonoid a -> ResolvableMonoid a -> Bool
$c== :: forall a. Eq a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
Eq, Eq (ResolvableMonoid a)
Eq (ResolvableMonoid a)
-> (ResolvableMonoid a -> ResolvableMonoid a -> Ordering)
-> (ResolvableMonoid a -> ResolvableMonoid a -> Bool)
-> (ResolvableMonoid a -> ResolvableMonoid a -> Bool)
-> (ResolvableMonoid a -> ResolvableMonoid a -> Bool)
-> (ResolvableMonoid a -> ResolvableMonoid a -> Bool)
-> (ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a)
-> (ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a)
-> Ord (ResolvableMonoid a)
ResolvableMonoid a -> ResolvableMonoid a -> Bool
ResolvableMonoid a -> ResolvableMonoid a -> Ordering
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ResolvableMonoid a)
forall a. Ord a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
forall a.
Ord a =>
ResolvableMonoid a -> ResolvableMonoid a -> Ordering
forall a.
Ord a =>
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
min :: ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
$cmin :: forall a.
Ord a =>
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
max :: ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
$cmax :: forall a.
Ord a =>
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
>= :: ResolvableMonoid a -> ResolvableMonoid a -> Bool
$c>= :: forall a. Ord a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
> :: ResolvableMonoid a -> ResolvableMonoid a -> Bool
$c> :: forall a. Ord a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
<= :: ResolvableMonoid a -> ResolvableMonoid a -> Bool
$c<= :: forall a. Ord a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
< :: ResolvableMonoid a -> ResolvableMonoid a -> Bool
$c< :: forall a. Ord a => ResolvableMonoid a -> ResolvableMonoid a -> Bool
compare :: ResolvableMonoid a -> ResolvableMonoid a -> Ordering
$ccompare :: forall a.
Ord a =>
ResolvableMonoid a -> ResolvableMonoid a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ResolvableMonoid a)
Ord, ReadPrec [ResolvableMonoid a]
ReadPrec (ResolvableMonoid a)
Int -> ReadS (ResolvableMonoid a)
ReadS [ResolvableMonoid a]
(Int -> ReadS (ResolvableMonoid a))
-> ReadS [ResolvableMonoid a]
-> ReadPrec (ResolvableMonoid a)
-> ReadPrec [ResolvableMonoid a]
-> Read (ResolvableMonoid a)
forall a. Read a => ReadPrec [ResolvableMonoid a]
forall a. Read a => ReadPrec (ResolvableMonoid a)
forall a. Read a => Int -> ReadS (ResolvableMonoid a)
forall a. Read a => ReadS [ResolvableMonoid a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ResolvableMonoid a]
$creadListPrec :: forall a. Read a => ReadPrec [ResolvableMonoid a]
readPrec :: ReadPrec (ResolvableMonoid a)
$creadPrec :: forall a. Read a => ReadPrec (ResolvableMonoid a)
readList :: ReadS [ResolvableMonoid a]
$creadList :: forall a. Read a => ReadS [ResolvableMonoid a]
readsPrec :: Int -> ReadS (ResolvableMonoid a)
$creadsPrec :: forall a. Read a => Int -> ReadS (ResolvableMonoid a)
Read, Int -> ResolvableMonoid a -> ShowS
[ResolvableMonoid a] -> ShowS
ResolvableMonoid a -> String
(Int -> ResolvableMonoid a -> ShowS)
-> (ResolvableMonoid a -> String)
-> ([ResolvableMonoid a] -> ShowS)
-> Show (ResolvableMonoid a)
forall a. Show a => Int -> ResolvableMonoid a -> ShowS
forall a. Show a => [ResolvableMonoid a] -> ShowS
forall a. Show a => ResolvableMonoid a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolvableMonoid a] -> ShowS
$cshowList :: forall a. Show a => [ResolvableMonoid a] -> ShowS
show :: ResolvableMonoid a -> String
$cshow :: forall a. Show a => ResolvableMonoid a -> String
showsPrec :: Int -> ResolvableMonoid a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ResolvableMonoid a -> ShowS
Show, Typeable, Typeable (ResolvableMonoid a)
DataType
Constr
Typeable (ResolvableMonoid a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ResolvableMonoid a
    -> c (ResolvableMonoid a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ResolvableMonoid a))
-> (ResolvableMonoid a -> Constr)
-> (ResolvableMonoid a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ResolvableMonoid a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ResolvableMonoid a)))
-> ((forall b. Data b => b -> b)
    -> ResolvableMonoid a -> ResolvableMonoid a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ResolvableMonoid a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ResolvableMonoid a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ResolvableMonoid a -> m (ResolvableMonoid a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ResolvableMonoid a -> m (ResolvableMonoid a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ResolvableMonoid a -> m (ResolvableMonoid a))
-> Data (ResolvableMonoid a)
ResolvableMonoid a -> DataType
ResolvableMonoid a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (ResolvableMonoid a))
(forall b. Data b => b -> b)
-> ResolvableMonoid a -> ResolvableMonoid a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ResolvableMonoid a
-> c (ResolvableMonoid a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ResolvableMonoid a)
forall a. Data a => Typeable (ResolvableMonoid a)
forall a. Data a => ResolvableMonoid a -> DataType
forall a. Data a => ResolvableMonoid a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b)
-> ResolvableMonoid a -> ResolvableMonoid a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> ResolvableMonoid a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> ResolvableMonoid a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ResolvableMonoid a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ResolvableMonoid a
-> c (ResolvableMonoid a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ResolvableMonoid a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ResolvableMonoid a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ResolvableMonoid a -> u
forall u. (forall d. Data d => d -> u) -> ResolvableMonoid a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ResolvableMonoid a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ResolvableMonoid a
-> c (ResolvableMonoid a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ResolvableMonoid a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ResolvableMonoid a))
$cRM :: Constr
$tResolvableMonoid :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
gmapMp :: (forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
gmapM :: (forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> ResolvableMonoid a -> m (ResolvableMonoid a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> ResolvableMonoid a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> ResolvableMonoid a -> u
gmapQ :: (forall d. Data d => d -> u) -> ResolvableMonoid a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> ResolvableMonoid a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ResolvableMonoid a -> r
gmapT :: (forall b. Data b => b -> b)
-> ResolvableMonoid a -> ResolvableMonoid a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b)
-> ResolvableMonoid a -> ResolvableMonoid a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ResolvableMonoid a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ResolvableMonoid a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (ResolvableMonoid a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ResolvableMonoid a))
dataTypeOf :: ResolvableMonoid a -> DataType
$cdataTypeOf :: forall a. Data a => ResolvableMonoid a -> DataType
toConstr :: ResolvableMonoid a -> Constr
$ctoConstr :: forall a. Data a => ResolvableMonoid a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ResolvableMonoid a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ResolvableMonoid a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ResolvableMonoid a
-> c (ResolvableMonoid a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ResolvableMonoid a
-> c (ResolvableMonoid a)
$cp1Data :: forall a. Data a => Typeable (ResolvableMonoid a)
Data, b -> ResolvableMonoid a -> ResolvableMonoid a
NonEmpty (ResolvableMonoid a) -> ResolvableMonoid a
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
(ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a)
-> (NonEmpty (ResolvableMonoid a) -> ResolvableMonoid a)
-> (forall b.
    Integral b =>
    b -> ResolvableMonoid a -> ResolvableMonoid a)
-> Semigroup (ResolvableMonoid a)
forall b.
Integral b =>
b -> ResolvableMonoid a -> ResolvableMonoid a
forall a.
Semigroup a =>
NonEmpty (ResolvableMonoid a) -> ResolvableMonoid a
forall a.
Semigroup a =>
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
forall a b.
(Semigroup a, Integral b) =>
b -> ResolvableMonoid a -> ResolvableMonoid a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> ResolvableMonoid a -> ResolvableMonoid a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> ResolvableMonoid a -> ResolvableMonoid a
sconcat :: NonEmpty (ResolvableMonoid a) -> ResolvableMonoid a
$csconcat :: forall a.
Semigroup a =>
NonEmpty (ResolvableMonoid a) -> ResolvableMonoid a
<> :: ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
$c<> :: forall a.
Semigroup a =>
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
Semigroup, Semigroup (ResolvableMonoid a)
ResolvableMonoid a
Semigroup (ResolvableMonoid a)
-> ResolvableMonoid a
-> (ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a)
-> ([ResolvableMonoid a] -> ResolvableMonoid a)
-> Monoid (ResolvableMonoid a)
[ResolvableMonoid a] -> ResolvableMonoid a
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (ResolvableMonoid a)
forall a. Monoid a => ResolvableMonoid a
forall a. Monoid a => [ResolvableMonoid a] -> ResolvableMonoid a
forall a.
Monoid a =>
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
mconcat :: [ResolvableMonoid a] -> ResolvableMonoid a
$cmconcat :: forall a. Monoid a => [ResolvableMonoid a] -> ResolvableMonoid a
mappend :: ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
$cmappend :: forall a.
Monoid a =>
ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
mempty :: ResolvableMonoid a
$cmempty :: forall a. Monoid a => ResolvableMonoid a
$cp1Monoid :: forall a. Monoid a => Semigroup (ResolvableMonoid a)
Monoid, Value -> Parser [ResolvableMonoid a]
Value -> Parser (ResolvableMonoid a)
(Value -> Parser (ResolvableMonoid a))
-> (Value -> Parser [ResolvableMonoid a])
-> FromJSON (ResolvableMonoid a)
forall a. FromJSON a => Value -> Parser [ResolvableMonoid a]
forall a. FromJSON a => Value -> Parser (ResolvableMonoid a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ResolvableMonoid a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [ResolvableMonoid a]
parseJSON :: Value -> Parser (ResolvableMonoid a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (ResolvableMonoid a)
FromJSON, [ResolvableMonoid a] -> Encoding
[ResolvableMonoid a] -> Value
ResolvableMonoid a -> Encoding
ResolvableMonoid a -> Value
(ResolvableMonoid a -> Value)
-> (ResolvableMonoid a -> Encoding)
-> ([ResolvableMonoid a] -> Value)
-> ([ResolvableMonoid a] -> Encoding)
-> ToJSON (ResolvableMonoid a)
forall a. ToJSON a => [ResolvableMonoid a] -> Encoding
forall a. ToJSON a => [ResolvableMonoid a] -> Value
forall a. ToJSON a => ResolvableMonoid a -> Encoding
forall a. ToJSON a => ResolvableMonoid a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ResolvableMonoid a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [ResolvableMonoid a] -> Encoding
toJSONList :: [ResolvableMonoid a] -> Value
$ctoJSONList :: forall a. ToJSON a => [ResolvableMonoid a] -> Value
toEncoding :: ResolvableMonoid a -> Encoding
$ctoEncoding :: forall a. ToJSON a => ResolvableMonoid a -> Encoding
toJSON :: ResolvableMonoid a -> Value
$ctoJSON :: forall a. ToJSON a => ResolvableMonoid a -> Value
ToJSON)

instance (Show a, Monoid a) => Resolvable (ResolvableMonoid a) where
    resolve :: ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
resolve = ResolvableMonoid a -> ResolvableMonoid a -> ResolvableMonoid a
forall a. Monoid a => a -> a -> a
mappend
    {-# INLINE resolve #-}

instance (Resolvable a) => Resolvable (Maybe a) where
    resolve :: Maybe a -> Maybe a -> Maybe a
resolve (Just a
a)   (Just a
b) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> a -> a
forall a. Resolvable a => a -> a -> a
resolve a
a a
b)
    resolve a :: Maybe a
a@(Just a
_) Maybe a
_        = Maybe a
a
    resolve Maybe a
_          Maybe a
b        = Maybe a
b
    {-# INLINE resolve #-}

type Get a = Connection -> Maybe BucketType -> Bucket -> Key -> R -> IO (Maybe ([a], VClock))

get :: (Resolvable a) => Get a
    -> (Connection -> Maybe BucketType -> Bucket -> Key -> R -> IO (Maybe (a, VClock)))
get :: Get a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe (a, VClock))
get Get a
doGet Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r =
    (([a], VClock) -> (a, VClock))
-> Maybe ([a], VClock) -> Maybe (a, VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> a) -> ([a], VClock) -> (a, VClock)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [a] -> a
forall a. Resolvable a => [a] -> a
resolveMany) (Maybe ([a], VClock) -> Maybe (a, VClock))
-> IO (Maybe ([a], VClock)) -> IO (Maybe (a, VClock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Get a
doGet Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r
{-# INLINE get #-}

getMany :: (Resolvable a) =>
           (Connection -> Maybe BucketType -> Bucket -> [Key]
                       -> R -> IO [Maybe ([a], VClock)])
        -> Connection -> Maybe BucketType -> Bucket -> [Key]
        -> R -> IO [Maybe (a, VClock)]
getMany :: (Connection
 -> Maybe BucketType
 -> BucketType
 -> [BucketType]
 -> R
 -> IO [Maybe ([a], VClock)])
-> Connection
-> Maybe BucketType
-> BucketType
-> [BucketType]
-> R
-> IO [Maybe (a, VClock)]
getMany Connection
-> Maybe BucketType
-> BucketType
-> [BucketType]
-> R
-> IO [Maybe ([a], VClock)]
doGet Connection
conn Maybe BucketType
bt BucketType
b [BucketType]
ks R
r =
    (Maybe ([a], VClock) -> Maybe (a, VClock))
-> [Maybe ([a], VClock)] -> [Maybe (a, VClock)]
forall a b. (a -> b) -> [a] -> [b]
map ((([a], VClock) -> (a, VClock))
-> Maybe ([a], VClock) -> Maybe (a, VClock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([a] -> a) -> ([a], VClock) -> (a, VClock)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first [a] -> a
forall a. Resolvable a => [a] -> a
resolveMany)) ([Maybe ([a], VClock)] -> [Maybe (a, VClock)])
-> IO [Maybe ([a], VClock)] -> IO [Maybe (a, VClock)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Connection
-> Maybe BucketType
-> BucketType
-> [BucketType]
-> R
-> IO [Maybe ([a], VClock)]
doGet Connection
conn Maybe BucketType
bt BucketType
b [BucketType]
ks R
r
{-# INLINE getMany #-}

-- If Riak receives a put request with no vclock, and the given
-- type+bucket+key already exists, it will treat the missing vclock as
-- stale, ignore the put request, and send back whatever values it
-- currently knows about.  The same problem will arise if we send a
-- vclock that really is stale, but that's much less likely to occur.
-- We handle the missing-vclock case in the single-body-response case
-- of both put and putMany below, but we do not (can not?) handle the
-- stale-vclock case.

type Put a = Connection -> Maybe BucketType -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
           -> IO ([a], VClock)

put :: (Resolvable a) => Put a
    -> Connection -> Maybe BucketType -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
    -> IO (a, VClock)
put :: Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO (a, VClock)
put Put a
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock0 a
val0 R
w R
dw = do
  let go :: Int -> a -> Maybe VClock -> IO (a, VClock)
go !Int
i a
val Maybe VClock
mvclock
         | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxRetries = ResolutionFailure -> IO (a, VClock)
forall e a. Exception e => e -> IO a
throwIO ResolutionFailure
RetriesExceeded
         | Bool
otherwise       = do
        ([a]
xs, VClock
vclock) <- Put a
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock a
val R
w R
dw
        case [a]
xs of
          [a
x] | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
|| Maybe VClock -> Bool
forall a. Maybe a -> Bool
isJust Maybe VClock
mvclock -> (a, VClock) -> IO (a, VClock)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x, VClock
vclock)
          (a
_:[a]
_) -> do String -> String -> [a] -> IO ()
forall a. Show a => String -> String -> [a] -> IO ()
debugValues String
"put" String
"conflict" [a]
xs
                      Int -> a -> Maybe VClock -> IO (a, VClock)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([a] -> a
forall a. Resolvable a => [a] -> a
resolveMany [a]
xs) (VClock -> Maybe VClock
forall a. a -> Maybe a
Just VClock
vclock)
          []    -> String -> String -> String -> IO (a, VClock)
forall a. String -> String -> String -> a
unexError String
"Network.Riak.Resolvable" String
"put"
                   String
"received empty response from server"
  Int -> a -> Maybe VClock -> IO (a, VClock)
go (Int
0::Int) a
val0 Maybe VClock
mvclock0
{-# INLINE put #-}

-- | The maximum number of times to retry conflict resolution.
maxRetries :: Int
maxRetries :: Int
maxRetries = Int
64
{-# INLINE maxRetries #-}

put_ :: (Resolvable a) =>
        (Connection -> Maybe BucketType -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
                    -> IO ([a], VClock))
     -> Connection -> Maybe BucketType -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
     -> IO ()
put_ :: (Connection
 -> Maybe BucketType
 -> BucketType
 -> BucketType
 -> Maybe VClock
 -> a
 -> R
 -> R
 -> IO ([a], VClock))
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO ()
put_ Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO ([a], VClock)
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock0 a
val0 R
w R
dw =
    (Connection
 -> Maybe BucketType
 -> BucketType
 -> BucketType
 -> Maybe VClock
 -> a
 -> R
 -> R
 -> IO ([a], VClock))
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO (a, VClock)
forall a.
Resolvable a =>
Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO (a, VClock)
put Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO ([a], VClock)
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' Maybe VClock
mvclock0 a
val0 R
w R
dw IO (a, VClock) -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE put_ #-}

modify :: (MonadIO m, Resolvable a) => Get a -> Put a
       -> Connection -> Maybe BucketType -> Bucket
       -> Key -> R -> W -> DW -> (Maybe a -> m (a,b))
       -> m (a,b)
modify :: Get a
-> Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> R
-> R
-> (Maybe a -> m (a, b))
-> m (a, b)
modify Get a
doGet Put a
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r R
w R
dw Maybe a -> m (a, b)
act = do
  Maybe (a, VClock)
a0 <- IO (Maybe (a, VClock)) -> m (Maybe (a, VClock))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (a, VClock)) -> m (Maybe (a, VClock)))
-> IO (Maybe (a, VClock)) -> m (Maybe (a, VClock))
forall a b. (a -> b) -> a -> b
$ Get a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe (a, VClock))
forall a.
Resolvable a =>
Get a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe (a, VClock))
get Get a
doGet Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r
  (a
a,b
b) <- Maybe a -> m (a, b)
act ((a, VClock) -> a
forall a b. (a, b) -> a
fst ((a, VClock) -> a) -> Maybe (a, VClock) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, VClock)
a0)
  (a
a',VClock
_) <- IO (a, VClock) -> m (a, VClock)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (a, VClock) -> m (a, VClock))
-> IO (a, VClock) -> m (a, VClock)
forall a b. (a -> b) -> a -> b
$ Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO (a, VClock)
forall a.
Resolvable a =>
Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO (a, VClock)
put Put a
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' ((a, VClock) -> VClock
forall a b. (a, b) -> b
snd ((a, VClock) -> VClock) -> Maybe (a, VClock) -> Maybe VClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, VClock)
a0) a
a R
w R
dw
  (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a',b
b)
{-# INLINE modify #-}

modify_ :: (MonadIO m, Resolvable a) => Get a -> Put a
        -> Connection -> Maybe BucketType -> Bucket
        -> Key -> R -> W -> DW -> (Maybe a -> m a)
        -> m a
modify_ :: Get a
-> Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> R
-> R
-> (Maybe a -> m a)
-> m a
modify_ Get a
doGet Put a
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r R
w R
dw Maybe a -> m a
act = do
  Maybe (a, VClock)
a0 <- IO (Maybe (a, VClock)) -> m (Maybe (a, VClock))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (a, VClock)) -> m (Maybe (a, VClock)))
-> IO (Maybe (a, VClock)) -> m (Maybe (a, VClock))
forall a b. (a -> b) -> a -> b
$ Get a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe (a, VClock))
forall a.
Resolvable a =>
Get a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> R
-> IO (Maybe (a, VClock))
get Get a
doGet Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' R
r
  a
a <- Maybe a -> m a
act ((a, VClock) -> a
forall a b. (a, b) -> a
fst ((a, VClock) -> a) -> Maybe (a, VClock) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, VClock)
a0)
  IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ (a, VClock) -> a
forall a b. (a, b) -> a
fst ((a, VClock) -> a) -> IO (a, VClock) -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO (a, VClock)
forall a.
Resolvable a =>
Put a
-> Connection
-> Maybe BucketType
-> BucketType
-> BucketType
-> Maybe VClock
-> a
-> R
-> R
-> IO (a, VClock)
put Put a
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' BucketType
key' ((a, VClock) -> VClock
forall a b. (a, b) -> b
snd ((a, VClock) -> VClock) -> Maybe (a, VClock) -> Maybe VClock
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (a, VClock)
a0) a
a R
w R
dw
{-# INLINE modify_ #-}

putMany :: (Resolvable a) =>
           (Connection -> Maybe BucketType -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW
                       -> IO [([a], VClock)])
        -> Connection -> Maybe BucketType -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW
        -> IO [(a, VClock)]
putMany :: (Connection
 -> Maybe BucketType
 -> BucketType
 -> [(BucketType, Maybe VClock, a)]
 -> R
 -> R
 -> IO [([a], VClock)])
-> Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO [(a, VClock)]
putMany Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO [([a], VClock)]
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' [(BucketType, Maybe VClock, a)]
puts0 R
w R
dw = Int
-> [(Int, (a, VClock))]
-> [(Int, (BucketType, Maybe VClock, a))]
-> IO [(a, VClock)]
forall a.
(Show a, Ord a, Num a) =>
Int
-> [(a, (a, VClock))]
-> [(a, (BucketType, Maybe VClock, a))]
-> IO [(a, VClock)]
go (Int
0::Int) [] ([(Int, (BucketType, Maybe VClock, a))] -> IO [(a, VClock)])
-> ([(BucketType, Maybe VClock, a)]
    -> [(Int, (BucketType, Maybe VClock, a))])
-> [(BucketType, Maybe VClock, a)]
-> IO [(a, VClock)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int]
-> [(BucketType, Maybe VClock, a)]
-> [(Int, (BucketType, Maybe VClock, a))]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Int
0::Int)..] ([(BucketType, Maybe VClock, a)] -> IO [(a, VClock)])
-> [(BucketType, Maybe VClock, a)] -> IO [(a, VClock)]
forall a b. (a -> b) -> a -> b
$ [(BucketType, Maybe VClock, a)]
puts0
 where
  go :: Int
-> [(a, (a, VClock))]
-> [(a, (BucketType, Maybe VClock, a))]
-> IO [(a, VClock)]
go Int
_ [(a, (a, VClock))]
acc [] = [(a, VClock)] -> IO [(a, VClock)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, VClock)] -> IO [(a, VClock)])
-> ([(a, (a, VClock))] -> [(a, VClock)])
-> [(a, (a, VClock))]
-> IO [(a, VClock)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, (a, VClock)) -> (a, VClock))
-> [(a, (a, VClock))] -> [(a, VClock)]
forall a b. (a -> b) -> [a] -> [b]
map (a, (a, VClock)) -> (a, VClock)
forall a b. (a, b) -> b
snd ([(a, (a, VClock))] -> [(a, VClock)])
-> ([(a, (a, VClock))] -> [(a, (a, VClock))])
-> [(a, (a, VClock))]
-> [(a, VClock)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, (a, VClock)) -> (a, (a, VClock)) -> Ordering)
-> [(a, (a, VClock))] -> [(a, (a, VClock))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (a -> a -> Ordering)
-> ((a, (a, VClock)) -> a)
-> (a, (a, VClock))
-> (a, (a, VClock))
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, (a, VClock)) -> a
forall a b. (a, b) -> a
fst) ([(a, (a, VClock))] -> IO [(a, VClock)])
-> [(a, (a, VClock))] -> IO [(a, VClock)]
forall a b. (a -> b) -> a -> b
$ [(a, (a, VClock))]
acc
  go !Int
i [(a, (a, VClock))]
acc [(a, (BucketType, Maybe VClock, a))]
puts
      | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxRetries = ResolutionFailure -> IO [(a, VClock)]
forall e a. Exception e => e -> IO a
throwIO ResolutionFailure
RetriesExceeded
      | Bool
otherwise = do
    [([a], VClock)]
rs <- Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO [([a], VClock)]
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' (((a, (BucketType, Maybe VClock, a))
 -> (BucketType, Maybe VClock, a))
-> [(a, (BucketType, Maybe VClock, a))]
-> [(BucketType, Maybe VClock, a)]
forall a b. (a -> b) -> [a] -> [b]
map (a, (BucketType, Maybe VClock, a)) -> (BucketType, Maybe VClock, a)
forall a b. (a, b) -> b
snd [(a, (BucketType, Maybe VClock, a))]
puts) R
w R
dw
    let ([(a, (BucketType, Maybe VClock, a))]
conflicts, [(a, (a, VClock))]
ok) = [Either (a, (BucketType, Maybe VClock, a)) (a, (a, VClock))]
-> ([(a, (BucketType, Maybe VClock, a))], [(a, (a, VClock))])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (a, (BucketType, Maybe VClock, a)) (a, (a, VClock))]
 -> ([(a, (BucketType, Maybe VClock, a))], [(a, (a, VClock))]))
-> [Either (a, (BucketType, Maybe VClock, a)) (a, (a, VClock))]
-> ([(a, (BucketType, Maybe VClock, a))], [(a, (a, VClock))])
forall a b. (a -> b) -> a -> b
$ ((a, (BucketType, Maybe VClock, a))
 -> ([a], VClock)
 -> Either (a, (BucketType, Maybe VClock, a)) (a, (a, VClock)))
-> [(a, (BucketType, Maybe VClock, a))]
-> [([a], VClock)]
-> [Either (a, (BucketType, Maybe VClock, a)) (a, (a, VClock))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (a, (BucketType, Maybe VClock, a))
-> ([a], VClock)
-> Either (a, (BucketType, Maybe VClock, a)) (a, (a, VClock))
forall a c a a c a.
(Ord a, Num a, Resolvable c) =>
(a, (a, Maybe a, c))
-> ([c], a) -> Either (a, (a, Maybe a, c)) (a, (c, a))
mush [(a, (BucketType, Maybe VClock, a))]
puts [([a], VClock)]
rs
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(a, (BucketType, Maybe VClock, a))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, (BucketType, Maybe VClock, a))]
conflicts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      String -> String -> [(a, (BucketType, Maybe VClock, a))] -> IO ()
forall a. Show a => String -> String -> [a] -> IO ()
debugValues String
"putMany" String
"conflicts" [(a, (BucketType, Maybe VClock, a))]
conflicts
    Int
-> [(a, (a, VClock))]
-> [(a, (BucketType, Maybe VClock, a))]
-> IO [(a, VClock)]
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) ([(a, (a, VClock))]
ok[(a, (a, VClock))] -> [(a, (a, VClock))] -> [(a, (a, VClock))]
forall a. [a] -> [a] -> [a]
++[(a, (a, VClock))]
acc) [(a, (BucketType, Maybe VClock, a))]
conflicts
  mush :: (a, (a, Maybe a, c))
-> ([c], a) -> Either (a, (a, Maybe a, c)) (a, (c, a))
mush (a
i,(a
k,Maybe a
mv,c
_)) ([c]
cs,a
v) =
      case [c]
cs of
        [c
x] | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 Bool -> Bool -> Bool
|| Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
mv -> (a, (c, a)) -> Either (a, (a, Maybe a, c)) (a, (c, a))
forall a b. b -> Either a b
Right (a
i,(c
x,a
v))
        (c
_:[c]
_) -> (a, (a, Maybe a, c)) -> Either (a, (a, Maybe a, c)) (a, (c, a))
forall a b. a -> Either a b
Left (a
i,(a
k,a -> Maybe a
forall a. a -> Maybe a
Just a
v, [c] -> c
forall a. Resolvable a => [a] -> a
resolveMany [c]
cs))
        []    -> String
-> String -> String -> Either (a, (a, Maybe a, c)) (a, (c, a))
forall a. String -> String -> String -> a
unexError String
"Network.Riak.Resolvable" String
"put"
                 String
"received empty response from server"
{-# INLINE putMany #-}

putMany_ :: (Resolvable a) =>
            (Connection -> Maybe BucketType -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW
                        -> IO [([a], VClock)])
         -> Connection -> Maybe BucketType -> Bucket
         -> [(Key, Maybe VClock, a)] -> W -> DW -> IO ()
putMany_ :: (Connection
 -> Maybe BucketType
 -> BucketType
 -> [(BucketType, Maybe VClock, a)]
 -> R
 -> R
 -> IO [([a], VClock)])
-> Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO ()
putMany_ Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO [([a], VClock)]
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' [(BucketType, Maybe VClock, a)]
puts0 R
w R
dw =
    (Connection
 -> Maybe BucketType
 -> BucketType
 -> [(BucketType, Maybe VClock, a)]
 -> R
 -> R
 -> IO [([a], VClock)])
-> Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO [(a, VClock)]
forall a.
Resolvable a =>
(Connection
 -> Maybe BucketType
 -> BucketType
 -> [(BucketType, Maybe VClock, a)]
 -> R
 -> R
 -> IO [([a], VClock)])
-> Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO [(a, VClock)]
putMany Connection
-> Maybe BucketType
-> BucketType
-> [(BucketType, Maybe VClock, a)]
-> R
-> R
-> IO [([a], VClock)]
doPut Connection
conn Maybe BucketType
btype BucketType
bucket' [(BucketType, Maybe VClock, a)]
puts0 R
w R
dw IO [(a, VClock)] -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINE putMany_ #-}

resolveMany' :: (Resolvable a) => a -> [a] -> a
resolveMany' :: a -> [a] -> a
resolveMany' = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Resolvable a => a -> a -> a
resolve
{-# INLINE resolveMany' #-}

resolveMany :: (Resolvable a) => [a] -> a
resolveMany :: [a] -> a
resolveMany (a
a:[a]
as) = a -> [a] -> a
forall a. Resolvable a => a -> [a] -> a
resolveMany' a
a [a]
as
resolveMany [a]
_      = String -> a
forall a. HasCallStack => String -> a
error String
"resolveMany: empty list"
{-# INLINE resolveMany #-}