Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added form for paste adding (not working yet :D)

  • Loading branch information...
commit 1b141033f0e9a5d20e2dc3d298983ea85596fa50 1 parent e99af1e
@Palmik authored
View
6 pastie.cabal
@@ -1,5 +1,5 @@
Name: pastie
-Version: 0.1
+Version: 0.2
Synopsis: Project Synopsis Here
Description: Project Description Here
License: AllRightsReserved
@@ -33,6 +33,10 @@ Executable pastie
snap-extension-mongodb,
bson,
compact-string-fix,
+ digestive-functors,
+ digestive-functors-snap,
+ digestive-functors-blaze,
+ blaze-html > 0.3 && < 0.5,
mongoDB
extensions: TypeSynonymInstances MultiParamTypeClasses
View
60 src/Controller/Paste.hs
@@ -1,21 +1,29 @@
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
module Controller.Paste
( recentPastesSplice
-, highlightAsSplice
+, addPasteHandler
) where
import qualified Data.Text as T
import qualified Text.XmlHtml as X
-import Text.XHtml.Strict (renderHtmlFragment)
import Control.Monad.Trans
-import Control.Monad (liftM, liftM2)
-import Data.Maybe
-import Text.Highlighting.Kate
+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 Snap.Types
+import Text.Digestive.Forms.Snap
import Text.Templating.Heist
-import Application
+import Application
+import Model.Utils
import Model.Paste
@@ -26,18 +34,34 @@ pasteParts p = map applyAndPack [ ("title", pasteTitle)
, ("language", pasteLanguage) ]
where applyAndPack (x, f) = (T.pack x, T.pack $ f p)
-highlightAsSplice :: Splice Application
-highlightAsSplice = do
- l <- liftM2 X.getAttribute (return $ T.pack "lang") getParamNode
- c <- liftM (X.nodeText . head . X.childNodes) getParamNode
- case l of
- Nothing -> return [X.TextNode c]
- _ -> case highlightAs (T.unpack $ fromJust l) (T.unpack c) of
- Left _ -> return [X.TextNode c]
- Right h -> return [X.TextNode . T.pack . renderHtmlFragment $ formatAsXHtml [OptNumberLines] (T.unpack $ fromJust l) h]
-
-
recentPastesSplice :: Splice Application
recentPastesSplice = do
ps <- lift getRecentPastesDummy
- 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"
+ 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'
+
+
+
View
6 src/Model/Paste.hs
@@ -9,6 +9,7 @@ module Model.Paste
, getRecentPastes
, getRecentPastesDummy
, pastesTable
+, insertPaste
) where
import Control.Monad (liftM)
@@ -41,4 +42,7 @@ getRecentPastes = liftM fromDocList $ withDB' $ rest =<< (find (select [] "paste
getRecentPastesDummy :: Application [Paste]
getRecentPastesDummy = return $ map (\ n -> paste ("Title " ++ show n) (content ++ ' ':show n) (description ++ ' ':show n) "cpp") [1..15]
where content = "Lorem ipsum dolor sit amet, consectetur adipiscing elit."
- description = "In et felis nulla. Vivamus vitae feugiat nulla."
+ description = "In et felis nulla. Vivamus vitae feugiat nulla."
+
+insertPaste :: Paste -> Application ()
+insertPaste p = withDB' $ insertADT_ "pastes" p
View
2  src/Site.hs
@@ -56,12 +56,12 @@ pastes = ifTop $ heistLocal (bindSplices pastesSplices) $ render "pastes"
where
pastesSplices =
[ ("recent-pastes", recentPastesSplice)
- , ("highlight", highlightAsSplice)
]
------------------------------------------------------------------------------
-- | The main entry point handler.
site :: Application ()
site = route [ ("/", pastes)
+ , ("/add/", addPasteHandler)
]
<|> serveDirectory "resources/static"
Please sign in to comment.
Something went wrong with that request. Please try again.