Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Updated the code to use Control.Lens

  • Loading branch information...
commit 22120a24a495b07d504e3ab2ba9cfeef5529a059 1 parent e93461d
Alfredo Di Napoli authored
12 examples/example1/src/Application.hs
View
@@ -4,16 +4,11 @@
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
@@ -21,11 +16,12 @@ data App = App
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)
2  examples/example1/src/Example/Foo.hs
View
@@ -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)]
14 snaplet-mongodb-minimalistic.cabal
View
@@ -32,12 +32,12 @@ Library
Other-modules:
Build-depends:
- base == 4.*,
- lens == 3.7.*,
- mtl == 2.*,
- snap == 0.10.*,
- 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.10 && < 0.12,
+ text >= 0.11 && < 0.12,
+ mongoDB >= 1.3 && < 1.4
12 src/Snap/Snaplet/MongoDB/Core.hs
View
@@ -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)
@@ -52,8 +52,8 @@ data MongoDB = MongoDB
-- > getMongoDB = getL (snapletValue . database)
--
-- Note: The @(.)@ is from 'Control.Category'.
-class HasMongoDB app where
- getMongoDB :: app -> MongoDB
+class HasMongoDB a where
+ getMongoDB :: a -> MongoDB
------------------------------------------------------------------------------
-- | Initializer function.
@@ -91,4 +91,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
-
+
6 src/Snap/Snaplet/MongoDB/Functions/S.hs
View
@@ -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)
Please sign in to comment.
Something went wrong with that request. Please try again.