Moved initializers from Core to Functions. Removed unneccessary langu…

…age extensions. Added README.md.
Palmik · Jan 15, 2012 · 2648e7b · 2648e7b
1 parent a028ad7
commit 2648e7b
Show file tree

Hide file tree

Showing 4 changed files with 100 additions and 108 deletions.
diff --git a/README.md b/README.md
@@ -54,94 +54,94 @@ We will follow the common Snap project structure.
 
 ### src/Example/Foo.hs
 
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE ExtendedDefaultRules      #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
+    {-# LANGUAGE OverloadedStrings         #-}
+    {-# LANGUAGE ExtendedDefaultRules      #-}
+    {-# LANGUAGE NoMonomorphismRestriction #-}
 
-module Example.Foo
-( makeTeamDocument
-, documentsSplice
-, module Database.MongoDB
-) where
+    module Example.Foo
+    ( makeTeamDocument
+    , documentsSplice
+    , module Database.MongoDB
+    ) where
 
-import qualified Data.Text as T
-import           Data.Text (Text)
-import qualified Data.Text.Encoding as T (decodeUtf8)
+    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 Snap
+    import Snap.Snaplet
+    import Snap.Snaplet.MongoDB
 
-import Text.Templating.Heist
+    import Text.Templating.Heist
 
-import Database.MongoDB
-import Control.Monad.Trans (liftIO)
+    import Database.MongoDB
+    import Control.Monad.Trans (liftIO)
 
-makeTeamDocument name city = ["name" =: name, "city" =: city]
+    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
+    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
 
-showAs :: (Show a) => Text -> a -> [(Text, Text)]
-showAs name x = [(name, T.pack $ show x)]
+    showAs :: (Show a) => Text -> a -> [(Text, Text)]
+    showAs name x = [(name, T.pack $ show x)]
 
 ### src/Site.hs
 
-{-# LANGUAGE OverloadedStrings #-}
-
-module Site
-( app
-) where
-
-import           Data.ByteString (ByteString)
-import           Data.ByteString.UTF8 (toString)
-
-import           Snap.Core
-import           Snap.Util.FileServe
-
-import           Snap.Snaplet
-import           Snap.Snaplet.Heist
-import           Snap.Snaplet.MongoDB
-
-import           Text.Templating.Heist
-import           Text.XmlHtml hiding (render)
-
-import           Application
-import           Example.Foo
-
-indexView :: Handler App App ()
-indexView = ifTop $ heistLocal (bindSplices indexSplices) $ render "index"
-  where
-    indexSplices =
-        [ ("documents", documentsSplice "test-collection")
-        ]
-
-indexHandler :: Handler App App ()
-indexHandler = insertTeamHandler >> redirect "/"
-
-insertTeamHandler :: Handler App App ()
-insertTeamHandler = do
-    name <- getParamOr "form1-name" (redirect "/")
-    city <- getParamOr "form1-city" (redirect "/")
-    eitherWithDB $ insert "test-collection" $ makeTeamDocument name city
-    return ()
-    where getParamOr param action = getParam param >>= maybe action (return . toString)
-
-routes :: [(ByteString, Handler App App ())]
-routes = [ ("/", method POST indexHandler)
-         , ("/",             indexView)
-         , ("",  with heist heistServe)
-         , ("",  serveDirectory "resources/static")
-         ]
-
-app :: SnapletInit App App
-app = makeSnaplet "app" "An snaplet example application." Nothing $ do
-    h <- nestSnaplet "heist" heist $ heistInit "resources/templates"
-    d <- nestSnaplet "database" database $ mongoDBInit 10 (host "127.0.0.1") "Snaplet-MongoDB"
-    addRoutes routes
-    return $ App h d
-
-And that's it.
+    {-# LANGUAGE OverloadedStrings #-}
+
+    module Site
+    ( app
+    ) where
+
+    import           Data.ByteString (ByteString)
+    import           Data.ByteString.UTF8 (toString)
+
+    import           Snap.Core
+    import           Snap.Util.FileServe
+
+    import           Snap.Snaplet
+    import           Snap.Snaplet.Heist
+    import           Snap.Snaplet.MongoDB
+
+    import           Text.Templating.Heist
+    import           Text.XmlHtml hiding (render)
+
+    import           Application
+    import           Example.Foo
+
+    indexView :: Handler App App ()
+    indexView = ifTop $ heistLocal (bindSplices indexSplices) $ render "index"
+      where
+        indexSplices =
+            [ ("documents", documentsSplice "test-collection")
+            ]
+
+    indexHandler :: Handler App App ()
+    indexHandler = insertTeamHandler >> redirect "/"
+
+    insertTeamHandler :: Handler App App ()
+    insertTeamHandler = do
+        name <- getParamOr "form1-name" (redirect "/")
+        city <- getParamOr "form1-city" (redirect "/")
+        eitherWithDB $ insert "test-collection" $ makeTeamDocument name city
+        return ()
+        where getParamOr param action = getParam param >>= maybe action (return . toString)
+
+    routes :: [(ByteString, Handler App App ())]
+    routes = [ ("/", method POST indexHandler)
+             , ("/",             indexView)
+             , ("",  with heist heistServe)
+             , ("",  serveDirectory "resources/static")
+             ]
+
+    app :: SnapletInit App App
+    app = makeSnaplet "app" "An snaplet example application." Nothing $ do
+        h <- nestSnaplet "heist" heist $ heistInit "resources/templates"
+        d <- nestSnaplet "database" database $ mongoDBInit 10 (host "127.0.0.1") "Snaplet-MongoDB"
+        addRoutes routes
+        return $ App h d
+
+    And that's it.
diff --git a/snaplet-mongodb-minimalistic.cabal b/snaplet-mongodb-minimalistic.cabal
@@ -1,5 +1,5 @@
 name:           snaplet-mongodb-minimalistic
-version:        0.0.1
+version:        0.0.2
 synopsis:       Minimalistic MongoDB Snaplet.
 description:    Minimalistic MongoDB Snaplet.
 license:        BSD3

diff --git a/src/Snap/Snaplet/MongoDB/Core.hs b/src/Snap/Snaplet/MongoDB/Core.hs
@@ -1,29 +1,11 @@
-{-# LANGUAGE OverloadedStrings         #-}
-{-# LANGUAGE FlexibleInstances         #-}
-{-# LANGUAGE ExistentialQuantification #-}
-{-# LANGUAGE MultiParamTypeClasses     #-}
-{-# LANGUAGE FunctionalDependencies    #-}
-{-# LANGUAGE FlexibleContexts          #-}
-{-# LANGUAGE TypeFamilies              #-}
-
 module Snap.Snaplet.MongoDB.Core
 ( MongoDB(..)
 , HasMongoDB(..)
-, mongoDBInit
 ) where
 
-import            Data.Text (Text)
-
-import            Snap
-
 import            Database.MongoDB
 import            System.IO.Pool
 
-------------------------------------------------------------------------------
--- |
-description :: Text
-description = "Minimalistic MongoDB Snaplet"
-
 ------------------------------------------------------------------------------
 -- |
 data MongoDB = MongoDB
@@ -35,10 +17,4 @@ data MongoDB = MongoDB
 -- |
 class HasMongoDB app where
     getMongoDB :: app -> MongoDB
-
-------------------------------------------------------------------------------
--- |
-mongoDBInit :: Int -> Host -> Database -> 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
+
diff --git a/src/Snap/Snaplet/MongoDB/Functions.hs b/src/Snap/Snaplet/MongoDB/Functions.hs
@@ -1,16 +1,19 @@
+{-# LANGUAGE OverloadedStrings     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
 module Snap.Snaplet.MongoDB.Functions
-( eitherWithDB'
+( mongoDBInit
+, eitherWithDB'
 , eitherWithDB
 , maybeWithDB
 , maybeWithDB'
 , unsafeWithDB
 , unsafeWithDB'
 ) where
 
+import            Data.Text (Text)
 import            Control.Monad.Error
 
 import            Snap
@@ -19,6 +22,18 @@ import            Snap.Snaplet.MongoDB.Core
 import            Database.MongoDB
 import            System.IO.Pool
 
+------------------------------------------------------------------------------
+-- |
+description :: Text
+description = "Minimalistic MongoDB Snaplet"
+
+------------------------------------------------------------------------------
+-- |
+mongoDBInit :: Int -> Host -> Database -> 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
+
 class (MonadIO m, MonadState app m, HasMongoDB app) => HasMongoDB' app m
 instance (MonadIO m, MonadState app m, HasMongoDB app) => HasMongoDB' app m
 
@@ -59,4 +74,5 @@ eitherWithDB' mode action = do
     ep <- liftIO $ runErrorT $ aResource pool
     case ep of
          Left  err -> return $ Left $ ConnectionFailure err
-         Right pip -> liftIO $ access pip mode database action
+         Right pip -> liftIO $ access pip mode database action
+