Permalink
Browse files

Merge

  • Loading branch information...
2 parents f0988de + 71af404 commit 7762d71a39c1da20cf5f69b403211529829e8d04 @Palmik committed Mar 15, 2013
View
12 examples/example1/src/Application.hs
@@ -4,28 +4,24 @@
module Application where
-import Data.Lens.Template
-import Data.Lens.Common
-
+import Control.Lens
import Snap.Snaplet
import Snap.Snaplet.Heist
import Snap.Snaplet.MongoDB.Core
-import Control.Category ((.))
-import Prelude hiding ((.))
-
data App = App
{ _heist :: Snaplet (Heist App)
, _database :: Snaplet MongoDB
}
type AppHandler = Handler App App
-makeLens ''App
+makeLenses ''App
instance HasHeist App where
heistLens = subSnaplet heist
+-- This is ugly, how to beautify it?
instance HasMongoDB App where
- getMongoDB = getL (snapletValue . database)
+ getMongoDB app = view snapletValue (view database app)
View
2 examples/example1/src/Example/Foo.hs
@@ -30,4 +30,4 @@ documentsSplice collection = do
mapSplices (runChildrenWithText . showAs "document") res
showAs :: (Show a) => Text -> a -> [(Text, Text)]
-showAs name x = [(name, T.pack $ show x)]
+showAs name x = [(name, T.pack $ show x)]
View
14 snaplet-mongodb-minimalistic.cabal
@@ -1,5 +1,9 @@
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
@@ -32,12 +36,22 @@ 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
View
16 src/Snap/Snaplet/MongoDB/Core.hs
@@ -10,10 +10,10 @@ module Snap.Snaplet.MongoDB.Core
, mongoDBInit
) where
+import Control.Lens
import Data.Text (Text)
-
-import Snap (SnapletInit, liftIO, makeSnaplet)
-
+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)
@@ -49,11 +49,9 @@ data MongoDB = MongoDB
-- Usage:
--
-- > instance HasMongoDB App where
--- > getMongoDB = getL (snapletValue . database)
---
--- Note: The @(.)@ is from 'Control.Category'.
-class HasMongoDB app where
- getMongoDB :: app -> MongoDB
+-- > getMongoDB app = view snapletValue (view database app)
+class HasMongoDB a where
+ getMongoDB :: a -> MongoDB
------------------------------------------------------------------------------
-- | Initializer function.
@@ -91,4 +89,4 @@ mongoDBInit' :: Int -- ^ Maximum pool size.
mongoDBInit' n h d m = makeSnaplet "snaplet-mongodb" description Nothing $ do
pool <- liftIO $ newPool (Factory (connect h) close isClosed) n
return $ MongoDB pool d m
-
+
View
6 src/Snap/Snaplet/MongoDB/Functions/S.hs
@@ -15,9 +15,9 @@ module Snap.Snaplet.MongoDB.Functions.S
) where
import Control.Monad.Error (runErrorT)
-
-import Snap (MonadIO, MonadState, gets, liftIO) -- transformers, mtl
-import Snap (Snaplet, snapletValue)
+import Control.Lens hiding (Action)
+import Snap
+import Snap.Snaplet
import Snap.Snaplet.MongoDB.Core
import Database.MongoDB (Action, AccessMode, Failure (ConnectionFailure), access)

0 comments on commit 7762d71

Please sign in to comment.