Bryan O'Sullivan avatar Bryan O'Sullivan committed 2d6f08d

Reorganise modules to make docs build correctly

Comments (0)

Files changed (5)

 
   exposed-modules:     
     Network.Riak
+    Network.Riak.Basic
     Network.Riak.Connection
     Network.Riak.Connection.Pool
     Network.Riak.Content
     Network.Riak.Debug
     Network.Riak.Escape
-    Network.Riak.Request
-    Network.Riak.Response
-    Network.Riak.Basic
-    Network.Riak.Types
     Network.Riak.JSON
     Network.Riak.JSON.Resolvable
+    Network.Riak.Request
+    Network.Riak.Resolvable
+    Network.Riak.Response
+    Network.Riak.Types
     Network.Riak.Value
     Network.Riak.Value.Resolvable
     Network.Riak.Protocol.ServerInfo
     Network.Riak.Protocol.ListBucketsRequest
 
   other-modules:       
-    Network.Riak.Resolvable
-    Network.Riak.Protocol.Link
     Network.Riak.Connection.Internal
     Network.Riak.Connection.NoPush
+    Network.Riak.Protocol
     Network.Riak.Protocol.Content
+    Network.Riak.Protocol.Link
+    Network.Riak.Resolvable.Internal
     Network.Riak.Tag
     Network.Riak.Types.Internal
-    Network.Riak.Protocol
   
   build-depends:       
     aeson == 0.2.*,

src/Network/Riak/JSON/Resolvable.hs

     ) where
 
 import Data.Aeson.Types (FromJSON(..), ToJSON(..))
-import Network.Riak.Resolvable (Resolvable)
+import Network.Riak.Resolvable.Internal (Resolvable)
 import Network.Riak.Types.Internal hiding (MessageTag(..))
 import qualified Network.Riak.JSON as J
-import qualified Network.Riak.Resolvable as R
+import qualified Network.Riak.Resolvable.Internal as R
 
 -- | Retrieve a single value.  If conflicting values are returned, the
 -- 'Resolvable' is used to choose a winner.

src/Network/Riak/Resolvable.hs

-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
 -- |
 -- Module:      Network.Riak.Resolvable
 -- Copyright:   (c) 2011 MailRank, Inc.
     (
       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"
+import Network.Riak.Resolvable.Internal (Resolvable(..), ResolvableMonoid(..))

src/Network/Riak/Resolvable/Internal.hs

+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+-- |
+-- Module:      Network.Riak.Resolvable.Internal
+-- 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.Internal
+    (
+      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/Value/Resolvable.hs

     , putMany_
     ) where
 
-import Network.Riak.Resolvable (Resolvable)
+import Network.Riak.Resolvable.Internal (Resolvable)
 import Network.Riak.Types.Internal hiding (MessageTag(..))
-import qualified Network.Riak.Resolvable as R
+import qualified Network.Riak.Resolvable.Internal as R
 import qualified Network.Riak.Value as V
 
 -- | Retrieve a single value.  If conflicting values are returned, the
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.