Permalink
Browse files

Added example project.

  • Loading branch information...
1 parent 810143d commit 51f057aa8415789acdaec183bab2529efa4555de @Palmik committed Jan 18, 2012
View
150 README.md
@@ -11,153 +11,9 @@ The package itself is divided into two parts:
1. `Snap.Snaplet.MongoDB.Functions.S`
2. `Snap.Snaplet.MongoDB.Functions.M`
-## Core
-
-The `Snap.Snaplet.MongoDB.Core` package contains:
- * The Snaplet's data type (`MongoDB`).
- * The type class (`HasMongoDB`).
- * The initializer (`mongoDBInit`).
-
-The `MongoDB` data type instances hold connection pool and database name.
-
-The `HasMongoDB` type class is to be used when you inted to have only one database in your application, more on this later.
-
-## Functions
-
-As I have already said,
-
-The `Functions` package contains the basic functions (initializers and functions for querying the database).
+For details check-out the [documentation](http://palmik.github.com/snaplet-mongodb-minimalistic/)
+(alternatively on [hackage](http://hackage.haskell.org/package/snaplet-mongodb-minimalistic) -- not neccessary up to date).
# Examples
-## Example #1
-
-We will follow the common Snap project structure.
-
-### src/Application.hs
-
- {-# LANGUAGE TemplateHaskell #-}
- {-# LANGUAGE MultiParamTypeClasses #-}
- {-# LANGUAGE TypeSynonymInstances #-}
-
- module Application where
-
- import Data.Lens.Template
- import Data.Lens.Common
-
- import Snap.Snaplet
- import Snap.Snaplet.Heist
- import Snap.Snaplet.MongoDB.Core
-
- -- We want (.) from Control.Category.
- import Control.Category ((.))
- import Prelude hiding ((.))
-
- data App = App
- { _heist :: Snaplet (Heist App)
- , _database :: Snaplet MongoDB
- }
-
- type AppHandler = Handler App App
-
- makeLens ''App
-
- instance HasHeist App where
- heistLens = subSnaplet heist
-
- instance HasMongoDB App where
- getMongoDB = getL (snapletValue . database)
-
-### src/Example/Foo.hs
-
- {-# LANGUAGE OverloadedStrings #-}
- {-# LANGUAGE ExtendedDefaultRules #-}
- {-# LANGUAGE NoMonomorphismRestriction #-}
-
- 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 Snap
- import Snap.Snaplet
- import Snap.Snaplet.MongoDB
-
- import Text.Templating.Heist
-
- 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
-
- 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.
+Check out the examples subdirectory.
View
27 examples/example1/LICENSE
@@ -0,0 +1,27 @@
+Copyright (c) 2009, Snap Framework authors (see CONTRIBUTORS)
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+Redistributions of source code must retain the above copyright notice, this
+list of conditions and the following disclaimer.
+
+Redistributions in binary form must reproduce the above copyright notice, this
+list of conditions and the following disclaimer in the documentation and/or
+other materials provided with the distribution.
+
+Neither the name of the Snap Framework authors nor the names of its
+contributors may be used to endorse or promote products derived from this
+software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
View
54 examples/example1/example1.cabal
@@ -0,0 +1,54 @@
+name: snaplet-mongodb-minimalistic-example1
+version: 0.0.1
+synopsis: Simple Example.
+description: Simple Example.
+license: BSD3
+license-file: LICENSE
+author: Petr Pilař
+maintainer: jondoe@example.com
+build-type: Simple
+cabal-version: >= 1.6
+homepage: example.com
+category: Web
+
+Flag development
+ Description: Whether to build the server in development (interpreted) mode
+ Default: False
+
+Executable snaplet-mongodb-minimalistic-example1
+ hs-source-dirs: src
+ main-is: Main.hs
+
+ Build-depends:
+ base >= 4 && < 5,
+ bytestring >= 0.9.1 && < 0.10,
+ data-lens >= 2.0.1 && < 2.1,
+ data-lens-template >= 2.1 && < 2.2,
+ heist >= 0.7 && < 0.8,
+ mtl >= 2 && < 3,
+ snap == 0.7.*,
+ snap-core == 0.7.*,
+ snap-server == 0.7.*,
+ text >= 0.11 && < 0.12,
+ xmlhtml == 0.1.*,
+ snaplet-mongodb-minimalistic,
+ mongoDB,
+ utf8-string
+
+ if flag(development)
+ cpp-options: -DDEVELOPMENT
+ -- In development mode, speed is already going to suffer, so skip
+ -- the fancy optimization flags. Additionally, disable all
+ -- warnings. The hint library doesn't give an option to execute
+ -- compiled code when there were also warnings, so disabling
+ -- warnings allows quicker workflow.
+ ghc-options: -threaded -w
+ else
+ if impl(ghc >= 6.12.0)
+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
+ -fno-warn-orphans -fno-warn-unused-do-bind
+ else
+ ghc-options: -threaded -Wall -fwarn-tabs -funbox-strict-fields -O2
+ -fno-warn-orphans
+
+
View
0 examples/example1/log/access.log
No changes.
View
0 examples/example1/log/error.log
No changes.
View
26 examples/example1/resources/static/screen.css
@@ -0,0 +1,26 @@
+html {
+ padding: 0;
+ margin: 0;
+ background-color: #ffffff;
+ font-family: Verdana, Helvetica, sans-serif;
+}
+body {
+ padding: 0;
+ margin: 0;
+}
+a {
+ text-decoration: underline;
+}
+a :hover {
+ cursor: pointer;
+ text-decoration: underline;
+}
+img {
+ border: none;
+}
+#content {
+ padding-left: 1em;
+}
+#info {
+ font-size: 60%;
+}
View
19 examples/example1/resources/templates/index.tpl
@@ -0,0 +1,19 @@
+<html>
+ <head>
+ <title>Snap web server</title>
+ <link rel="stylesheet" type="text/css" href="/screen.css"/>
+ </head>
+ <body>
+ <form method="post">
+ <input type="text" name="form1-name" />
+ <input type="text" name="form1-city" />
+ <input type="submit" value="Submit"/>
+ </form>
+
+ <ul>
+ <documents>
+ <li><document/></li>
+ </documents>
+ </ul>
+ </body>
+</html>
View
31 examples/example1/src/Application.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+
+module Application where
+
+import Data.Lens.Template
+import Data.Lens.Common
+
+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
+
+instance HasHeist App where
+ heistLens = subSnaplet heist
+
+instance HasMongoDB App where
+ getMongoDB = getL (snapletValue . database)
+
View
33 examples/example1/src/Example/Foo.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+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 Snap
+import Snap.Snaplet
+import Snap.Snaplet.MongoDB
+
+import Text.Templating.Heist
+
+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
+
+showAs :: (Show a) => Text -> a -> [(Text, Text)]
+showAs name x = [(name, T.pack $ show x)]
View
56 examples/example1/src/Main.hs
@@ -0,0 +1,56 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Main where
+
+import Control.Exception (SomeException, try)
+
+import qualified Data.Text as T
+
+import Snap.Http.Server
+import Snap.Snaplet
+import Snap.Core
+
+import Application
+
+import System.IO
+
+import Site
+
+#ifdef DEVELOPMENT
+import Snap.Loader.Devel
+#else
+import Snap.Loader.Prod
+#endif
+
+main :: IO ()
+main = do
+ (conf, site, cleanup) <- $(loadSnapTH [| getConf |]
+ 'getActions
+ ["resources/templates"])
+
+ _ <- try $ httpServe conf $ site :: IO (Either SomeException ())
+ cleanup
+
+getConf :: IO (Config Snap ())
+getConf = commandLineConfig defaultConfig
+
+
+-- | This function generates the the site handler and cleanup action
+-- from the configuration. In production mode, this action is only
+-- run once. In development mode, this action is run whenever the
+-- application is reloaded.
+--
+-- Development mode also makes sure that the cleanup actions are run
+-- appropriately before shutdown. The cleanup action returned from
+-- loadSnapTH should still be used after the server has stopped
+-- handling requests, as the cleanup actions are only automatically
+-- run when a reload is triggered.
+--
+-- This sample doesn't actually use the config passed in, but more
+-- sophisticated code might.
+getActions :: Config Snap () -> IO (Snap (), IO ())
+getActions _ = do
+ (msgs, site, cleanup) <- runSnaplet app
+ hPutStrLn stderr $ T.unpack msgs
+ return (site, cleanup)
View
58 examples/example1/src/Site.hs
@@ -0,0 +1,58 @@
+{-# 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
+
+
+

0 comments on commit 51f057a

Please sign in to comment.