Permalink
Browse files

What was in MongoDB.Functions is now in MongoDB.Funcstions.S (you can…

… still use the old module for now). In MongoDB.Functions.M contains functions that let you select the database (you pass it the MongoDB Snaplet lens) on which you want the action to be run.
  • Loading branch information...
1 parent 27ad6d8 commit 34848ac43e614971b03cf96f915da46dc23f7fef @Palmik committed Jan 17, 2012
Binary file not shown.
@@ -1,5 +1,5 @@
name: snaplet-mongodb-minimalistic
-version: 0.0.2
+version: 0.0.3
synopsis: Minimalistic MongoDB Snaplet.
description: Minimalistic MongoDB Snaplet.
license: BSD3
@@ -21,7 +21,9 @@ Library
Exposed-modules:
Snap.Snaplet.MongoDB,
Snap.Snaplet.MongoDB.Core,
- Snap.Snaplet.MongoDB.Functions
+ Snap.Snaplet.MongoDB.Functions,
+ Snap.Snaplet.MongoDB.Functions.S,
+ Snap.Snaplet.MongoDB.Functions.M
Build-depends:
base >= 4 && < 5,
@@ -1,10 +1,20 @@
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.
@@ -20,7 +30,7 @@ data MongoDB = MongoDB
{ mongoPool :: Pool IOError Pipe
, mongoDatabase :: Database
}
-
+
------------------------------------------------------------------------------
-- | Snaplet's type-class.
--
@@ -33,4 +43,23 @@ data MongoDB = MongoDB
-- Note: The (.) is from Control.Category.
class HasMongoDB app where
getMongoDB :: app -> MongoDB
+
+------------------------------------------------------------------------------
+-- | 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
@@ -1,123 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE UndecidableInstances #-}
-
module Snap.Snaplet.MongoDB.Functions
-( mongoDBInit
-, eitherWithDB'
-, eitherWithDB
-, maybeWithDB
-, maybeWithDB'
-, unsafeWithDB
-, unsafeWithDB'
+( module Snap.Snaplet.MongoDB.Functions.S
) 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
-
+import Snap.Snaplet.MongoDB.Functions.S

0 comments on commit 34848ac

Please sign in to comment.