The form should be now working properly

Palmik · Mar 27, 2011 · daecd6d · daecd6d
1 parent 639facd
commit daecd6d
Show file tree

Hide file tree

Showing 6 changed files with 25 additions and 60 deletions.
diff --git a/resources/templates/add-paste-form.tpl b/resources/templates/add-paste-form.tpl
@@ -0,0 +1,8 @@
+<form method="post">
+    <ul>
+        <li><input type="text" name="title"/></li>
+        <li><textarea rows="15" cols="60" name="code"></textarea></li>
+        <li><textarea rows="5" cols="60" name="description"></textarea></li>
+        <li><input type="submit" value="Paste!"/></li>
+    </ul>
+</form>
diff --git a/resources/templates/pastes.tpl b/resources/templates/pastes.tpl
@@ -4,6 +4,7 @@
   </head>
   <body>
     <div id="recent-pastes">
+        <apply template="add-paste-form"/>
         <recent-pastes>
             <apply template="full-paste">
                 <bind tag="title"><title/></bind>

diff --git a/src/Controller/Paste.hs b/src/Controller/Paste.hs
@@ -8,15 +8,12 @@ module Controller.Paste
 ) where
 
 import qualified Data.Text    as T
+import qualified Data.Text.Encoding as T (decodeUtf8)
 import qualified Text.XmlHtml as X
 import           Control.Monad.Trans
-import           Control.Applicative ((<$>), (<*>))
+import           Control.Monad (mzero)
-import           Text.Digestive.Blaze.Html5
+import qualified Data.ByteString.Char8 as BS (unpack)
-import           Text.Digestive
+import           Debug.Trace (trace)
-import           Text.Blaze (Html, (!))
-import qualified Text.Blaze.Html5 as H
-import qualified Text.Blaze.Html5.Attributes as A
-import           Text.Blaze.Renderer.Utf8 (renderHtml)
 
 import           Snap.Types
 import           Text.Digestive.Forms.Snap
@@ -36,32 +33,17 @@ pasteParts p = map applyAndPack [ ("title", pasteTitle)
 
 recentPastesSplice :: Splice Application
 recentPastesSplice = do
-     ps <- lift getRecentPastesDummy
+    ps <- lift getRecentPastes
-     mapSplices (runChildrenWithText . pasteParts) ps
+    mapSplices (runChildrenWithText . pasteParts) ps
-
-addPasteForm :: SnapForm Html BlazeFormHtml Paste
-addPasteForm = paste
-    <$> label "Title: " ++> inputText (Just "Title")
-    <*> label "Code: " ++> inputTextArea (Just 10) (Just 20) (Just "Code")
-    <*> label "Description: " ++> inputTextArea (Just 5) (Just 20) (Just "Description")
-    <*> label "Language: " ++> inputText (Just "Language")
-
-blaze :: Html -> Application ()
-blaze response = do
-    modifyResponse $ addHeader "Content-Type" "text/html; charset=UTF-8"
-    writeLBS $ renderHtml response
 
 addPasteHandler :: Application ()
 addPasteHandler = do
-    r <- eitherSnapForm addPasteForm "add-paste-form"
+    t <- getParam "title" >>= maybe (redirect "/") (return . T.unpack . T.decodeUtf8)
-    case r of
+    c <- getParam "code" >>= maybe (redirect "/") (return . T.unpack . T.decodeUtf8)
-        Left form' -> blaze $ do
+    d <- getParam "description" >>= maybe (redirect "/") (return . T.unpack . T.decodeUtf8)
-            let (fhtml, enctype) = renderFormHtml form'
+    l <- return "cpp"
-            H.form ! A.enctype (H.stringValue $ show enctype)
+    if (not $ any null [t, c, d, l]) then insertPaste $ paste t c d l else return ()
-                   ! A.method "POST" ! A.action "/" $ do
+    redirect "/"
-                fhtml
-                H.input ! A.type_ "submit" ! A.value "Submit"
-        Right paste' -> insertPaste paste'
 
 
 
diff --git a/src/Main.hs b/src/Main.hs
@@ -62,4 +62,4 @@ main = do
     quickHttpServe snap
 #else
 main = quickHttpServe applicationInitializer site
-#endif
+#endif
diff --git a/src/Model/Paste.hs b/src/Model/Paste.hs
@@ -37,7 +37,7 @@ paste :: String -> String -> String -> String -> Paste
 paste t c d l = Paste (RecKey Nothing) t c d l
 
 getRecentPastes :: Application [Paste]
-getRecentPastes = liftM fromDocList $ withDB' $ rest =<< (find (select [] "pastes"))
+getRecentPastes = liftM fromDocList $ withDB' $ rest =<< (find (select [] "pastes") {sort = ["$natural" =: (-1 :: Int)]})
 
 getRecentPastesDummy :: Application [Paste]
 getRecentPastesDummy = return $ map (\ n -> paste ("Title " ++ show n) (content ++ ' ':show n) (description ++ ' ':show n) "cpp") [1..15]

diff --git a/src/Site.hs b/src/Site.hs
@@ -23,32 +23,6 @@ import           Text.Templating.Heist
 import           Application
 import           Controller.Paste
 
-
-------------------------------------------------------------------------------
--- | Renders the front page of the sample site.
---
--- The 'ifTop' is required to limit this to the top of a route.
--- Otherwise, the way the route table is currently set up, this action
--- would be given every request.
-index :: Application ()
-index = ifTop $ heistLocal (bindSplices indexSplices) $ render "index"
-  where
-    indexSplices =
-        [ ("start-time",   startTimeSplice)
-        , ("current-time", currentTimeSplice)
-        ]
-
-
-------------------------------------------------------------------------------
--- | Renders the echo page.
-echo :: Application ()
-echo = do
-    message <- decodedParam "stuff"
-    heistLocal (bindString "message" (T.decodeUtf8 message)) $ render "echo"
-  where
-    decodedParam p = fromMaybe "" <$> getParam p
-
-
 ------------------------------------------------------------------------------
 -- | Render recent pastes
 pastes :: Application ()
@@ -61,7 +35,7 @@ pastes = ifTop $ heistLocal (bindSplices pastesSplices) $ render "pastes"
 ------------------------------------------------------------------------------
 -- | The main entry point handler.
 site :: Application ()
-site = route [ ("/",      pastes)
+site = route [ ("/",      methods [GET, HEAD] pastes)
-             , ("/add/",  addPasteHandler)
+             , ("/",      method  POST        addPasteHandler)
              ]
        <|> serveDirectory "resources/static"