Bryan O'Sullivan avatar Bryan O'Sullivan committed 79aa76e

Factor JSON and other typeclass support out.

Comments (0)

Files changed (6)

     Network.Riak.Connection
     Network.Riak.Content
     Network.Riak.Debug
-    Network.Riak.Monoid
     Network.Riak.Request
     Network.Riak.Response
     Network.Riak.Basic
     Network.Riak.Types
+    Network.Riak.JSON
+    Network.Riak.JSON.Monoid
     Network.Riak.Value
+    Network.Riak.Value.Monoid
     Network.Riak.Protocol.ServerInfo
     Network.Riak.Protocol.BucketProps
     Network.Riak.Protocol.Content

src/Network/Riak/JSON.hs

+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+
+module Network.Riak.JSON
+    (
+      JSON(plain)
+    , json
+    , get
+    , getMany
+    , put
+    , put_
+    , putMany
+    , putMany_
+    ) where
+
+import Control.Applicative ((<$>))
+import Control.Arrow (first)
+import Data.Monoid (Monoid)
+import Data.Typeable (Typeable)
+import Network.Riak.Types.Internal
+import qualified Data.Aeson.Types as Aeson
+import qualified Network.Riak.Value as V
+
+newtype JSON a = J {
+      plain :: a
+    } deriving (Eq, Ord, Show, Read, Bounded, Typeable, Monoid)
+
+json :: (Aeson.FromJSON a, Aeson.ToJSON a) => a -> JSON a
+json = J
+{-# INLINE json #-}
+
+instance Functor JSON where
+    fmap f (J a) = J (f a)
+    {-# INLINE fmap #-}
+
+instance (Aeson.FromJSON a, Aeson.ToJSON a) => V.IsContent (JSON a) where
+    fromContent c = J `fmap` (V.fromContent c >>= Aeson.fromJSON)
+    {-# INLINE fromContent #-}
+
+    toContent (J a) = V.toContent (Aeson.toJSON a)
+    {-# INLINE toContent #-}
+
+get :: (Aeson.FromJSON c, Aeson.ToJSON c) => Connection -> Bucket -> Key -> R
+    -> IO (Maybe ([c], VClock))
+get conn bucket key r = fmap convert <$> V.get conn bucket key r
+
+getMany :: (Aeson.FromJSON c, Aeson.ToJSON c) => Connection -> Bucket -> [Key] -> R
+    -> IO [Maybe ([c], VClock)]
+getMany conn bucket ks r = map (fmap convert) <$> V.getMany conn bucket ks r
+
+put :: (Aeson.FromJSON c, Aeson.ToJSON c) =>
+       Connection -> Bucket -> Key -> Maybe VClock -> c
+    -> W -> DW -> IO ([c], VClock)
+put conn bucket key mvclock val w dw =
+    convert <$> V.put conn bucket key mvclock (json val) w dw
+
+put_ :: (Aeson.FromJSON c, Aeson.ToJSON c) =>
+       Connection -> Bucket -> Key -> Maybe VClock -> c
+    -> W -> DW -> IO ()
+put_ conn bucket key mvclock val w dw =
+    V.put_ conn bucket key mvclock (json val) w dw
+
+putMany :: (Aeson.FromJSON c, Aeson.ToJSON c) =>
+       Connection -> Bucket -> [(Key, Maybe VClock, c)]
+    -> W -> DW -> IO [([c], VClock)]
+putMany conn bucket puts w dw =
+    map convert <$> V.putMany conn bucket (map f puts) w dw
+  where f (k,v,c) = (k,v,json c)
+
+putMany_ :: (Aeson.FromJSON c, Aeson.ToJSON c) =>
+            Connection -> Bucket -> [(Key, Maybe VClock, c)]
+         -> W -> DW -> IO ()
+putMany_ conn bucket puts w dw = V.putMany_ conn bucket (map f puts) w dw
+  where f (k,v,c) = (k,v,json c)
+
+convert :: ([JSON a], VClock) -> ([a], VClock)
+convert = first (map plain)

src/Network/Riak/JSON/Monoid.hs

+{-# LANGUAGE RecordWildCards #-}
+
+module Network.Riak.JSON.Monoid
+    (
+      get
+    , getMany
+    , put
+    ) where
+
+import Control.Arrow (first)
+import Data.Monoid (Monoid(..))
+import Network.Riak.Types.Internal hiding (MessageTag(..))
+import qualified Data.Aeson.Types as Aeson
+import qualified Network.Riak.JSON as J
+
+get :: (Aeson.FromJSON c, Aeson.ToJSON c, Monoid c) =>
+       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))
+get conn bucket key r = fmap (first mconcat) `fmap` J.get conn bucket key r
+{-# INLINE get #-}
+
+getMany :: (Aeson.FromJSON c, Aeson.ToJSON c, Monoid c)
+           => Connection -> Bucket -> [Key] -> R
+        -> IO [Maybe (c, VClock)]
+getMany conn b ks r = map (fmap (first mconcat)) `fmap` J.getMany conn b ks r
+{-# INLINE getMany #-}
+
+put :: (Aeson.FromJSON c, Aeson.ToJSON c, Monoid c) =>
+       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
+    -> IO (c, VClock)
+put conn bucket key mvclock0 val0 w dw = do
+  let go val mvclock1 = do
+        (xs, vclock) <- J.put conn bucket key mvclock1 val w dw
+        case xs of
+          [c] -> return (c, vclock)
+          _   -> go (mconcat xs) (Just vclock)
+  go val0 mvclock0

src/Network/Riak/Monoid.hs

-{-# LANGUAGE RecordWildCards #-}
-
-module Network.Riak.Monoid
-    (
-      V.IsContent(..)
-    , V.JSON(plain)
-    , V.json
-    , get
-    , getMany
-    , put
-    ) where
-
-import Control.Arrow (first)
-import Data.Monoid (Monoid(..))
-import Network.Riak.Types.Internal hiding (MessageTag(..))
-import qualified Network.Riak.Value as V
-
-get :: (Monoid c, V.IsContent c) =>
-       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))
-get conn bucket key r = fmap (first mconcat) `fmap` V.get conn bucket key r
-
-getMany :: (Monoid c, V.IsContent c) => Connection -> Bucket -> [Key] -> R
-        -> IO [Maybe (c, VClock)]
-getMany conn b ks r = map (fmap (first mconcat)) `fmap` V.getMany conn b ks r
-
-put :: (Monoid c, V.IsContent c) =>
-       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
-    -> IO (c, VClock)
-put conn bucket key mvclock0 val0 w dw = do
-  let go val mvclock1 = do
-        (xs, vclock) <- V.put conn bucket key mvclock1 val w dw
-        case xs of
-          [c] -> return (c, vclock)
-          _   -> go (mconcat xs) (Just vclock)
-  go val0 mvclock0

src/Network/Riak/Value.hs

-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
 
 module Network.Riak.Value
     (
       IsContent(..)
-    , JSON(plain)
-    , json
     , get
     , getMany
     , put
     ) where
 
 import Data.Attoparsec.Lazy (maybeResult, parse)
-import Data.Typeable (Typeable)
 import Data.Foldable (toList)
 import Network.Riak.Connection.Internal
 import Network.Riak.Protocol.Content (Content(..))
     toContent = C.json
     {-# INLINE toContent #-}
 
-newtype JSON a = J {
-      plain :: a
-    } deriving (Eq, Ord, Show, Read, Bounded, Typeable)
-
-json :: (Aeson.FromJSON a, Aeson.ToJSON a) => a -> JSON a
-json = J
-{-# INLINE json #-}
-
-instance (Aeson.FromJSON a, Aeson.ToJSON a) => IsContent (JSON a) where
-    fromContent c = J `fmap` (fromContent c >>= Aeson.fromJSON)
-
-    toContent (J a) = toContent (Aeson.toJSON 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

+{-# LANGUAGE RecordWildCards #-}
+
+module Network.Riak.Value.Monoid
+    (
+      V.IsContent(..)
+    , get
+    , getMany
+    , put
+    ) where
+
+import Control.Arrow (first)
+import Data.Monoid (Monoid(..))
+import Network.Riak.Types.Internal hiding (MessageTag(..))
+import qualified Network.Riak.Value as V
+
+get :: (Monoid c, V.IsContent c) =>
+       Connection -> Bucket -> Key -> R -> IO (Maybe (c, VClock))
+get conn bucket key r = fmap (first mconcat) `fmap` V.get conn bucket key r
+{-# INLINE get #-}
+
+getMany :: (Monoid c, V.IsContent c) => Connection -> Bucket -> [Key] -> R
+        -> IO [Maybe (c, VClock)]
+getMany conn b ks r = map (fmap (first mconcat)) `fmap` V.getMany conn b ks r
+{-# INLINE getMany #-}
+
+put :: (Monoid c, V.IsContent c) =>
+       Connection -> Bucket -> Key -> Maybe VClock -> c -> W -> DW
+    -> IO (c, VClock)
+put conn bucket key mvclock0 val0 w dw = do
+  let go val mvclock1 = do
+        (xs, vclock) <- V.put conn bucket key mvclock1 val w dw
+        case xs of
+          [c] -> return (c, vclock)
+          _   -> go (mconcat xs) (Just vclock)
+  go val0 mvclock0
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.