Permalink
Browse files

Merged from adinapoli + updated example + cosmetical changes

  • Loading branch information...
1 parent 7762d71 commit dde0e59ca571047bdf0be9933b2b1d8e03fe8b52 @Palmik committed Mar 15, 2013
Binary file not shown.
Binary file not shown.
@@ -20,18 +20,18 @@ Executable snaplet-mongodb-minimalistic-example1
main-is: Main.hs
Build-depends:
- base >= 4 && < 5,
- bytestring >= 0.9.1 && < 0.10,
- data-lens >= 2.0.1 && < 2.11,
- data-lens-template >= 2.1 && < 2.2,
- heist >= 0.8 && < 0.9,
- mtl >= 2 && < 3,
- snap == 0.9.*,
- snap-core == 0.9.*,
- snap-server == 0.9.*,
- snap-loader-static == 0.9.*,
- text >= 0.11 && < 0.12,
- xmlhtml >= 0.1,
+ -- You will want to add appropriate constraints here in production.
+ base,
+ bytestring,
+ lens,
+ heist,
+ mtl,
+ snap,
+ snap-core,
+ snap-server,
+ snap-loader-static,
+ text,
+ xmlhtml,
snaplet-mongodb-minimalistic,
mongoDB,
utf8-string
@@ -21,7 +21,6 @@ makeLenses ''App
instance HasHeist App where
heistLens = subSnaplet heist
--- This is ugly, how to beautify it?
instance HasMongoDB App where
getMongoDB app = view snapletValue (view database app)
@@ -10,24 +10,21 @@ module Example.Foo
import qualified Data.Text as T
import Data.Text (Text)
-import qualified Data.Text.Encoding as T (decodeUtf8)
import Snap
-import Snap.Snaplet
import Snap.Snaplet.MongoDB
-import Text.Templating.Heist
+import Heist.Interpreted
import Database.MongoDB
-import Control.Monad.Trans (liftIO)
makeTeamDocument name city = ["name" =: name, "city" =: city]
documentsSplice :: (HasMongoDB m) => Collection -> Splice (Handler m m)
documentsSplice collection = do
eres <- eitherWithDB $ rest =<< find (select [] collection)
- res <- return $ either (const []) id eres
- mapSplices (runChildrenWithText . showAs "document") res
+ mapSplices (runChildrenWithText . showAs "document")
+ (either (const []) id eres)
showAs :: (Show a) => Text -> a -> [(Text, Text)]
showAs name x = [(name, T.pack $ show x)]
@@ -27,7 +27,7 @@ main = do
'getActions
["resources/templates"])
- _ <- try $ httpServe conf $ site :: IO (Either SomeException ())
+ _ <- try $ httpServe conf site :: IO (Either SomeException ())
cleanup
getConf :: IO (Config Snap AppConfig)
@@ -4,22 +4,21 @@ module Site
( app
) where
-import Data.ByteString (ByteString)
-import Data.ByteString.UTF8 (toString)
+import Data.ByteString (ByteString)
+import Data.ByteString.UTF8 (toString)
-import Snap.Core
-import Snap.Util.FileServe
+import Snap.Core
+import Snap.Util.FileServe
-import Snap.Snaplet
-import Snap.Snaplet.Heist
-import Snap.Snaplet.MongoDB
+import Snap.Snaplet
+import Snap.Snaplet.Heist
+import Snap.Snaplet.MongoDB
-import Text.Templating.Heist
-import Text.XmlHtml hiding (render)
+import Heist.Interpreted
-import Application
+import Application
-import Example.Foo
+import Example.Foo
indexView :: Handler App App ()
@@ -1,9 +1,5 @@
Name: snaplet-mongodb-minimalistic
-<<<<<<< HEAD
-Version: 0.0.6.7
-=======
Version: 0.0.6.8
->>>>>>> 71af404f48b91fd01c1bcfe2b98407ca363c0d8e
Synopsis: Minimalistic MongoDB Snaplet.
Description: Minimalistic MongoDB Snaplet.
License: BSD3
@@ -36,22 +32,13 @@ Library
Other-modules:
Build-depends:
-<<<<<<< HEAD
- base == 4.*,
- lens >= 3.7 && < 3.9,
- mtl == 2.*,
- snap >= 0.10 && < 0.12,
- snap-core == 0.9.*,
- text == 0.11.*,
- mongoDB == 1.3.*
-=======
base >= 4 && < 5,
lens >= 3.7 && < 3.9,
mtl >= 2.0 && < 2.2,
transformers >= 0.2 && < 0.4,
snap >= 0.11 && < 0.12,
text >= 0.11 && < 0.12,
mongoDB >= 1.3 && < 1.4
->>>>>>> 71af404f48b91fd01c1bcfe2b98407ca363c0d8e
+ GHC-Options: -Wall
@@ -8,9 +8,9 @@ module Snap.Snaplet.MongoDB.Core
, HasMongoDB(..)
, MongoDBPool
, mongoDBInit
+, mongoDBInit'
) where
-import Control.Lens
import Data.Text (Text)
import Snap.Snaplet
import Control.Monad.IO.Class
@@ -18,9 +18,7 @@ import Control.Monad (liftM)
import Control.Monad.Error (runErrorT)
import Control.Lens (cloneLens, use)
-import Snap (MonadIO, MonadState, gets, liftIO) -- transformers, mtl
-import Snap (SnapletLens)
-import Snap (Snaplet, snapletValue)
+import Snap (MonadIO, MonadState, liftIO, SnapletLens, snapletValue)
import Snap.Snaplet.MongoDB.Core
import Database.MongoDB (Action, AccessMode, Failure (ConnectionFailure), access)
@@ -15,9 +15,7 @@ module Snap.Snaplet.MongoDB.Functions.S
) where
import Control.Monad.Error (runErrorT)
-import Control.Lens hiding (Action)
import Snap
-import Snap.Snaplet
import Snap.Snaplet.MongoDB.Core
import Database.MongoDB (Action, AccessMode, Failure (ConnectionFailure), access)
@@ -45,7 +43,7 @@ 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' mode action = do
- res <- (eitherWithDB' mode action)
+ res <- eitherWithDB' mode action
either (error . show) return res
------------------------------------------------------------------------------
@@ -70,7 +68,7 @@ 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' mode action = do
- res <- (eitherWithDB' mode action)
+ res <- eitherWithDB' mode action
return $ either (const Nothing) Just res
------------------------------------------------------------------------------
@@ -102,5 +100,5 @@ eitherWithDB' mode action = do
Right pip -> liftIO $ access pip mode database action
getMongoAccessMode :: (MonadIO m, MonadState app m, HasMongoDB app) => m AccessMode
-getMongoAccessMode = gets getMongoDB >>= return . mongoAccessMode
+getMongoAccessMode = mongoAccessMode `liftM` gets getMongoDB
{-# INLINE getMongoAccessMode #-}

0 comments on commit dde0e59

Please sign in to comment.