Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 148 lines (103 sloc) 4.206 kb
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
1 # About
2
2b80100 @Palmik Fixed README formating
authored
3 `snaplet-mongodb-minimalistic` is minimal implementation of Snaplet for MongoDB.
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
4
5 The package follows the [Snaplet Design](http://snapframework.com/docs/tutorials/snaplets-design).
6
7 The package itself is divided into two parts:
8
2b80100 @Palmik Fixed README formating
authored
9 1. `Snap.Snaplet.MongoDB.Core`
10 2. `Snap.Snaplet.MongoDB.Functions`
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
11
2b80100 @Palmik Fixed README formating
authored
12 The `Core` package contains the Snaplet's data type (`MongoDB`) and typeclass (`HasMongoDB`).
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
13
2b80100 @Palmik Fixed README formating
authored
14 The `Functions` package contains the basic functions (initializers and functions for querying the database).
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
15
16 # Examples
17
18 ## Example #1
19
20 We will follow the common Snap project structure.
21
22 ### src/Application.hs
23
24 {-# LANGUAGE TemplateHaskell #-}
25 {-# LANGUAGE MultiParamTypeClasses #-}
26 {-# LANGUAGE TypeSynonymInstances #-}
27
28 module Application where
29
30 import Data.Lens.Template
31 import Data.Lens.Common
32
33 import Snap.Snaplet
34 import Snap.Snaplet.Heist
35 import Snap.Snaplet.MongoDB.Core
36
37 import Control.Category
38 import Prelude hiding ((.))
39
40 data App = App
41 { _heist :: Snaplet (Heist App)
42 , _database :: Snaplet MongoDB
43 }
44
45 type AppHandler = Handler App App
46
47 makeLens ''App
48
49 instance HasHeist App where
50 heistLens = subSnaplet heist
51
52 instance HasMongoDB App where
53 getMongoDB = getL (snapletValue . database)
54
55 ### src/Example/Foo.hs
56
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
57 {-# LANGUAGE OverloadedStrings #-}
58 {-# LANGUAGE ExtendedDefaultRules #-}
59 {-# LANGUAGE NoMonomorphismRestriction #-}
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
60
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
61 module Example.Foo
62 ( makeTeamDocument
63 , documentsSplice
64 , module Database.MongoDB
65 ) where
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
66
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
67 import qualified Data.Text as T
68 import Data.Text (Text)
69 import qualified Data.Text.Encoding as T (decodeUtf8)
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
70
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
71 import Snap
72 import Snap.Snaplet
73 import Snap.Snaplet.MongoDB
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
74
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
75 import Text.Templating.Heist
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
76
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
77 import Database.MongoDB
78 import Control.Monad.Trans (liftIO)
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
79
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
80 makeTeamDocument name city = ["name" =: name, "city" =: city]
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
81
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
82 documentsSplice :: (HasMongoDB m) => Collection -> Splice (Handler m m)
83 documentsSplice collection = do
84 eres <- eitherWithDB $ rest =<< find (select [] collection)
85 res <- return $ either (const []) id eres
86 mapSplices (runChildrenWithText . showAs "document") res
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
87
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
88 showAs :: (Show a) => Text -> a -> [(Text, Text)]
89 showAs name x = [(name, T.pack $ show x)]
805467b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
90
91 ### src/Site.hs
92
2648e7b @Palmik Moved initializers from Core to Functions. Removed unneccessary langu…
authored
93 {-# LANGUAGE OverloadedStrings #-}
94
95 module Site
96 ( app
97 ) where
98
99 import Data.ByteString (ByteString)
100 import Data.ByteString.UTF8 (toString)
101
102 import Snap.Core
103 import Snap.Util.FileServe
104
105 import Snap.Snaplet
106 import Snap.Snaplet.Heist
107 import Snap.Snaplet.MongoDB
108
109 import Text.Templating.Heist
110 import Text.XmlHtml hiding (render)
111
112 import Application
113 import Example.Foo
114
115 indexView :: Handler App App ()
116 indexView = ifTop $ heistLocal (bindSplices indexSplices) $ render "index"
117 where
118 indexSplices =
119 [ ("documents", documentsSplice "test-collection")
120 ]
121
122 indexHandler :: Handler App App ()
123 indexHandler = insertTeamHandler >> redirect "/"
124
125 insertTeamHandler :: Handler App App ()
126 insertTeamHandler = do
127 name <- getParamOr "form1-name" (redirect "/")
128 city <- getParamOr "form1-city" (redirect "/")
129 eitherWithDB $ insert "test-collection" $ makeTeamDocument name city
130 return ()
131 where getParamOr param action = getParam param >>= maybe action (return . toString)
132
133 routes :: [(ByteString, Handler App App ())]
134 routes = [ ("/", method POST indexHandler)
135 , ("/", indexView)
136 , ("", with heist heistServe)
137 , ("", serveDirectory "resources/static")
138 ]
139
140 app :: SnapletInit App App
141 app = makeSnaplet "app" "An snaplet example application." Nothing $ do
142 h <- nestSnaplet "heist" heist $ heistInit "resources/templates"
143 d <- nestSnaplet "database" database $ mongoDBInit 10 (host "127.0.0.1") "Snaplet-MongoDB"
144 addRoutes routes
145 return $ App h d
146
ce75c9b @Palmik Fixed README formating
authored
147 And that's it.
Something went wrong with that request. Please try again.