| By | Chris Done |
| At | 2011-06-04 |
| Title | Paste form. |
| Description |
Edit file amelie.cabal 33188 → 33188
11 11 Build-type: Simple
12 12 Cabal-version: >=1.2
13 13 14 14 Executable amelie
15 15 Main-is: Main.hs
- 16 Ghc-options: -threaded -O2
+ 16 Ghc-options: -threaded -O0
17 17 Hs-source-dirs: src
18 18 Build-depends: base >= 4 && < 5
19 19 ,snap-server >= 0.4 && < 0.5
20 20 ,snap-core >= 0.4 && < 0.5
21 21 ,text >= 0.11 && < 0.12
… … … … Remove file src/Amelie/View/Forms.hs 33188
- 1 {-# OPTIONS -Wall #-} - 2 {-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleInstances #-} - 3 {-# LANGUAGE TupleSections #-} - 4 {-# OPTIONS -fno-warn-name-shadowing #-} - 5 - 6 -- | Forms used throughout. - 7 - 8 module Amelie.View.Forms where - 9 - 10 import Amelie.Types - 11 - 12 import Control.Applicative - 13 import Control.Monad.Error - 14 import Data.Either.Extra - 15 import Data.Maybe - 16 import Prelude hiding ((++)) - 17 import Snap.Types - 18 import Text.Blaze.Html5 as H - 19 import qualified Text.Blaze.Html5.Attributes as A - 20 import Text.Blaze.Html5.Extra - 21 import Text.Formlet - 22 - 23 pasteForm :: Snap (Html,Maybe Paste) - 24 pasteForm = do - 25 params <- getParams - 26 let value = formletValue formlet params - 27 submitted <- isJust <$> getParam "submit" - 28 let form = postForm $ do - 29 formletHtml formlet params - 30 submitInput "submit" "Submit" - 31 when submitted $ whenLeft value (mapM_ (p . toHtml)) - 32 return (form,either (const Nothing) Just $ value) - 33 - 34 where formlet = Paste <$> req (textInput "title" "Title") - 35 <*> req (textInput "author" "Author") - 36 <*> opt (dropInput "language" "Language") - 37 <*> opt (dropInput "channel" "Channel") - 38 <*> req (areaInput "paste" "Paste") Edit file src/Amelie/View/Home.hs 33188 → 33188
- 1 {-# OPTIONS -Wall #-}+ 1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-}2 2 {-# LANGUAGE OverloadedStrings #-}3 3 {-# LANGUAGE RecordWildCards #-}4 4 5 5 -- | Home page view.
6 6 … … … … 16 16 import Data.Time.Show (showDateTime)
17 17 import Text.Blaze.Html5 as H hiding (map)
18 18 import qualified Text.Blaze.Html5.Attributes as A
19 19 20 20 -- | Render the home page.
- 21 page :: [Paste] -> Html
- 22 page ps =
+ 21 page :: [Paste] -> Html -> Html
+ 22 page ps form =
23 23 layoutPage $ Page {24 24 pageTitle = "λ Knights!"
- 25 , pageBody = latest ps
+ 25 , pageBody = content ps form
26 26 }
+ 27 + 28 -- | Render the home page body.
+ 29 content :: [Paste] -> Html -> Html
+ 30 content ps form = do
+ 31 createNew form
+ 32 latest ps
+ 33 + 34 createNew :: Html -> Html
+ 35 createNew form = do
+ 36 H.div ! aClasses ["section","section-light"] $ do
+ 37 h2 "Create new paste"
+ 38 form
27 39 28 40 -- | View the latest pastes.
29 41 latest :: [Paste] -> Html
30 42 latest ps = do
31 43 H.div ! aClasses ["section","section-dark"] $ do
… … … … Edit file src/Amelie/View/Layout.hs 33188 → 33188
7 7 module Amelie.View.Layout
8 8 (layoutPage)
9 9 where
10 10 11 11 import Amelie.Types
+ 12 import Amelie.View.Html
12 13 13 14 import Text.Blaze.Html5 as H hiding (map)
14 15 import qualified Text.Blaze.Html5.Attributes as A
15 16 16 17 -- | Render the page in a layout.
… … … … 27 28 pageBody
28 29 29 30 -- | Show the hpaste logo.
30 31 logo :: Html
31 32 logo = do
- 32 img ! A.src "/css/hpaste.png"
+ 33 img ! aClass "logo" ! A.src "/css/hpaste.png"
33 34 34 35 -- | Layout wrapper.
35 36 wrap :: Html -> Html
- 36 wrap x = H.div ! A.class_ "amelie-wrap" $ x
+ 37 wrap x = H.div ! aClass "wrap" $ x
… … … … Edit file src/Amelie/View/Style.hs 33188 → 33188
17 17 style = renderCSS $ runCSS $ do
18 18 rule "body" $ do
19 19 fontFamily "'DejaVu Sans', sans-serif"
20 20 fontSize "13px"
21 21 textAlign "center"
+ 22 + 23 classRule "logo" $ do
+ 24 margin "0 0 1em 0"
22 25 23 26 classRule "wrap" $ do
24 27 maxWidth "50em"
25 28 margin "auto"
26 29 textAlign "left"
27 30 28 31 classRule "section" $ do
29 32 borderRadius "5px"
30 33 padding "10px"
31 34 border "3px solid #000"
+ 35 margin "0 0 1em 0"
32 36 33 37 subRule "h2" $ do
34 38 margin "0"
35 39 fontSize "1em"
36 40 padding "0 0 0.5em 0"
… … … … 49 53 50 54 subRule "a:hover" $ do
51 55 textDecoration "underline"
52 56 53 57 classRule "section-light" $ do
- 54 background "#453D5B"
- 55 borderColor "#A9A0D2"
- 56 color "#FFF"
+ 58 background "#FFF"
+ 59 borderColor "#EEE"
+ 60 color "#000"
57 61 58 62 subRule "h2" $ do
59 63 color "#2D2542"
60 64 61 65 -- | A short-hand for prefixing rules with ‘.amelie-’.
… … … … Edit file src/Amelie/Types/Paste.hs 33188 → 33188
4 4 {-# LANGUAGE OverloadedStrings #-}5 5 6 6 -- | The paste type.
7 7 8 8 module Amelie.Types.Paste
- 9 (Paste(..))
+ 9 (Paste(..)
+ 10 ,PasteSubmit(..))
10 11 where
11 12 12 13 import Data.Text (Text,pack)
13 14 import Data.Time (UTCTime,zonedTimeToUTC)
14 15 import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
… … … … 20 21 ,pasteDate :: UTCTime
21 22 ,pasteAuthor :: Text
22 23 ,pasteLanguage :: Maybe Text
23 24 ,pasteChannel :: Maybe Text
24 25 ,pastePaste :: Text
+ 26 } deriving Show
+ 27 + 28 -- | A paste submission or edit.
+ 29 data PasteSubmit = PasteSubmit {+ 30 pasteSubmitTitle :: Text
+ 31 ,pasteSubmitAuthor :: Text
+ 32 ,pasteSubmitLanguage :: Maybe Text
+ 33 ,pasteSubmitChannel :: Maybe Text
+ 34 ,pasteSubmitPaste :: Text
25 35 } deriving Show
26 36 27 37 instance ToHtml Paste where
28 38 toHtml paste@Paste{..} = toHtml $ pack $ show paste29 39 … … … … Edit file src/Amelie/Model/Paste.hs 33188 → 33188
12 12 13 13 getLatestPastes :: Model [Paste]
14 14 getLatestPastes = queryNoParams ["SELECT created,title,author,language,channel,content"
15 15 ,"FROM toplevel_paste"
16 16 ,"ORDER BY id DESC"
- 17 ,"LIMIT 10"]
+ 17 ,"LIMIT 20"]
… … … … Edit file src/Amelie/Controller/Home.hs 33188 → 33188
5 5 6 6 module Amelie.Controller.Home
7 7 (handle)
8 8 where
9 9 - 10 import Amelie.Controller (output)
+ 10 import Amelie.Controller (output)
+ 11 import Amelie.Controller.Paste (pasteForm)
11 12 import Amelie.Model
- 12 import Amelie.Model.Home (getPastes)
- 13 import Amelie.View.Home (page)
+ 13 import Amelie.Model.Home (getPastes)
+ 14 import Amelie.View.Home (page)
14 15 15 16 handle :: Controller ()
16 17 handle = do
17 18 pastes <- model $ getPastes
- 18 output $ page pastes
+ 19 form <- pasteForm
+ 20 output $ page pastes form
… … … … Add file src/Amelie/View/Paste.hs 33188
+ 1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-} + 2 {-# LANGUAGE OverloadedStrings #-} + 3 {-# LANGUAGE RecordWildCards #-} + 4 + 5 -- | Paste views. + 6 + 7 module Amelie.View.Paste + 8 (pasteFormlet) + 9 where + 10 + 11 import Amelie.Types + 12 + 13 import Control.Applicative ((<$>),(<*>)) + 14 import Control.Monad (when) + 15 import Snap.Types (Params) + 16 import Text.Blaze.Html5 as H + 17 import Text.Blaze.Html5.Extra + 18 import Text.Formlet + 19 import Data.Text (Text) + 20 + 21 -- | A formlet for paste submission / editing. + 22 pasteFormlet :: Params -> Bool -> [Text] -> (Formlet PasteSubmit,Html) + 23 pasteFormlet params submitted errors = + 24 let form = postForm $ do + 25 formletHtml formlet params + 26 submitInput "submit" "Submit" + 27 when submitted $ + 28 when (not (null errors)) $ + 29 mapM_ (p . toHtml) errors + 30 in (formlet,form) + 31 + 32 where formlet = + 33 PasteSubmit <$> req (textInput "title" "Title") + 34 <*> req (textInput "author" "Author") + 35 <*> opt (dropInput "language" "Language") + 36 <*> opt (dropInput "channel" "Channel") + 37 <*> req (areaInput "paste" "Paste") Add file src/Amelie/Controller/Paste.hs 33188
+ 1 {-# OPTIONS -Wall -fno-warn-name-shadowing #-} + 2 {-# LANGUAGE OverloadedStrings #-} + 3 + 4 -- | Paste controller. + 5 + 6 module Amelie.Controller.Paste + 7 (pasteForm) + 8 where + 9 + 10 import Amelie.Types + 11 + 12 import Amelie.View.Paste (pasteFormlet) + 13 + 14 import Control.Applicative + 15 import Control.Monad.Error + 16 import Data.Maybe + 17 import Prelude hiding ((++)) + 18 import Snap.Types + 19 import Text.Blaze.Html5 as H + 20 import Text.Formlet + 21 + 22 -- | Control paste editing / submission. + 23 pasteForm :: Controller Html + 24 pasteForm = do + 25 params <- getParams + 26 submitted <- isJust <$> getParam "submit" + 27 let (getValue,html) = pasteFormlet params submitted [] + 28 value = formletValue getValue params + 29 val = either (const Nothing) Just $ value + 30 return html