Permalink
Browse files

Consolidate into a single module, re-export Database.MongoDB for conv…

…enience
  • Loading branch information...
1 parent cdab848 commit e7366088b7a4171296fb70ac82f1453721b15a7d @ozataman committed Dec 23, 2010
Showing with 81 additions and 85 deletions.
  1. +1 −2 snap-extension-mongodb.cabal
  2. +80 −15 src/Snap/Extension/MongoDB.hs
  3. +0 −68 src/Snap/Extension/MongoDB/MongoDB.hs
@@ -1,5 +1,5 @@
Name: snap-extension-mongodb
-Version: 0.1.2
+Version: 0.1.3
Synopsis: MongoDB extension for Snap Framework
Homepage: https://github.com/ozataman/snap-extension-mongodb
License: BSD3
@@ -17,7 +17,6 @@ Library
Exposed-modules:
Snap.Extension.MongoDB
- , Snap.Extension.MongoDB.MongoDB
Build-depends:
base >= 4 && < 5
@@ -1,35 +1,50 @@
{-|
-'Snap.Extension.Timer' exports the 'MonadTimer' interface which allows you to
-keep track of the time at which your application was started. The interface's
-only operation is 'startTime'.
+'Snap.Extension.MongoDB' enables simple access to MongoDB databases inside of
+your Snap applications. There is currently a single back-end and therefore this
+library is presented in a single module.
-Two splices, 'startTimeSplice' and 'currentTimeSplice' are also provided, for
-your convenience.
+For convenience, this module will also export the 'Database.MongoDB' module,
+which means you don't have to import anything else.
-'Snap.Extension.Timer.Timer' contains the only implementation of this
-interface and can be used to turn your application's monad into a
-'MonadTimer'.
-
-More than anything else, this is intended to serve as an example Snap
-Extension to any developer wishing to write their own Snap Extension.
+To get started, make your 'ApplicationState' an instance of 'HasMongoDBState'
+and use 'mongoDBInitializer' in your application's initializer. Your
+'Application' will then be a 'MonadMongoDB'.
-}
module Snap.Extension.MongoDB
- ( MonadMongoDB(..)
+ (
+ -- * MongoDB Functionality Inside Snap Monad
+ MonadMongoDB(..)
+
+ -- * Implementation
+
+ -- ** Keeping MongoDB State
+ , MongoDBState(..)
+ , HasMongoDBState(..)
+
+ -- ** Initializing Your Applications
+ , mongoDBInitializer
+
+ -- * MongoDB Library
+ -- | Exported for your convenience.
+ , module Database.MongoDB
) where
+import Control.Monad
import Control.Monad.Trans
import Control.Monad.Reader
+
import Data.ByteString.Internal (c2w, w2c)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import Data.Word (Word8)
-
import Database.MongoDB
+
import Snap.Types
+import Snap.Extension
------------------------------------------------------------------------------
@@ -55,13 +70,63 @@ class MonadSnap m => MonadMongoDB m where
instance Val B8.ByteString where
val = val . B8.unpack
cast' x = fmap B8.pack . cast' $ x
- cast' _ = Nothing
------------------------------------------------------------------------------
-- | Get [Octet] to work directly with BSON auto-casting
instance Val [Word8] where
val = val . fmap w2c
cast' x = fmap (fmap c2w) . cast' $ x
- cast' _ = Nothing
+
+------------------------------------------------------------------------------
+------------------------------------------------------------------------------
+-- Implementation
+------------------------------------------------------------------------------
+------------------------------------------------------------------------------
+
+
+-- | MongoDB State
+data MongoDBState = MongoDBState
+ { connPool :: ConnPool Host
+ , appDatabase :: Database
+ }
+
+
+------------------------------------------------------------------------------
+-- |
+class HasMongoDBState s where
+ getMongoDBState :: s -> MongoDBState
+ setMongoDBState :: MongoDBState -> s -> s
+
+ modifyMongoDBState :: (MongoDBState -> MongoDBState) -> s -> s
+ modifyMongoDBState f s = setMongoDBState (f $ getMongoDBState s) s
+
+
+------------------------------------------------------------------------------
+-- |
+mongoDBInitializer :: Host
+ -> Int
+ -> UString
+ -> Initializer MongoDBState
+mongoDBInitializer h n db = do
+ mongoState <- liftIO $ do
+ pool <- newConnPool Internet n h
+ return $ MongoDBState pool (Database db)
+ mkInitializer mongoState
+
+
+------------------------------------------------------------------------------
+-- |
+instance InitializerState MongoDBState where
+ extensionId = const "MongoDB/MongoDB"
+ mkCleanup s = killPipes $ connPool s
+ mkReload = const $ return ()
+
+
+------------------------------------------------------------------------------
+-- |
+instance HasMongoDBState s => MonadMongoDB (SnapExtend s) where
+ withDB run = do
+ (MongoDBState pool db) <- asks getMongoDBState
+ liftIO . access safe Master pool $ use db run
@@ -1,68 +0,0 @@
-{-|
-
-
--}
-
-module Snap.Extension.MongoDB.MongoDB
- ( MongoDBState
- , HasMongoDBState(..)
- , mongoDBInitializer
- ) where
-
-import Control.Monad
-import Control.Monad.Reader
-import Control.Monad.Trans
-import qualified Data.ByteString as B
-
-import Database.MongoDB
-import Snap.Extension
-import Snap.Types
-
-import Snap.Extension.MongoDB
-
-
-------------------------------------------------------------------------------
--- | MongoDB State
-data MongoDBState = MongoDBState
- { connPool :: ConnPool Host
- , appDatabase :: Database
- }
-
-
-------------------------------------------------------------------------------
--- |
-class HasMongoDBState s where
- getMongoDBState :: s -> MongoDBState
- setMongoDBState :: MongoDBState -> s -> s
-
- modifyMongoDBState :: (MongoDBState -> MongoDBState) -> s -> s
- modifyMongoDBState f s = setMongoDBState (f $ getMongoDBState s) s
-
-
-------------------------------------------------------------------------------
--- |
-mongoDBInitializer :: Host
- -> Int
- -> UString
- -> Initializer MongoDBState
-mongoDBInitializer h n db = do
- mongoState <- liftIO $ do
- pool <- newConnPool Internet n h
- return $ MongoDBState pool (Database db)
- mkInitializer mongoState
-
-
-------------------------------------------------------------------------------
--- |
-instance InitializerState MongoDBState where
- extensionId = const "MongoDB/MongoDB"
- mkCleanup s = killPipes $ connPool s
- mkReload = const $ return ()
-
-
-------------------------------------------------------------------------------
--- |
-instance HasMongoDBState s => MonadMongoDB (SnapExtend s) where
- withDB run = do
- (MongoDBState pool db) <- asks getMongoDBState
- liftIO . access safe Master pool $ use db run

0 comments on commit e736608

Please sign in to comment.