Skip to content
Browse files

more, yesod

  • Loading branch information...
1 parent 3784d5d commit 459f0307369b9af265c02ea8690e11a82c85345d @astro astro committed Aug 29, 2012
Showing with 118 additions and 1 deletion.
  1. +9 −1 index.html
  2. +81 −0 yesod-example/Application.hs
  3. +9 −0 yesod-example/default-layout.hamlet
  4. +19 −0 yesod-example/main.hs
View
10 index.html
@@ -49,6 +49,8 @@
<p>Chaos Computer Club Dresden</p>
<p>2012-08-29</p>
<p class="note">Genesis: 1990</p>
+ <p class="note">Most Advanced Flow Control</p>
+ <p class="note">Academic Reputation</p>
</div>
<div class="slide">
@@ -267,7 +269,9 @@
Prelude> :t meinInteger
meinInteger :: MeinTyp -> Integer
Prelude> meinInteger fnord
-23</div>
+23</pre>
+ <p class="note">Parameterisierte Typen!</p>
+</div>
<!-- Classes, instances -->
<div class="slide">
<h1>Classes &amp; Instances</h1>
@@ -1415,6 +1419,10 @@
<a href="http://www.yesodweb.com/blog/2011/03/preliminary-warp-cross-language-benchmarks">www.yesodweb.com/blog/2011/03/preliminary-warp-cross-language-benchmarks</a>
</p>
</div>
+<div class="slide">
+ <h1>Yesod</h1>
+ <p>Live-Coding!</p>
+</div>
<!--
mtl
lists: monomorph
View
81 yesod-example/Application.hs
@@ -0,0 +1,81 @@
+{-# LANGUAGE TemplateHaskell, QuasiQuotes, MultiParamTypeClasses, TypeFamilies, OverloadedStrings #-}
+module Application where
+
+import Control.Applicative
+import Yesod
+import Yesod.Form.Jquery
+import Text.Hamlet
+import qualified Data.Text as T
+import Control.Concurrent.STM
+
+
+
+app :: IO Application
+app = do
+ dents <- liftIO $ atomically $ newTVar []
+ toWaiAppPlain $ ChatApp dents
+
+
+data Dent = Dent
+ { dentSender :: T.Text
+ , dentBody :: T.Text
+ }
+
+data ChatApp = ChatApp { chatDents :: TVar [Dent] }
+
+getDents = chatDents <$> getYesod
+
+mkYesod "ChatApp" [parseRoutes|
+ / HomeR GET
+ /send SendR POST
+ |]
+
+instance Yesod ChatApp where
+ defaultLayout widget =
+ do pc <- widgetToPageContent widget
+ hamletToRepHtml $(hamletFile "default-layout.hamlet")
+
+instance YesodJquery ChatApp
+
+instance RenderMessage ChatApp FormMessage where
+ renderMessage _ _ = defaultFormMessage
+
+
+getHomeR :: Handler RepHtml
+getHomeR = do
+ (form, enctype) <- generateFormPost dentForm
+ dents <- getDents >>=
+ liftIO . atomically . readTVar
+ defaultLayout $ do
+ setTitle "Welcome to Yitter"
+ [whamlet|
+ <h1>Chat
+ <form method=POST action=@{SendR} enctype=#{enctype}>
+ ^{form}
+ <input type=submit value=Ok>
+ $forall dent <- dents
+ <article>
+ <h2>#{dentSender dent}
+ <p>#{dentBody dent}
+ |]
+
+dentForm = renderDivs $ Dent
+ <$> areq textField "Name: " Nothing
+ <*> areq textField "Body: " Nothing
+
+postSendR :: Handler RepHtml
+postSendR = do
+ ((result, widget), enctype) <- runFormPost dentForm
+ case result of
+ FormSuccess dent -> do
+ dents <- getDents
+ liftIO $ atomically $
+ modifyTVar dents $ (dent :)
+ redirect HomeR
+ _ ->
+ defaultLayout [whamlet|
+ <h1>Oops
+ |]
+
+
+-- TODO: i18n, form validation
View
9 yesod-example/default-layout.hamlet
@@ -0,0 +1,9 @@
+$newline always
+<html>
+ <head>
+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+ <title>#{pageTitle pc}
+ ^{pageHead pc}
+ <body>
+ <div #page>
+ ^{pageBody pc}
View
19 yesod-example/main.hs
@@ -0,0 +1,19 @@
+module Main where
+
+import System.IO
+import Network.Wai.Handler.Warp (runSettings, defaultSettings,
+ settingsHost, settingsPort, settingsOnException)
+import Data.Conduit.Network (HostPreference (HostIPv6))
+import Application
+
+
+main :: IO ()
+main = app >>=
+ runSettings (defaultSettings
+ { settingsHost = HostIPv6
+ , settingsPort = 8000
+ , settingsOnException = \e ->
+ hPrint stdout e
+ >>
+ hFlush stdout
+ })

0 comments on commit 459f030

Please sign in to comment.
Something went wrong with that request. Please try again.