Bryan O'Sullivan avatar Bryan O'Sullivan committed 1afc01a

Use the new Resolvable class instead of abusing Monoid

Comments (0)

Files changed (10)

   .
   [Network.Riak.JSON] JSON for storage, manual conflict resolution.
   .
-  [Network.Riak.Value.Monoid] More complex (but still automatic)
+  [Network.Riak.Value.Resolvable] More complex (but still automatic)
   storage, automatic conflict resolution.
   .
   [Network.Riak.Value] More complex (but still automatic) storage,
     Network.Riak.Basic
     Network.Riak.Types
     Network.Riak.JSON
-    Network.Riak.JSON.Monoid
+    Network.Riak.JSON.Resolvable
     Network.Riak.Value
-    Network.Riak.Value.Monoid
+    Network.Riak.Value.Resolvable
     Network.Riak.Protocol.ServerInfo
     Network.Riak.Protocol.BucketProps
     Network.Riak.Protocol.DeleteRequest
     Network.Riak.Protocol.ListBucketsRequest
 
   other-modules:       
-    Network.Riak.Monoid
+    Network.Riak.Resolvable
     Network.Riak.Protocol.Link
     Network.Riak.Connection.Internal
     Network.Riak.Connection.NoPush

src/Network/Riak.hs

 -- use one of the following modules (ranked from easiest to most
 -- tricky to use):
 --
--- [Network.Riak.JSON.Monoid] JSON for storage, automatic conflict
+-- [Network.Riak.JSON.Resolvable] JSON for storage, automatic conflict
 -- resolution.  (This module actually re-exports its definitions.)
 -- This is the easiest module to work with.
 --
 -- [Network.Riak.JSON] JSON for storage, manual conflict resolution.
 --
--- [Network.Riak.Value.Monoid] More complex (but still automatic)
+-- [Network.Riak.Value.Resolvable] More complex (but still automatic)
 -- storage, automatic conflict resolution.
 --
 -- [Network.Riak.Value] More complex (but still automatic) storage,
 import Network.Riak.Connection
 import Network.Riak.Types
 import Network.Riak.Basic hiding (get, put, put_)
-import Network.Riak.JSON.Monoid (get, getMany, put, putMany)
+import Network.Riak.JSON.Resolvable (get, getMany, put, putMany)

src/Network/Riak/JSON/Monoid.hs

