Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

The form should be now working properly

  • Loading branch information...
commit daecd6de527e41898fb968414c62b5600cf94a69 1 parent 639facd
@Palmik authored
View
8 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>
View
1  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>
View
42 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 Text.Digestive.Blaze.Html5
-import Text.Digestive
-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 Control.Monad (mzero)
+import qualified Data.ByteString.Char8 as BS (unpack)
+import Debug.Trace (trace)
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
- 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
+ ps <- lift getRecentPastes
+ mapSplices (runChildrenWithText . pasteParts) ps
addPasteHandler :: Application ()
addPasteHandler = do
- r <- eitherSnapForm addPasteForm "add-paste-form"
- case r of
- Left form' -> blaze $ do
- let (fhtml, enctype) = renderFormHtml form'
- H.form ! A.enctype (H.stringValue $ show enctype)
- ! A.method "POST" ! A.action "/" $ do
- fhtml
- H.input ! A.type_ "submit" ! A.value "Submit"
- Right paste' -> insertPaste paste'
+ t <- getParam "title" >>= maybe (redirect "/") (return . T.unpack . T.decodeUtf8)
+ c <- getParam "code" >>= maybe (redirect "/") (return . T.unpack . T.decodeUtf8)
+ d <- getParam "description" >>= maybe (redirect "/") (return . T.unpack . T.decodeUtf8)
+ l <- return "cpp"
+ if (not $ any null [t, c, d, l]) then insertPaste $ paste t c d l else return ()
+ redirect "/"
View
2  src/Main.hs
@@ -62,4 +62,4 @@ main = do
quickHttpServe snap
#else
main = quickHttpServe applicationInitializer site
-#endif
+#endif
View
2  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]
View
30 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)
- , ("/add/", addPasteHandler)
+site = route [ ("/", methods [GET, HEAD] pastes)
+ , ("/", method POST addPasteHandler)
]
<|> serveDirectory "resources/static"
Please sign in to comment.
Something went wrong with that request. Please try again.