Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

* Initial commit

  • Loading branch information...
commit 92bad96fdba14b933f64af7f2f037e80a8f6a622 0 parents
@ozataman authored
1  .gitignore
@@ -0,0 +1 @@
+dist
30 LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2010, Ozgun Ataman
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Ozgun Ataman nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
14 README.md
@@ -0,0 +1,14 @@
+README
+======
+
+
+Snap Extension for MongoDB
+--------------------------
+
+This package provides a straightforward way to integrate MongoDB database
+connectivity into Snap applications.
+
+This is a very crude initial realease, to be refined on an ongoing basis. The
+API may change, so please use at your own risk for the time being.
+
+
2  Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
34 snap-extension-mongodb.cabal
@@ -0,0 +1,34 @@
+Name: snap-extension-mongodb
+Version: 0.1
+Synopsis: MongoDB extension for Snap Framework
+Homepage: https://github.com/ozataman/snap-extension-mongodb
+License: BSD3
+License-file: LICENSE
+Author: Ozgun Ataman
+Maintainer: ozataman@gmail.com
+Category: Web
+Build-type: Simple
+
+Cabal-version: >=1.2
+
+
+Library
+ hs-source-dirs: src
+
+ Exposed-modules:
+ Snap.Extension.MongoDB
+ , Snap.Extension.MongoDB.MongoDB
+
+ Build-depends:
+ base >= 4 && < 5
+ , bytestring >= 0.9
+ , mongoDB >= 0.8
+ , mtl
+ , snap >= 0.3 && < 0.4
+ , snap-core >= 0.3 && < 0.4
+
+ extensions:
+ OverloadedStrings
+ , Rank2Types
+ , MultiParamTypeClasses
+ , UndecidableInstances
36 src/Snap/Extension/MongoDB.hs
@@ -0,0 +1,36 @@
+{-|
+
+'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'.
+
+Two splices, 'startTimeSplice' and 'currentTimeSplice' are also provided, for
+your convenience.
+
+'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.
+
+-}
+
+module Snap.Extension.MongoDB
+ ( MonadMongoDB(..)
+ ) where
+
+import Control.Monad.Trans
+import Control.Monad.Reader
+
+import Database.MongoDB
+import Snap.Types
+
+
+------------------------------------------------------------------------------
+-- | The 'MonadMongoDB' class. Minimal complete definition:
+class MonadSnap m => MonadMongoDB m where
+
+ ----------------------------------------------------------------------------
+ -- |
+ withDB :: ReaderT Database (Action m) a -> m (Either Failure a)
69 src/Snap/Extension/MongoDB/MongoDB.hs
@@ -0,0 +1,69 @@
+{-|
+
+
+-}
+
+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 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
+ access safe Master pool $ use db run
Please sign in to comment.
Something went wrong with that request. Please try again.