snaplet-riak 0.1.0.0 → 0.2.0.0
raw patch · 2 files changed
+102/−12 lines, 2 filesdep +aesondep +containersdep +riak-protobuf
Dependencies added: aeson, containers, riak-protobuf
Files
- snaplet-riak.cabal +11/−2
- src/Snap/Snaplet/Riak.hs +91/−10
snaplet-riak.cabal view
@@ -1,7 +1,9 @@ name: snaplet-riak-version: 0.1.0.0+version: 0.2.0.0 synopsis: A Snaplet for the Riak database--- description: +description: A Snaplet allowing easy use of the Riak database within+ the Snap framework.+homepage: http://github.com/statusfailed/snaplet-riak license: MIT license-file: LICENSE author: Paul Wilson@@ -20,11 +22,18 @@ base >= 4 && < 5, transformers >= 0.3.0 && < 0.4, mtl >= 2.1.2 && < 2.2,+ containers >= 0.5.0 && < 0.6,+ aeson >= 0.6.0 && < 0.7, snap >= 0.9.2 && < 0.10, snap-core >= 0.9.2 && < 0.10, data-lens-template >= 2.1.7 && < 2.2, data-lens >= 2.10.2 && < 2.11, riak >= 0.7.0 && < 0.8,+ riak-protobuf >= 0.16.0 && < 0.17, time >= 1.4.0 && < 1.5 Exposed-modules: Snap.Snaplet.Riak++source-repository head+ type: git+ location: https://github.com/statusfailed/snaplet-riak.git
src/Snap/Snaplet/Riak.hs view
@@ -1,17 +1,32 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} --- | A Snaplet for using the Riak database (via the 'Network.Riak' package)+-- | A Snaplet for using the Riak database (via the <http://hackage.haskell.org/package/riak riak> package)+-- Modelled on <http://hackage.haskell.org/package/snaplet-postgresql-simple snaplet-postgresql-simple>+ module Snap.Snaplet.Riak ( RiakDB , withRiak , riakInit , riakCreate+ , HasRiak(getRiakState)+ , get+ , getMany+ , modify+ , modify_+ , delete+ , put+ , putMany+ , listBuckets+ , foldKeys+ , getBucket+ , setBucket+ , mapReduce ) where import Prelude hiding ((.)) import Control.Category ((.))-import Control.Monad.State+import Control.Monad.State (MonadState, gets) import Control.Monad.IO.Class import Data.Lens.Common@@ -19,25 +34,41 @@ import Snap.Snaplet -import Data.Time.Clock-import Network.Riak+import Network.Riak (Connection, Client, Resolvable)+import Network.Riak.Types++import qualified Network.Riak as R+import Network.Riak.Protocol.BucketProps+import Network.Riak.Protocol.MapReduce import Network.Riak.Connection.Pool --- | Riak Snaplet state+import Data.Time.Clock+import Data.Aeson.Types+import Data.Sequence++-- | Riak Snaplet state. Stores a connection pool shared between handlers. data RiakDB = RiakDB { _pool :: Pool } makeLens ''RiakDB +-- | A class which, when implemented, allows the wrapper functions below to+-- be used without explicitly managing the connection and having to use liftIO.++-- The wrappers are pretty mechanically defined, so Template Haskell could+-- probably be used instead- especially since there are so many options in+-- Network.Riak+class MonadIO m => HasRiak m where+ getRiakState :: m RiakDB+ -- | Perform an action using a Riak Connection in the Riak snaplet -- -- > result <- withRiak $ \c -> get c "myBucket" "myKey" Default-withRiak :: (MonadIO m, MonadState app m) =>- Lens app (Snaplet RiakDB) -> (Connection -> IO a) -> m a-withRiak snaplet f = do- c <- gets $ getL (pool . snapletValue . snaplet)- liftIO $ withConnection c f+withRiak :: (HasRiak m) => (Connection -> IO a) -> m a+withRiak f = do+ c <- getRiakState+ liftIO $ withConnection (getL pool $ c) f -- | Utility function for creating the Riak snaplet from an Initializer makeRiak :: Initializer b v v -> SnapletInit b v@@ -52,3 +83,53 @@ riakCreate c ns t nc = makeRiak $ do pool <- liftIO $ create c ns t nc return $ RiakDB pool++get ::+ (HasRiak m, FromJSON a, ToJSON a, Resolvable a)+ => Bucket -> Key -> R -> m (Maybe (a, VClock))+get b k r = withRiak $ \conn -> R.get conn b k r++getMany ::+ (HasRiak m, FromJSON a, ToJSON a, Resolvable a)+ => Bucket -> [Key] -> R -> m [Maybe (a, VClock)]+getMany b ks r = withRiak $ \conn -> R.getMany conn b ks r++modify ::+ (HasRiak m, FromJSON a, ToJSON a, Resolvable a)+ => Bucket -> Key -> R -> W -> DW -> (Maybe a -> IO (a, b))+ -> m (a, b)+modify b k r w dw f = withRiak $ \conn -> R.modify conn b k r w dw f++modify_ ::+ (HasRiak m, FromJSON a, ToJSON a, Resolvable a)+ => Bucket -> Key -> R -> W -> DW -> (Maybe a -> IO a)+ -> m a+modify_ b k r w dw f = withRiak $ \conn -> R.modify_ conn b k r w dw f++delete :: (HasRiak m) => Bucket -> Key -> RW -> m ()+delete b k rw = withRiak $ \conn -> R.delete conn b k rw++put :: + (HasRiak m, Eq a, FromJSON a, ToJSON a, Resolvable a)+ => Bucket -> Key -> Maybe VClock -> a -> W -> DW -> m (a, VClock)+put b k vc c w dw = withRiak $ \conn -> R.put conn b k vc c w dw++putMany :: + (HasRiak m, Eq a, FromJSON a, ToJSON a, Resolvable a)+ => Bucket -> [(Key, Maybe VClock, a)] -> W -> DW -> m [(a, VClock)]+putMany b ks w dw = withRiak $ \conn -> R.putMany conn b ks w dw++listBuckets :: HasRiak m => m (Seq Bucket)+listBuckets = withRiak R.listBuckets++foldKeys :: HasRiak m => Bucket -> (a -> Key -> IO a) -> a -> m a+foldKeys b f x = withRiak $ \conn -> R.foldKeys conn b f x++getBucket :: HasRiak m => Bucket -> m BucketProps+getBucket b = withRiak $ \conn -> R.getBucket conn b++setBucket :: HasRiak m => Bucket -> BucketProps -> m ()+setBucket b props = withRiak $ \conn -> R.setBucket conn b props++mapReduce :: HasRiak m => Job -> (a -> MapReduce -> a) -> a -> m a+mapReduce job f z0 = withRiak $ \conn -> R.mapReduce conn job f z0