Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Modify to work with snap-0.10.*

snap-0.10 uses the lens package instead of data-lens, so we use
lens package lenses in M.hs. Also remove some unnecessary imports
in S.hs, bump the snap dependency, and add a direct dependency on
the lens package. (The last is needed because we're using functions
from Control.Lens that Snap does not re-export.)
  • Loading branch information...
commit b4c8335521ebde95cf18cc852b4338541054f17f 1 parent 014fc12
@zopa zopa authored
View
3  snaplet-mongodb-minimalistic.cabal
@@ -33,8 +33,9 @@ Library
Build-depends:
base == 4.*,
+ lens == 3.7.*,
mtl == 2.*,
- snap == 0.9.*,
+ snap == 0.10.*,
snap-core == 0.9.*,
text == 0.11.*,
mongoDB == 1.3.*
View
58 src/Snap/Snaplet/MongoDB/Functions/M.hs
@@ -15,17 +15,16 @@ module Snap.Snaplet.MongoDB.Functions.M
) where
import Control.Monad.Error (runErrorT)
+import Control.Lens (cloneLens, use)
import Snap (MonadIO, MonadState, gets, liftIO) -- transformers, mtl
-import Snap (Lens, getL) -- data-lens
+import Snap (SnapletLens)
import Snap (Snaplet, snapletValue)
import Snap.Snaplet.MongoDB.Core
import Database.MongoDB (Action, AccessMode, Failure (ConnectionFailure), access)
import System.IO.Pool (aResource)
-import qualified Control.Category as C ((.))
-
------------------------------------------------------------------------------
-- | Database access function.
--
@@ -33,9 +32,9 @@ import qualified Control.Category as C ((.))
--
-- > unsafeWithDB accountDB $ insert "test-collection" [ "some_field" = "something" ]
unsafeWithDB :: (MonadIO m, MonadState app m)
- => Lens app (Snaplet MongoDB) -- ^ The snaplet (database) on which you want the action to be run.
- -> Action IO a -- ^ 'Action' you want to perform.
- -> m a -- ^ The action's result; in case of failure 'error' is called.
+ => SnapletLens app MongoDB -- ^ The snaplet (database) on which you want the action to be run.
+ -> Action IO a -- ^ 'Action' you want to perform.
+ -> m a -- ^ The action's result; in case of failure 'error' is called.
unsafeWithDB snaplet action = getMongoAccessMode snaplet >>= flip (unsafeWithDB' snaplet) action
------------------------------------------------------------------------------
@@ -45,10 +44,10 @@ unsafeWithDB snaplet action = getMongoAccessMode snaplet >>= flip (unsafeWithDB'
--
-- > unsafeWithDB' accountDB UnconfirmedWrites $ insert "test-collection" [ "some_field" = "something" ]
unsafeWithDB' :: (MonadIO m, MonadState app m)
- => Lens app (Snaplet MongoDB) -- ^ The snaplet (database) on which you want the action to be run.
- -> AccessMode -- ^ Access mode you want to use when performing the action.
- -> Action IO a -- ^ 'Action' you want to perform.
- -> m a -- ^ The action's result; in case of failure 'error' is called.
+ => SnapletLens app MongoDB -- ^ The snaplet (database) on which you want the action to be run.
+ -> AccessMode -- ^ Access mode you want to use when performing the action.
+ -> Action IO a -- ^ 'Action' you want to perform.
+ -> m a -- ^ The action's result; in case of failure 'error' is called.
unsafeWithDB' snaplet mode action = do
res <- (eitherWithDB' snaplet mode action)
either (error . show) return res
@@ -60,9 +59,9 @@ unsafeWithDB' snaplet mode action = do
--
-- > maybeWithDB accountDB $ insert "test-collection" [ "some_field" = "something" ]
maybeWithDB :: (MonadIO m, MonadState app m)
- => Lens app (Snaplet MongoDB) -- ^ The snaplet (database) on which you want the action to be run.
- -> Action IO a -- ^ 'Action' you want to perform.
- -> m (Maybe a) -- ^ 'Nothing' in case of failure or 'Just' the result of the action.
+ => SnapletLens app MongoDB -- ^ The snaplet (database) on which you want the action to be run.
+ -> Action IO a -- ^ 'Action' you want to perform.
+ -> m (Maybe a) -- ^ 'Nothing' in case of failure or 'Just' the result of the action.
maybeWithDB snaplet action = getMongoAccessMode snaplet >>= flip (maybeWithDB' snaplet) action
------------------------------------------------------------------------------
@@ -72,10 +71,10 @@ maybeWithDB snaplet action = getMongoAccessMode snaplet >>= flip (maybeWithDB' s
--
-- > maybeWithDB' accountDB UnconfirmedWrites $ insert "test-collection" [ "some_field" = "something" ]
maybeWithDB' :: (MonadIO m, MonadState app m)
- => Lens app (Snaplet MongoDB) -- ^ The snaplet (database) on which you want the action to be run.
- -> AccessMode -- ^ Access mode you want to use when performing the action.
- -> Action IO a -- ^ 'Action' you want to perform.
- -> m (Maybe a) -- ^ 'Nothing' in case of failure or 'Just' the result of the action.
+ => SnapletLens app MongoDB -- ^ The snaplet (database) on which you want the action to be run.
+ -> AccessMode -- ^ Access mode you want to use when performing the action.
+ -> Action IO a -- ^ 'Action' you want to perform.
+ -> m (Maybe a) -- ^ 'Nothing' in case of failure or 'Just' the result of the action.
maybeWithDB' snaplet mode action = do
res <- (eitherWithDB' snaplet mode action)
return $ either (const Nothing) Just res
@@ -87,9 +86,9 @@ maybeWithDB' snaplet mode action = do
--
-- > eitherWithDB accountDB $ insert "test-collection" [ "some_field" = "something" ]
eitherWithDB :: (MonadIO m, MonadState app m)
- => Lens app (Snaplet MongoDB) -- ^ The snaplet (database) on which you want the action to be run.
- -> Action IO a -- ^ 'Action' you want to perform.
- -> m (Either Failure a) -- ^ 'Either' 'Failure' or the action's result.
+ => SnapletLens app MongoDB -- ^ The snaplet (database) on which you want the action to be run.
+ -> Action IO a -- ^ 'Action' you want to perform.
+ -> m (Either Failure a) -- ^ 'Either' 'Failure' or the action's result.
eitherWithDB snaplet action = getMongoAccessMode snaplet >>= flip (eitherWithDB' snaplet) action
------------------------------------------------------------------------------
@@ -99,19 +98,20 @@ eitherWithDB snaplet action = getMongoAccessMode snaplet >>= flip (eitherWithDB'
--
-- > eitherWithDB' accountDB UnconfirmedWrites $ insert "test-collection" [ "some_field" = "something" ]
eitherWithDB' :: (MonadIO m, MonadState app m)
- => Lens app (Snaplet MongoDB) -- ^ The snaplet (database) on which you want the action to be run.
- -> AccessMode -- ^ Access mode you want to use when performing the action.
- -> Action IO a -- ^ 'Action' you want to perform.
- -> m (Either Failure a) -- ^ 'Either' 'Failure' or the action's result.
+ => SnapletLens app MongoDB -- ^ The snaplet (database) on which you want the action to be run.
+ -> AccessMode -- ^ Access mode you want to use when performing the action.
+ -> Action IO a -- ^ 'Action' you want to perform.
+ -> m (Either Failure a) -- ^ 'Either' 'Failure' or the action's result.
eitherWithDB' snaplet mode action = do
- (MongoDB pool database _) <- gets (getL ((C..) snapletValue snaplet))
+ (MongoDB pool database _) <- use (snaplet'.snapletValue)
ep <- liftIO $ runErrorT $ aResource pool
case ep of
Left err -> return $ Left $ ConnectionFailure err
Right pip -> liftIO $ access pip mode database action
+ where
+ snaplet' = cloneLens snaplet
-getMongoAccessMode :: (MonadIO m, MonadState app m) => Lens app (Snaplet MongoDB) -> m AccessMode
-getMongoAccessMode snaplet = gets (getL ((C..) snapletValue snaplet)) >>= return . mongoAccessMode
+getMongoAccessMode :: (MonadIO m, MonadState app m) => SnapletLens app MongoDB -> m AccessMode
+getMongoAccessMode snaplet = use (snaplet'.snapletValue) >>= return . mongoAccessMode
+ where snaplet' = cloneLens snaplet
{-# INLINE getMongoAccessMode #-}
-
-
View
1  src/Snap/Snaplet/MongoDB/Functions/S.hs
@@ -17,7 +17,6 @@ module Snap.Snaplet.MongoDB.Functions.S
import Control.Monad.Error (runErrorT)
import Snap (MonadIO, MonadState, gets, liftIO) -- transformers, mtl
-import Snap (Lens, getL) -- data-lens
import Snap (Snaplet, snapletValue)
import Snap.Snaplet.MongoDB.Core
Please sign in to comment.
Something went wrong with that request. Please try again.