Changed the single paste handler a bit

Palmik · May 10, 2011 · 14dde63 · 14dde63
1 parent 1946630
commit 14dde63
Show file tree

Hide file tree

Showing 4 changed files with 50 additions and 12 deletions.
diff --git a/TUTORIAL.md b/TUTORIAL.md
@@ -66,14 +66,18 @@ In Snap & Heist terms, the view consists of the Heist templates where we call th
 
 It's really easy! Just download [the binary](http://www.mongodb.org/downloads) for your system and fire up the `mongod` daemon, that's it, you are set to go.
 
-### Setting up the Heist Extension
+### Installing the Extensions
+
+In this section we will install the extensions we use in snap-pastie.
+
+#### Setting up the Heist Extension
 
 *Working file: [Application.hs](src/Application.hs)*
 
 One of the strengths of Snap is its modularity and Heist is a proof of that.
 Heist is just an extension, meaning you could use templating engine or your choice (if such thing crossed your mind, it probably will not ever again after you learn more about Heist) or none at all, yet it seamlessly blends with Snap.
 
-### Setting up the MongoDB Extension
+#### Setting up the MongoDB Extension
 
 *Working file: [Application.hs](src/Application.hs)*
 
@@ -105,4 +109,7 @@ And finally call the extension's initializer in the application's initializer:
 
     database <- mongoDBInitializer (Host "127.0.0.1" $ PortNumber 27017) 1 "pastie"
 
-That line tells the MongoDB extension, that the database server is hosted on `127.0.0.1` and listening on port `27017` (which is the standard one)
+That line tells the MongoDB extension, that the database server is hosted on `127.0.0.1` and listening on port `27017` (which is the standard one)
+
+### Making the Model
+
diff --git a/src/Controller/Paste.hs b/src/Controller/Paste.hs
@@ -41,9 +41,8 @@ pasteParts paste = map applyAndPack [ ("title", pasteTitle)
           pasteLink p = maybe "#" id $ pasteIDText p
 
 
-singlePasteSplice :: Maybe ObjectId -> Splice Application
-singlePasteSplice Nothing    = textSplice "There is no such paste."
-singlePasteSplice (Just pid) = do
+singlePasteSplice :: ObjectId -> Splice Application
+singlePasteSplice pid = do
     mp <- lift $ getPaste pid
     case mp of
          Nothing -> textSplice "There is no such paste"

diff --git a/src/Model/Utils.hs b/src/Model/Utils.hs
@@ -2,13 +2,21 @@
 
 module Model.Utils
     ( fromDocList
+    , toDocList
+    --
     , insertADT
     , insertADT_
     , insertManyADT
     , insertManyADT_
+    --
+    , saveADT
+    , replaceADT
+    , repsertADT
+    --
     , restADT
     , nextNADT
     , nextADT
+    , groupADT
     ) where
 
 import           Data.Maybe
@@ -19,6 +27,11 @@ import           Snap.Extension.DB.MongoDB.Generics
 fromDocList :: (Regular a, FromDoc (PF a)) => [Document] -> [a]
 fromDocList = catMaybes . map fromDoc
 
+toDocList :: (Regular a, ToDoc (PF a)) => [a] -> [Document]
+toDocList = map toDoc
+
+-- Insert
+
 insertADT :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> a -> m Value
 insertADT c = insert c . toDoc
 
@@ -31,6 +44,19 @@ insertManyADT c = insertMany c . map toDoc
 insertManyADT_ :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> [a] -> m ()
 insertManyADT_ c adts = insertManyADT c adts >> return ()
 
+-- Update
+
+saveADT :: (Regular a, ToDoc (PF a), DbAccess m) => Collection -> a -> m ()
+saveADT c adt = save c $ toDoc adt
+
+replaceADT :: (Regular a, ToDoc (PF a), DbAccess m) => Selection -> a -> m () -- perhaps replaceWithADT would be better?
+replaceADT s adt = replace s $ toDoc adt
+
+repsertADT :: (Regular a, ToDoc (PF a), DbAccess m) => Selection -> a -> m () -- perhaps replaceWithADT would be better?
+repsertADT s adt = repsert s $ toDoc adt
+
+--
+
 restADT :: (Regular a, FromDoc (PF a), DbAccess m) => Cursor -> m [a]
 restADT c = rest c >>= return . fromDocList
 
@@ -39,3 +65,8 @@ nextNADT n c = nextN n c >>= return . fromDocList
 
 nextADT :: (Regular a, FromDoc (PF a), DbAccess m) => Cursor -> m (Maybe a)
 nextADT c = next c >>= return . (maybe Nothing fromDoc)
+
+groupADT :: (Regular a, FromDoc (PF a), DbAccess m) => Group -> m [a]
+groupADT g = group g >>= return . fromDocList
+
+
diff --git a/src/Site.hs b/src/Site.hs
@@ -50,14 +50,15 @@ pastes = ifTop $ heistLocal (bindSplices pastesSplices) $ render "pastes"
 -- | Render single paste
 paste :: Application ()
 paste = do
-    oid <- liftM bs2objid $ decodedParam "oid"    
-    let pasteSplices = [ ("single-paste",       singlePasteSplice oid)
-                       , ("possible-languages", possibleLanguagesSplice)
-                       ]
-    ifTop $ heistLocal (bindSplices pasteSplices) $ render "paste"
+    oid <- liftM bs2objid $ decodedParam "oid"
+    maybe pass okPaste oid
     where
       decodedParam p = fromMaybe "" <$> getParam p
-
+      okPaste oid'   = ifTop $ heistLocal (bindSplices pasteSplices) $ render "paste"
+        where
+          pasteSplices = [ ("single-paste",       singlePasteSplice oid')
+                         , ("possible-languages", possibleLanguagesSplice)
+                         ]
 
 ------------------------------------------------------------------------------
 -- | The main entry point handler.