Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Updated some dependencies to match stackage snapshot 6.27 #18

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
+34 −37
Open

Updated some dependencies to match stackage snapshot 6.27 #18

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
69fc5d0
Updated some dependencies to match stackage snapshot 6.27
ludat Jan 19, 2017
700aa5b
Make default acces mode more reasonable
JuanFdS Feb 10, 2017
5f27668
Merge pull request #1 from JuanFdS/patch-1
ludat Feb 10, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 8 additions & 8 deletions snaplet-mongodb-minimalistic.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,14 +32,14 @@ Library

Other-modules:

Build-depends:
base >= 4 && < 5,
lens >= 3.7 && < 3.11,
mtl >= 2.0 && < 2.2,
transformers >= 0.2 && < 0.4,
snap >= 0.11 && < 0.14,
text >= 0.11 && < 1.2,
mongoDB >= 1.4 && < 1.5
Build-depends: base >= 4 && < 5
, lens >= 4.0 && < 5.0
, mtl >= 2.0 && < 2.3
, transformers >= 0.2 && < 0.5
, snap >= 0.11 && < 1.0
, text >= 0.11 && < 1.3
, mongoDB >= 2.0 && < 2.2
, resource-pool >= 0.2 && < 0.4

GHC-Options: -Wall

23 changes: 12 additions & 11 deletions src/Snap/Snaplet/MongoDB/Core.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,8 +14,8 @@ module Snap.Snaplet.MongoDB.Core
import Data.Text (Text)
import Snap.Snaplet
import Control.Monad.IO.Class
import Database.MongoDB (Database, Host, Pipe, AccessMode (UnconfirmedWrites), close, isClosed, connect)
import System.IO.Pool (Pool, Factory (Factory), newPool)
import Database.MongoDB (Database, Host, Pipe, AccessMode (..), close, connect)
import Data.Pool (Pool, createPool)

------------------------------------------------------------------------------

Expand All @@ -26,23 +26,23 @@ description = "Minimalistic MongoDB Snaplet."

------------------------------------------------------------------------------
-- | MongoDB Pool type
type MongoDBPool = Pool IOError Pipe
type MongoDBPool = Pool Pipe

------------------------------------------------------------------------------
-- | Snaplet's data type.
--
-- Usage:
--
--
-- > data App = App
-- > { _heist :: Snaplet (Heist App)
-- > , _database :: Snaplet MongoDB
-- > }
data MongoDB = MongoDB
{ mongoPool :: Pool IOError Pipe
{ mongoPool :: Pool Pipe
, mongoDatabase :: Database
, mongoAccessMode :: AccessMode
}

------------------------------------------------------------------------------
-- | Snaplet's type-class.
--
Expand All @@ -67,9 +67,10 @@ 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
mongoDBInit poolSize host database =
makeSnaplet "snaplet-mongodb" description Nothing $ do
pool <- liftIO $ createPool (connect host) close poolSize 0.5 1
return $ MongoDB pool database (ConfirmWrites [])

------------------------------------------------------------------------------
-- | Initializer function.
Expand All @@ -87,6 +88,6 @@ mongoDBInit' :: Int -- ^ Maximum pool size.
-> 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
pool <- liftIO $ createPool (connect h) close n 50 3 -- TODO I'm not so sure about this numbers
return $ MongoDB pool d m

18 changes: 8 additions & 10 deletions src/Snap/Snaplet/MongoDB/Functions/M.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,17 +12,17 @@ module Snap.Snaplet.MongoDB.Functions.M
, maybeWithDB'
, unsafeWithDB
, unsafeWithDB'
) where
) where

import Control.Monad (liftM)
import Control.Monad.Error (runErrorT)
import Control.Exception (try)
import Control.Lens (cloneLens, use)
import Control.Monad.State

import Snap (MonadIO, MonadState, liftIO, SnapletLens, snapletValue)
import Snap (SnapletLens, snapletValue)
import Snap.Snaplet.MongoDB.Core

import Database.MongoDB (Action, AccessMode, Failure (ConnectionFailure), access)
import System.IO.Pool (aResource)
import Database.MongoDB (Action, AccessMode, Failure (), access)
import qualified Data.Pool as Pool

------------------------------------------------------------------------------
-- | Database access function.
Expand Down Expand Up @@ -103,10 +103,8 @@ eitherWithDB' :: (MonadIO m, MonadState app m)
-> m (Either Failure a) -- ^ 'Either' 'Failure' or the action's result.
eitherWithDB' snaplet mode action = do
(MongoDB pool database _) <- use (cloneLens snaplet . snapletValue)
ep <- liftIO $ runErrorT $ aResource pool
case ep of
Left err -> return $ Left $ ConnectionFailure err
Right pip -> liftIO $ access pip mode database action
liftIO $ Pool.withResource pool $ \pip -> do
try $ access pip mode database action

getMongoAccessMode :: (MonadIO m, MonadState app m) => SnapletLens app MongoDB -> m AccessMode
getMongoAccessMode snaplet = mongoAccessMode `liftM` use (cloneLens snaplet . snapletValue)
Expand Down
14 changes: 6 additions & 8 deletions src/Snap/Snaplet/MongoDB/Functions/S.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,12 +14,12 @@ module Snap.Snaplet.MongoDB.Functions.S
, unsafeWithDB'
) where

import Control.Monad.Error (runErrorT)
import Snap
import Control.Monad.State
import Control.Exception (try)
import Snap.Snaplet.MongoDB.Core

import Database.MongoDB (Action, AccessMode, Failure (ConnectionFailure), access)
import System.IO.Pool (aResource)
import Database.MongoDB (Action, AccessMode, Failure (), access)
import qualified Data.Pool as Pool

------------------------------------------------------------------------------
-- | Database access function.
Expand Down Expand Up @@ -94,10 +94,8 @@ eitherWithDB' :: (MonadIO m, MonadState app m, HasMongoDB app)
-> 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
liftIO $ Pool.withResource pool $ \pip -> do
try $ access pip mode database action

getMongoAccessMode :: (MonadIO m, MonadState app m, HasMongoDB app) => m AccessMode
getMongoAccessMode = mongoAccessMode `liftM` gets getMongoDB
Expand Down