--- |
--- Module:      Network.Riak.JSON.Monoid
--- Copyright:   (c) 2011 MailRank, Inc.
--- License:     Apache
--- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
--- Stability:   experimental
--- Portability: portable
---
--- This module allows storage and retrieval of JSON-encoded data.
---
--- Functions automatically resolve conflicts using 'Monoid' instances.
--- For instance, if a 'get' returns three siblings, a winner will be
--- chosen using 'mconcat'.  If a 'put' results in a conflict, a winner
--- will be chosen using 'mconcat', and the winner will be 'put'; this
--- will be repeated until no conflict occurs.
-
-module Network.Riak.JSON.Monoid
-    (
-      get
-    , getMany
-    , put
-    , put_
-    , putMany
-    , putMany_
-    ) where
-
-import Data.Aeson.Types (FromJSON(..), ToJSON(..))
-import Data.Monoid (Monoid)
-import Network.Riak.Types.Internal hiding (MessageTag(..))
-import qualified Network.Riak.JSON as J
-import qualified Network.Riak.Monoid as M
-
--- | Retrieve a single value.  If conflicting values are returned, the
--- 'Monoid' is used to choose a winner.
-get :: (FromJSON c, ToJSON c, Monoid c) =>
-       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))
-get = M.get J.get
-{-# INLINE get #-}
-
--- | Retrieve multiple values.  If conflicting values are returned for
--- a key, the 'Monoid' is used to choose a winner.
-getMany :: (FromJSON c, ToJSON c, Monoid c)
-           => Connection -> Bucket -> [Key] -> R -> IO [Maybe (c, VClock)]
-getMany = M.getMany J.getMany
-{-# INLINE getMany #-}
-
--- | Store a single value, automatically resolving any vector clock
--- conflicts that arise.  A single invocation of this function may
--- involve several roundtrips to the server to resolve conflicts.
---
--- If a conflict arises, a winner will be chosen using 'mconcat', and
--- the winner will be stored; this will be repeated until no conflict
--- occurs.
---
--- The final value to be stored at the end of any conflict resolution
--- is returned.
-put :: (Eq c, FromJSON c, ToJSON c, Monoid c) =>
-       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-    -> IO (c, VClock)
-put = M.put J.put
-{-# INLINE put #-}
-
--- | Store a single value, automatically resolving any vector clock
--- conflicts that arise.  A single invocation of this function may
--- involve several roundtrips to the server to resolve conflicts.
---
--- If a conflict arises, a winner will be chosen using 'mconcat', and
--- the winner will be stored; this will be repeated until no conflict
--- occurs.
-put_ :: (Eq c, FromJSON c, ToJSON c, Monoid c) =>
-        Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-     -> IO ()
-put_ = M.put_ J.put
-{-# INLINE put_ #-}
-
--- | Store multiple values, resolving any vector clock conflicts that
--- arise.  A single invocation of this function may involve several
--- roundtrips to the server to resolve conflicts.
---
--- If any conflicts arise, a winner will be chosen in each case using
--- 'mconcat', and the winners will be stored; this will be repeated
--- until no conflicts occur.
---
--- For each original value to be stored, the final value that was
--- stored at the end of any conflict resolution is returned.
-putMany :: (Eq c, FromJSON c, ToJSON c, Monoid c) =>
-           Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
-        -> IO [(c, VClock)]
-putMany = M.putMany J.putMany
-{-# INLINE putMany #-}
-
--- | Store multiple values, resolving any vector clock conflicts that
--- arise.  A single invocation of this function may involve several
--- roundtrips to the server to resolve conflicts.
---
--- If any conflicts arise, a winner will be chosen in each case using
--- 'mconcat', and the winners will be stored; this will be repeated
--- until no conflicts occur.
-putMany_ :: (Eq c, FromJSON c, ToJSON c, Monoid c) =>
-            Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
-         -> IO ()
-putMany_ = M.putMany_ J.putMany
-{-# INLINE putMany_ #-}

src/Network/Riak/JSON/Resolvable.hs

+-- |
+-- Module:      Network.Riak.JSON.Resolvable
+-- Copyright:   (c) 2011 MailRank, Inc.
+-- License:     Apache
+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- This module allows storage and retrieval of JSON-encoded data.
+--
+-- Functions automatically resolve conflicts using 'Resolvable' instances.
+-- For instance, if a 'get' returns three siblings, a winner will be
+-- chosen using 'mconcat'.  If a 'put' results in a conflict, a winner
+-- will be chosen using 'mconcat', and the winner will be 'put'; this
+-- will be repeated until no conflict occurs.
+
+module Network.Riak.JSON.Resolvable
+    (
+      get
+    , getMany
+    , put
+    , put_
+    , putMany
+    , putMany_
+    ) where
+
+import Data.Aeson.Types (FromJSON(..), ToJSON(..))
+import Network.Riak.Resolvable (Resolvable)
+import Network.Riak.Types.Internal hiding (MessageTag(..))
+import qualified Network.Riak.JSON as J
+import qualified Network.Riak.Resolvable as R
+
+-- | Retrieve a single value.  If conflicting values are returned, the
+-- 'Resolvable' is used to choose a winner.
+get :: (FromJSON c, ToJSON c, Resolvable c) =>
+       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))
+get = R.get J.get
+{-# INLINE get #-}
+
+-- | Retrieve multiple values.  If conflicting values are returned for
+-- a key, the 'Resolvable' is used to choose a winner.
+getMany :: (FromJSON c, ToJSON c, Resolvable c)
+           => Connection -> Bucket -> [Key] -> R -> IO [Maybe (c, VClock)]
+getMany = R.getMany J.getMany
+{-# INLINE getMany #-}
+
+-- | Store a single value, automatically resolving any vector clock
+-- conflicts that arise.  A single invocation of this function may
+-- involve several roundtrips to the server to resolve conflicts.
+--
+-- If a conflict arises, a winner will be chosen using 'mconcat', and
+-- the winner will be stored; this will be repeated until no conflict
+-- occurs.
+--
+-- The final value to be stored at the end of any conflict resolution
+-- is returned.
+put :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>
+       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
+    -> IO (c, VClock)
+put = R.put J.put
+{-# INLINE put #-}
+
+-- | Store a single value, automatically resolving any vector clock
+-- conflicts that arise.  A single invocation of this function may
+-- involve several roundtrips to the server to resolve conflicts.
+--
+-- If a conflict arises, a winner will be chosen using 'mconcat', and
+-- the winner will be stored; this will be repeated until no conflict
+-- occurs.
+put_ :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>
+        Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
+     -> IO ()
+put_ = R.put_ J.put
+{-# INLINE put_ #-}
+
+-- | Store multiple values, resolving any vector clock conflicts that
+-- arise.  A single invocation of this function may involve several
+-- roundtrips to the server to resolve conflicts.
+--
+-- If any conflicts arise, a winner will be chosen in each case using
+-- 'mconcat', and the winners will be stored; this will be repeated
+-- until no conflicts occur.
+--
+-- For each original value to be stored, the final value that was
+-- stored at the end of any conflict resolution is returned.
+putMany :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>
+           Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
+        -> IO [(c, VClock)]
+putMany = R.putMany J.putMany
+{-# INLINE putMany #-}
+
+-- | Store multiple values, resolving any vector clock conflicts that
+-- arise.  A single invocation of this function may involve several
+-- roundtrips to the server to resolve conflicts.
+--
+-- If any conflicts arise, a winner will be chosen in each case using
+-- 'mconcat', and the winners will be stored; this will be repeated
+-- until no conflicts occur.
+putMany_ :: (Eq c, FromJSON c, ToJSON c, Resolvable c) =>
+            Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
+         -> IO ()
+putMany_ = R.putMany_ J.putMany
+{-# INLINE putMany_ #-}

src/Network/Riak/Monoid.hs

--- |
--- Module:      Network.Riak.Monoid
--- Copyright:   (c) 2011 MailRank, Inc.
--- License:     Apache
--- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
--- Stability:   experimental
--- Portability: portable
---
--- Storage and retrieval of monoidal data with automatic conflict resolution.
-
-module Network.Riak.Monoid
-    (
-      get
-    , getMany
-    , put
-    , put_
-    , putMany
-    , putMany_
-    ) where
-
-import Control.Arrow (first)
-import Control.Monad (unless)
-import Data.Function (on)
-import Data.Either (partitionEithers)
-import Data.List (sortBy)
-import Data.Monoid (Monoid(..))
-import Network.Riak.Debug (debug)
-import Network.Riak.Types.Internal hiding (MessageTag(..))
-
-get :: (Monoid c) =>
-       (Connection -> Bucket -> Key -> R -> IO (Maybe ([c], VClock)))
-       -> (Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock)))
-get doGet conn bucket key r =
-    fmap (first mconcat) `fmap` doGet conn bucket key r
-
-getMany :: (Monoid c) =>
-           (Connection -> Bucket -> [Key] -> R -> IO [Maybe ([c], VClock)])
-        -> Connection -> Bucket -> [Key] -> R -> IO [Maybe (c, VClock)]
-getMany doGet conn b ks r = map (fmap (first mconcat)) `fmap` doGet conn b ks r
-
-put :: (Eq c, Monoid c) =>
-       (Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-                   -> IO ([c], VClock))
-    -> Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-    -> IO (c, VClock)
-put doPut conn bucket key mvclock0 val0 w dw = do
-  let go val mvclock1 = do
-        (xs, vclock) <- doPut conn bucket key mvclock1 val w dw
-        case xs of
-          []             -> return (val, vclock) -- not observed in the wild
-          [v] | v == val -> return (val, vclock)
-          ys             -> do debug "put" "conflict" 
-                               go (mconcat (val:ys)) (Just vclock)
-  go val0 mvclock0
-
-put_ :: (Eq c, Monoid c) =>
-        (Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-                    -> IO ([c], VClock))
-     -> Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-     -> IO ()
-put_ doPut conn bucket key mvclock0 val0 w dw =
-    put doPut conn bucket key mvclock0 val0 w dw >> return ()
-{-# INLINE put_ #-}
-
-putMany :: (Eq c, Monoid c) =>
-           (Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
-                       -> IO [([c], VClock)])
-        -> Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
-        -> IO [(c, VClock)]
-putMany doPut conn bucket puts0 w dw = go [] . zip [(0::Int)..] $ puts0 where
-  go acc [] = return . map snd . sortBy (compare `on` fst) $ acc
-  go acc puts = do
-    rs <- doPut conn bucket (map snd puts) w dw
-    let (conflicts, ok) = partitionEithers $ zipWith mush puts rs
-    unless (null conflicts) $
-      debug "putMany" $ show (length conflicts) ++ " conflicts"
-    go (ok++acc) conflicts
-  mush (i,(k,_,c)) (cs,v) =
-      case cs of
-        []           -> Right (i,(c,v)) -- not observed in the wild
-        [x] | x == c -> Right (i,(c,v))
-        _            -> Left (i,(k,Just v, mconcat (c:cs)))
-
-putMany_ :: (Eq c, Monoid c) =>
-            (Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
-                        -> IO [([c], VClock)])
-         -> Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW -> IO ()
-putMany_ doPut conn bucket puts0 w dw =
-    putMany doPut conn bucket puts0 w dw >> return ()
-{-# INLINE putMany_ #-}

src/Network/Riak/Resolvable.hs

+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+-- |
+-- Module:      Network.Riak.Resolvable
+-- Copyright:   (c) 2011 MailRank, Inc.
+-- License:     Apache
+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- Storage and retrieval of data with automatic conflict resolution.
+
+module Network.Riak.Resolvable
+    (
+      Resolvable(..)
+    , ResolvableMonoid(..)
+    , get
+    , getMany
+    , put
+    , put_
+    , putMany
+    , putMany_
+    ) where
+
+import Control.Arrow (first)
+import Control.Monad (unless)
+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.Monoid (Monoid(mappend))
+import Data.Typeable (Typeable)
+import Network.Riak.Debug (debug)
+import Network.Riak.Types.Internal hiding (MessageTag(..))
+
+-- | 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 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 { unRM :: a }
+    deriving (Eq, Ord, Read, Show, Typeable, Data, Monoid, FromJSON, ToJSON)
+
+instance (Monoid a) => Resolvable (ResolvableMonoid a) where
+    resolve = mappend
+    {-# INLINE resolve #-}
+
+get :: (Resolvable a) =>
+       (Connection -> Bucket -> Key -> R -> IO (Maybe ([a], VClock)))
+       -> (Connection -> Bucket -> Key -> R -> IO (Maybe (a, VClock)))
+get doGet conn bucket key r =
+    fmap (first resolveMany) `fmap` doGet conn bucket key r
+
+getMany :: (Resolvable a) =>
+           (Connection -> Bucket -> [Key] -> R -> IO [Maybe ([a], VClock)])
+        -> Connection -> Bucket -> [Key] -> R -> IO [Maybe (a, VClock)]
+getMany doGet conn b ks r = map (fmap (first resolveMany)) `fmap` doGet conn b ks r
+
+put :: (Eq a, Resolvable a) =>
+       (Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
+                   -> IO ([a], VClock))
+    -> Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
+    -> IO (a, VClock)
+put doPut conn bucket key mvclock0 val0 w dw = do
+  let go val mvclock1 = do
+        (xs, vclock) <- doPut conn bucket key mvclock1 val w dw
+        case xs of
+          []             -> return (val, vclock) -- not observed in the wild
+          [v] | v == val -> return (val, vclock)
+          ys             -> do debug "put" "conflict" 
+                               go (resolveMany' val ys) (Just vclock)
+  go val0 mvclock0
+
+put_ :: (Eq a, Resolvable a) =>
+        (Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
+                    -> IO ([a], VClock))
+     -> Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
+     -> IO ()
+put_ doPut conn bucket key mvclock0 val0 w dw =
+    put doPut conn bucket key mvclock0 val0 w dw >> return ()
+{-# INLINE put_ #-}
+
+putMany :: (Eq a, Resolvable a) =>
+           (Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW
+                       -> IO [([a], VClock)])
+        -> Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW
+        -> IO [(a, VClock)]
+putMany doPut conn bucket puts0 w dw = go [] . zip [(0::Int)..] $ puts0 where
+  go acc [] = return . map snd . sortBy (compare `on` fst) $ acc
+  go acc puts = do
+    rs <- doPut conn bucket (map snd puts) w dw
+    let (conflicts, ok) = partitionEithers $ zipWith mush puts rs
+    unless (null conflicts) $
+      debug "putMany" $ show (length conflicts) ++ " conflicts"
+    go (ok++acc) conflicts
+  mush (i,(k,_,c)) (cs,v) =
+      case cs of
+        []           -> Right (i,(c,v)) -- not observed in the wild
+        [x] | x == c -> Right (i,(c,v))
+        _            -> Left (i,(k,Just v, resolveMany' c cs))
+
+putMany_ :: (Eq a, Resolvable a) =>
+            (Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW
+                        -> IO [([a], VClock)])
+         -> Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW -> IO ()
+putMany_ doPut conn bucket puts0 w dw =
+    putMany doPut conn bucket puts0 w dw >> return ()
+{-# INLINE putMany_ #-}
+
+resolveMany' :: (Resolvable a) => a -> [a] -> a
+resolveMany' a as = foldl' resolve a as
+
+resolveMany :: (Resolvable a) => [a] -> a
+resolveMany (a:as) = resolveMany' a as
+resolveMany _      = error "resolveMany: empty list"

src/Network/Riak/Types/Internal.hs

-{-# LANGUAGE DeriveDataTypeable, FunctionalDependencies, MultiParamTypeClasses,
+{-# LANGUAGE DeriveDataTypeable, FunctionalDependencies, MultiParamTypeClasses, 
     RecordWildCards #-}
 
 -- |

src/Network/Riak/Value.hs

-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings, RecordWildCards, StandaloneDeriving #-}
 
 -- |
 -- Module:      Network.Riak.Value
     ) where
 
 import Control.Applicative
-import qualified Data.Attoparsec.Lazy as A
+import Data.Aeson.Types (Parser, Result(..), parse)
 import Data.Foldable (toList)
 import Network.Riak.Connection.Internal
 import Network.Riak.Protocol.Content (Content(..))
 import Network.Riak.Protocol.GetResponse (GetResponse(..))
 import Network.Riak.Protocol.PutResponse (PutResponse(..))
+import Network.Riak.Resolvable (ResolvableMonoid(..))
 import Network.Riak.Types.Internal hiding (MessageTag(..))
 import qualified Data.Aeson.Parser as Aeson
 import qualified Data.Aeson.Types as Aeson
+import qualified Data.Attoparsec.Lazy as A
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Sequence as Seq
 import qualified Network.Riak.Content as C
 import qualified Network.Riak.Request as Req
-import Data.Aeson.Types (Parser, Result(..), parse)
 
 fromContent :: IsContent c => Content -> Maybe c
 fromContent c = case parse parseContent c of
     toContent = C.json
     {-# INLINE toContent #-}
 
+deriving instance (IsContent a) => IsContent (ResolvableMonoid a)
+
 put :: (IsContent c) => Connection -> Bucket -> Key -> Maybe VClock -> c
     -> W -> DW -> IO ([c], VClock)
 put conn bucket key mvclock val w dw =

src/Network/Riak/Value/Monoid.hs

--- |
--- Module:      Network.Riak.Value.Monoid
--- Copyright:   (c) 2011 MailRank, Inc.
--- License:     Apache
--- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
--- Stability:   experimental
--- Portability: portable
---
--- This module allows storage and retrieval of data encoded using the
--- 'V.IsContent' typeclass.  This provides access to more of Riak's
--- storage features than JSON, e.g. links.
---
--- Functions automatically resolve conflicts using 'Monoid' instances.
--- For instance, if a 'get' returns three siblings, a winner will be
--- chosen using 'mconcat'.  If a 'put' results in a conflict, a winner
--- will be chosen using 'mconcat', and the winner will be 'put'; this
--- will be repeated until no conflict occurs.
-
-module Network.Riak.Value.Monoid
-    (
-      V.IsContent(..)
-    , get
-    , getMany
-    , put
-    , put_
-    , putMany
-    , putMany_
-    ) where
-
-import Data.Monoid (Monoid(..))
-import Network.Riak.Types.Internal hiding (MessageTag(..))
-import qualified Network.Riak.Monoid as M
-import qualified Network.Riak.Value as V
-
--- | Retrieve a single value.  If conflicting values are returned, the
--- 'Monoid' is used to choose a winner.
-get :: (Monoid c, V.IsContent c) =>
-       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))
-get = M.get V.get
-{-# INLINE get #-}
-
--- | Retrieve multiple values.  If conflicting values are returned for
--- a key, the 'Monoid' is used to choose a winner.
-getMany :: (Monoid c, V.IsContent c) => Connection -> Bucket -> [Key] -> R
-        -> IO [Maybe (c, VClock)]
-getMany = M.getMany V.getMany
-{-# INLINE getMany #-}
-
--- | Store a single value, automatically resolving any vector clock
--- conflicts that arise.  A single invocation of this function may
--- involve several roundtrips to the server to resolve conflicts.
---
--- If a conflict arises, a winner will be chosen using 'mconcat', and
--- the winner will be stored; this will be repeated until no conflict
--- occurs.
---
--- The final value to be stored at the end of any conflict resolution
--- is returned.
-put :: (Eq c, Monoid c, V.IsContent c) =>
-       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-    -> IO (c, VClock)
-put = M.put V.put 
-{-# INLINE put #-}
-
--- | Store a single value, automatically resolving any vector clock
--- conflicts that arise.  A single invocation of this function may
--- involve several roundtrips to the server to resolve conflicts.
---
--- If a conflict arises, a winner will be chosen using 'mconcat', and
--- the winner will be stored; this will be repeated until no conflict
--- occurs.
-put_ :: (Eq c, Monoid c, V.IsContent c) =>
-        Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-     -> IO ()
-put_ = M.put_ V.put 
-{-# INLINE put_ #-}
-
--- | Store multiple values, resolving any vector clock conflicts that
--- arise.  A single invocation of this function may involve several
--- roundtrips to the server to resolve conflicts.
---
--- If any conflicts arise, a winner will be chosen in each case using
--- 'mconcat', and the winners will be stored; this will be repeated
--- until no conflicts occur.
---
--- For each original value to be stored, the final value that was
--- stored at the end of any conflict resolution is returned.
-putMany :: (Eq c, Monoid c, V.IsContent c) =>
-           Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW
-        -> IO [(c, VClock)]
-putMany = M.putMany V.putMany
-{-# INLINE putMany #-}
-
--- | Store multiple values, resolving any vector clock conflicts that
--- arise.  A single invocation of this function may involve several
--- roundtrips to the server to resolve conflicts.
---
--- If any conflicts arise, a winner will be chosen in each case using
--- 'mconcat', and the winners will be stored; this will be repeated
--- until no conflicts occur.
-putMany_ :: (Eq c, Monoid c, V.IsContent c) =>
-            Connection -> Bucket -> [(Key, Maybe VClock, c)] -> W -> DW -> IO ()
-putMany_ = M.putMany_ V.putMany
-{-# INLINE putMany_ #-}

src/Network/Riak/Value/Resolvable.hs

+-- |
+-- Module:      Network.Riak.Value.Resolvable
+-- Copyright:   (c) 2011 MailRank, Inc.
+-- License:     Apache
+-- Maintainer:  Bryan O'Sullivan <bos@mailrank.com>
+-- Stability:   experimental
+-- Portability: portable
+--
+-- This module allows storage and retrieval of data encoded using the
+-- 'V.IsContent' typeclass.  This provides access to more of Riak's
+-- storage features than JSON, e.g. links.
+--
+-- Functions automatically resolve conflicts using 'Resolvable' instances.
+-- For instance, if a 'get' returns three siblings, a winner will be
+-- chosen using 'mconcat'.  If a 'put' results in a conflict, a winner
+-- will be chosen using 'mconcat', and the winner will be 'put'; this
+-- will be repeated until no conflict occurs.
+
+module Network.Riak.Value.Resolvable
+    (
+      V.IsContent(..)
+    , get
+    , getMany
+    , put
+    , put_
+    , putMany
+    , putMany_
+    ) where
+
+import Network.Riak.Resolvable (Resolvable)
+import Network.Riak.Types.Internal hiding (MessageTag(..))
+import qualified Network.Riak.Resolvable as R
+import qualified Network.Riak.Value as V
+
+-- | Retrieve a single value.  If conflicting values are returned, the
+-- 'Resolvable' is used to choose a winner.
+get :: (Resolvable a, V.IsContent a) =>
+       Connection -> Bucket -> Key -> R -> IO (Maybe (a, VClock))
+get = R.get V.get
+{-# INLINE get #-}
+
+-- | Retrieve multiple values.  If conflicting values are returned for
+-- a key, the 'Resolvable' is used to choose a winner.
+getMany :: (Resolvable a, V.IsContent a) => Connection -> Bucket -> [Key] -> R
+        -> IO [Maybe (a, VClock)]
+getMany = R.getMany V.getMany
+{-# INLINE getMany #-}
+
+-- | Store a single value, automatically resolving any vector clock
+-- conflicts that arise.  A single invocation of this function may
+-- involve several roundtrips to the server to resolve conflicts.
+--
+-- If a conflict arises, a winner will be chosen using 'mconcat', and
+-- the winner will be stored; this will be repeated until no conflict
+-- occurs.
+--
+-- The final value to be stored at the end of any conflict resolution
+-- is returned.
+put :: (Eq a, Resolvable a, V.IsContent a) =>
+       Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
+    -> IO (a, VClock)
+put = R.put V.put 
+{-# INLINE put #-}
+
+-- | Store a single value, automatically resolving any vector clock
+-- conflicts that arise.  A single invocation of this function may
+-- involve several roundtrips to the server to resolve conflicts.
+--
+-- If a conflict arises, a winner will be chosen using 'mconcat', and
+-- the winner will be stored; this will be repeated until no conflict
+-- occurs.
+put_ :: (Eq a, Resolvable a, V.IsContent a) =>
+        Connection -> Bucket -> Key -> Maybe VClock -> a -> W -> DW
+     -> IO ()
+put_ = R.put_ V.put 
+{-# INLINE put_ #-}
+
+-- | Store multiple values, resolving any vector clock conflicts that
+-- arise.  A single invocation of this function may involve several
+-- roundtrips to the server to resolve conflicts.
+--
+-- If any conflicts arise, a winner will be chosen in each case using
+-- 'mconcat', and the winners will be stored; this will be repeated
+-- until no conflicts occur.
+--
+-- For each original value to be stored, the final value that was
+-- stored at the end of any conflict resolution is returned.
+putMany :: (Eq a, Resolvable a, V.IsContent a) =>
+           Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW
+        -> IO [(a, VClock)]
+putMany = R.putMany V.putMany
+{-# INLINE putMany #-}
+
+-- | Store multiple values, resolving any vector clock conflicts that
+-- arise.  A single invocation of this function may involve several
+-- roundtrips to the server to resolve conflicts.
+--
+-- If any conflicts arise, a winner will be chosen in each case using
+-- 'mconcat', and the winners will be stored; this will be repeated
+-- until no conflicts occur.
+putMany_ :: (Eq a, Resolvable a, V.IsContent a) =>
+            Connection -> Bucket -> [(Key, Maybe VClock, a)] -> W -> DW -> IO ()
+putMany_ = R.putMany_ V.putMany
+{-# INLINE putMany_ #-}
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.