snaplet-mongodb-minimalistic 0.0.3 → 0.0.5
raw patch · 5 files changed
+284/−142 lines, 5 files
Files
- snaplet-mongodb-minimalistic.cabal +3/−2
- src/Snap/Snaplet/MongoDB/Core.hs +69/−17
- src/Snap/Snaplet/MongoDB/Functions.hs +0/−123
- src/Snap/Snaplet/MongoDB/Functions/M.hs +111/−0
- src/Snap/Snaplet/MongoDB/Functions/S.hs +101/−0
snaplet-mongodb-minimalistic.cabal view
@@ -1,5 +1,5 @@ name: snaplet-mongodb-minimalistic-version: 0.0.3+version: 0.0.5 synopsis: Minimalistic MongoDB Snaplet. description: Minimalistic MongoDB Snaplet. license: BSD3@@ -21,7 +21,8 @@ Exposed-modules: Snap.Snaplet.MongoDB, Snap.Snaplet.MongoDB.Core,- Snap.Snaplet.MongoDB.Functions+ Snap.Snaplet.MongoDB.Functions.S,+ Snap.Snaplet.MongoDB.Functions.M Build-depends: base >= 4 && < 5,
src/Snap/Snaplet/MongoDB/Core.hs view
@@ -1,36 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}++------------------------------------------------------------------------------+-- | In this module you can find the Snaplet's data type, type class and initializer.+------------------------------------------------------------------------------ module Snap.Snaplet.MongoDB.Core ( MongoDB(..) , HasMongoDB(..)+, mongoDBInit ) where -import Database.MongoDB-import System.IO.Pool+import Data.Text (Text) +import Snap++import Database.MongoDB+import System.IO.Pool+ ------------------------------------------------------------------------------+-- | Description text used in mongoDBInit as makeSnaplet argument.+description :: Text+description = "Minimalistic MongoDB Snaplet."++------------------------------------------------------------------------------ -- | Snaplet's data type. ----- Example:--- @--- data App = App--- { _heist :: Snaplet (Heist App)--- , _database :: Snaplet MongoDB--- }--- @+-- Usage:+-- +-- > data App = App+-- > { _heist :: Snaplet (Heist App)+-- > , _database :: Snaplet MongoDB+-- > } data MongoDB = MongoDB- { mongoPool :: Pool IOError Pipe+ { mongoPool :: Pool IOError Pipe , mongoDatabase :: Database+ , mongoAccessMode :: AccessMode }-+ ------------------------------------------------------------------------------ -- | Snaplet's type-class. ----- Example:--- @--- instance HasMongoDB App where--- getMongoDB = getL (snapletValue . database)--- @+-- Usage: ----- Note: The (.) is from Control.Category.+--+-- > instance HasMongoDB App where+-- > getMongoDB = getL (snapletValue . database)+--+-- Note: The @(.)@ is from 'Control.Category'. class HasMongoDB app where getMongoDB :: app -> MongoDB++------------------------------------------------------------------------------+-- | Initializer function.+--+-- Usage:+--+-- > app :: SnapletInit App App+-- > app = makeSnaplet "app" "Example application." Nothing $ do+-- > h <- nestSnaplet "heist" heist $ heistInit "resources/templates"+-- > d <- nestSnaplet "database" database $ mongoDBInit 10 (host "127.0.0.1") "Snaplet-MongoDB"+-- > return $ App h d+mongoDBInit :: Int -- ^ Maximum pool size.+ -> Host -- ^ Host (e.g. return value of MongoDB's host function).+ -> Database -- ^ Database name.+ -> SnapletInit app MongoDB+mongoDBInit n h d = makeSnaplet "snaplet-mongodb" description Nothing $ do+ pool <- liftIO $ newPool (Factory (connect h) close isClosed) n+ return $ MongoDB pool d UnconfirmedWrites++------------------------------------------------------------------------------+-- | Initializer function.+--+-- Usage:+--+-- > app :: SnapletInit App App+-- > app = makeSnaplet "app" "Example application." Nothing $ do+-- > h <- nestSnaplet "heist" heist $ heistInit "resources/templates"+-- > d <- nestSnaplet "database" database $ mongoDBInit 10 (host "127.0.0.1") "Snaplet-MongoDB"+-- > return $ App h d+mongoDBInit' :: Int -- ^ Maximum pool size.+ -> Host -- ^ Host (e.g. return value of MongoDB's host function).+ -> Database -- ^ Database name.+ -> AccessMode -- ^ Default access mode to be used with this snaplet.+ -> SnapletInit app MongoDB+mongoDBInit' n h d m = makeSnaplet "snaplet-mongodb" description Nothing $ do+ pool <- liftIO $ newPool (Factory (connect h) close isClosed) n+ return $ MongoDB pool d m
− src/Snap/Snaplet/MongoDB/Functions.hs
@@ -1,123 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances #-}--module Snap.Snaplet.MongoDB.Functions-( mongoDBInit-, eitherWithDB'-, eitherWithDB-, maybeWithDB-, maybeWithDB'-, unsafeWithDB-, unsafeWithDB'-) where--import Data.Text (Text)-import Control.Monad.Error--import Snap-import Snap.Snaplet.MongoDB.Core--import Database.MongoDB-import System.IO.Pool----------------------------------------------------------------------------------- | Description text used in mongoDBInit as makeSnaplet argument.-description :: Text-description = "Minimalistic MongoDB Snaplet."----------------------------------------------------------------------------------- | Initializer function.--- 1. argument: Maximum pool size.--- 2. argument: Host (e.g. return value of MongoDB's host function).--- 3. argument: Database name.------ Example:--- @--- app :: SnapletInit App App--- app = makeSnaplet "app" "An snaplet example application." Nothing $ do--- h <- nestSnaplet "heist" heist $ heistInit "resources/templates"--- d <- nestSnaplet "database" database $ mongoDBInit 10 (host "127.0.0.1") "Snaplet-MongoDB"--- return $ App h d--- @-mongoDBInit :: Int -> Host -> Database -> SnapletInit app MongoDB-mongoDBInit n h d = makeSnaplet "snaplet-mongodb" description Nothing $ do- pool <- liftIO $ newPool (Factory (connect h) close isClosed) n- return $ MongoDB pool d--class (MonadIO m, MonadState app m, HasMongoDB app) => HasMongoDB' app m-instance (MonadIO m, MonadState app m, HasMongoDB app) => HasMongoDB' app m----------------------------------------------------------------------------------- | Database access function.--- 1. argument: Action to perform. (Defaults to UnconfirmedWrites AccessMode)--- Returns: The action's result; in case of failure error is called.------ Example:--- > unsafeWithDB $ insert "test-collection" ["some_field" = " something" ]-unsafeWithDB :: (HasMongoDB' app m) => Action IO a -> m a-unsafeWithDB = unsafeWithDB' UnconfirmedWrites----------------------------------------------------------------------------------- | Database access function.--- 1. argument: AccessMode.--- 2. argument: Action to perform.--- Returns: The action's result; in case of failure error is called.------ Example:--- > unsafeWithDB' UnconfirmedWrites $ insert "test-collection" ["some_field" = " something" ]-unsafeWithDB' :: (HasMongoDB' app m) => AccessMode -> Action IO a -> m a-unsafeWithDB' mode action = do- res <- (eitherWithDB' mode action)- return $ either (error . show) id res----------------------------------------------------------------------------------- | Database access function.--- 1. argument: Action to perform. (Defaults to UnconfirmedWrites AccessMode)--- Returns: Nothing in case of failure or Just the rsult of the action.------ Example:--- > maybeWithDB $ insert "test-collection" ["some_field" = " something" ]-maybeWithDB :: (HasMongoDB' app m) => Action IO a -> m (Maybe a)-maybeWithDB = maybeWithDB' UnconfirmedWrites----------------------------------------------------------------------------------- | Database access function.--- 1. argument: AccessMode.--- 2. argument: Action to perform.--- Returns: Nothing in case of failure or Just the rsult of the action.------ Example:--- > maybeWithDB' UnconfirmedWrites $ insert "test-collection" ["some_field" = " something" ]-maybeWithDB' :: (HasMongoDB' app m) => AccessMode -> Action IO a -> m (Maybe a)-maybeWithDB' mode action = do- res <- (eitherWithDB' mode action)- return $ either (const Nothing) Just res----------------------------------------------------------------------------------- | Database access function.--- 1. argument: Action to perform. (Defaults to UnconfirmedWrites AccessMode)--- Returns: Either Failure or the action's result.------ Example:--- > eitherWithDB $ insert "test-collection" ["some_field" = " something" ]-eitherWithDB :: (HasMongoDB' app m) => Action IO a -> m (Either Failure a)-eitherWithDB = eitherWithDB' UnconfirmedWrites----------------------------------------------------------------------------------- | Database access function.--- 1. argument: AccessMode.--- 2. argument: Action to perform.--- Returns: Either Failure or the action's result.------ Example:--- > eitherWithDB' UnconfirmedWrites $ insert "test-collection" ["some_field" = " something" ]-eitherWithDB' :: (HasMongoDB' app m) => AccessMode -> Action IO a -> m (Either Failure a)-eitherWithDB' mode action = do- (MongoDB pool database) <- gets getMongoDB- ep <- liftIO $ runErrorT $ aResource pool- case ep of- Left err -> return $ Left $ ConnectionFailure err- Right pip -> liftIO $ access pip mode database action-
+ src/Snap/Snaplet/MongoDB/Functions/M.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedStrings #-}++------------------------------------------------------------------------------+-- | In this module you can find variations of @withDB@ functions.+--+-- Functions from this module are to be used when you have multiple MongoDB snaplets (databases) in your application.+------------------------------------------------------------------------------+module Snap.Snaplet.MongoDB.Functions.M+( eitherWithDB+, eitherWithDB'+, maybeWithDB+, maybeWithDB'+, unsafeWithDB+, unsafeWithDB'+) where ++import Control.Monad.Error++import Snap+import Snap.Snaplet.MongoDB.Core++import Database.MongoDB+import System.IO.Pool++import qualified Control.Category as C ((.))++------------------------------------------------------------------------------+-- | Database access function.+--+-- Example:+--+-- > 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.+unsafeWithDB snaplet = unsafeWithDB' snaplet UnconfirmedWrites++------------------------------------------------------------------------------+-- | Database access function.+--+-- Example:+--+-- > 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.+unsafeWithDB' snaplet mode action = do+ res <- (eitherWithDB' snaplet mode action)+ either (error . show) return res++------------------------------------------------------------------------------+-- | Database access function.+--+-- Example:+--+-- > 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.+maybeWithDB snaplet = maybeWithDB' snaplet UnconfirmedWrites++------------------------------------------------------------------------------+-- | Database access function.+--+-- Example:+--+-- > 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.+maybeWithDB' snaplet mode action = do+ res <- (eitherWithDB' snaplet mode action)+ return $ either (const Nothing) Just res++------------------------------------------------------------------------------+-- | Database access function.+--+-- Example:+--+-- > 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.+eitherWithDB snaplet = eitherWithDB' snaplet UnconfirmedWrites++------------------------------------------------------------------------------+-- | Database access function.+--+-- Example:+--+-- > 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.+eitherWithDB' snaplet mode action = do+ (MongoDB pool database _) <- gets (getL ((C..) snapletValue snaplet))+ ep <- liftIO $ runErrorT $ aResource pool+ case ep of+ Left err -> return $ Left $ ConnectionFailure err+ Right pip -> liftIO $ access pip mode database action++
+ src/Snap/Snaplet/MongoDB/Functions/S.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE OverloadedStrings #-}++------------------------------------------------------------------------------+-- | In this module you can find variations of @withDB@ functions.+--+-- Functions from this module are to be used when you have single MongoDB snaplet in your application and your application is an instance of HasMongoDB.+------------------------------------------------------------------------------+module Snap.Snaplet.MongoDB.Functions.S+( eitherWithDB+, eitherWithDB'+, maybeWithDB+, maybeWithDB'+, unsafeWithDB+, unsafeWithDB'+) where++import Control.Monad.Error++import Snap+import Snap.Snaplet.MongoDB.Core++import Database.MongoDB+import System.IO.Pool++------------------------------------------------------------------------------+-- | Database access function.+--+-- Usage:+--+-- > unsafeWithDB $ insert "test-collection" ["some_field" = "something" ]+unsafeWithDB :: (MonadIO m, MonadState app m, HasMongoDB app)+ => Action IO a -- ^ 'Action' you want to perform.+ -> m a -- ^ The action's result; in case of failure 'error' is called.+unsafeWithDB = unsafeWithDB' UnconfirmedWrites++------------------------------------------------------------------------------+-- | Database access function.+--+-- Usage:+--+-- > unsafeWithDB' UnconfirmedWrites $ insert "test-collection" ["some_field" = "something" ]+unsafeWithDB' :: (MonadIO m, MonadState app m, HasMongoDB app)+ => 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' mode action = do+ res <- (eitherWithDB' mode action)+ either (error . show) return res++------------------------------------------------------------------------------+-- | Database access function.+--+-- Usage:+--+-- > maybeWithDB $ insert "test-collection" ["some_field" = "something" ]+maybeWithDB :: (MonadIO m, MonadState app m, HasMongoDB app)+ => Action IO a -- ^ 'Action' you want to perform.+ -> m (Maybe a) -- ^ 'Nothing' in case of failure or 'Just' the result of the action.+maybeWithDB = maybeWithDB' UnconfirmedWrites++------------------------------------------------------------------------------+-- | Database access function.+--+-- Usage:+--+-- > maybeWithDB' UnconfirmedWrites $ insert "test-collection" ["some_field" = "something" ]+maybeWithDB' :: (MonadIO m, MonadState app m, HasMongoDB app)+ => 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' mode action = do+ res <- (eitherWithDB' mode action)+ return $ either (const Nothing) Just res++------------------------------------------------------------------------------+-- | Database access function.+--+-- Usage:+--+-- > eitherWithDB $ insert "test-collection" ["some_field" = "something" ]+eitherWithDB :: (MonadIO m, MonadState app m, HasMongoDB app)+ => Action IO a -- ^ 'Action' you want to perform.+ -> m (Either Failure a) -- ^ 'Either' 'Failure' or the action's result.+eitherWithDB = eitherWithDB' UnconfirmedWrites++------------------------------------------------------------------------------+-- | Database access function.+--+-- Usage:+--+-- > eitherWithDB' UnconfirmedWrites $ insert "test-collection" ["some_field" = "something" ]+eitherWithDB' :: (MonadIO m, MonadState app m, HasMongoDB app)+ => 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' mode action = do+ (MongoDB pool database _) <- gets getMongoDB+ ep <- liftIO $ runErrorT $ aResource pool+ case ep of+ Left err -> return $ Left $ ConnectionFailure err+ Right pip -> liftIO $ access pip mode database action