Last active
December 18, 2015 11:49
-
-
Save xkikeg/5778161 to your computer and use it in GitHub Desktop.
Yesod Book :: Sessions :: session messages
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# LANGUAGE OverloadedStrings, TypeFamilies, TemplateHaskell, | |
| QuasiQuotes, MultiParamTypeClasses #-} | |
| import Yesod | |
| data Messages = Messages | |
| mkYesod "Messages" [parseRoutes| | |
| / RootR GET | |
| /set-message SetMessageR POST | |
| |] | |
| instance Yesod Messages where | |
| defaultLayout widget = do | |
| pc <- widgetToPageContent widget | |
| mmsg <- getMessage | |
| giveUrlRenderer [hamlet| | |
| $doctype 5 | |
| <html> | |
| <head> | |
| <title>#{pageTitle pc} | |
| ^{pageHead pc} | |
| <body> | |
| $maybe msg <- mmsg | |
| <p>Your message was: #{msg} | |
| ^{pageBody pc} | |
| |] | |
| instance RenderMessage Messages FormMessage where | |
| renderMessage _ _ = defaultFormMessage | |
| getRootR :: Handler Html | |
| getRootR = defaultLayout [whamlet| | |
| <form method=post action=@{SetMessageR}> | |
| My message is: # | |
| <input type=text name=message> | |
| <input type=submit> | |
| |] | |
| postSetMessageR :: Handler () | |
| postSetMessageR = do | |
| msg <- runInputPost $ ireq textField "message" | |
| setMessage $ toHtml msg | |
| redirect RootR | |
| main :: IO () | |
| main = warp 3000 Messages |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment