get all examples compiling

This commit is contained in:
Greg Weber 2011-11-06 20:14:50 -08:00
parent e6c67df5c2
commit e636c11c03
4 changed files with 33 additions and 18 deletions

View File

@ -6,7 +6,7 @@
module Main where module Main where
import Yesod import Yesod
import Yesod.Helpers.Static import Yesod.Static
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TChan
@ -18,8 +18,6 @@ import Data.Text (Text, unpack)
-- speaker and content -- speaker and content
data Message = Message Text Text data Message = Message Text Text
type Handler yesod = GHandler yesod yesod
-- all those TChans are dupes, so writing to any one writes to them all, but reading is separate -- all those TChans are dupes, so writing to any one writes to them all, but reading is separate
data Chat = Chat data Chat = Chat
{ chatClients :: TVar [(Int, TChan Message)] { chatClients :: TVar [(Int, TChan Message)]
@ -54,7 +52,7 @@ instance Yesod Chat where
\ \
|] |]
getHomeR :: Handler Chat RepHtml getHomeR :: Handler RepHtml
getHomeR = do getHomeR = do
Chat clients next _ <- getYesod Chat clients next _ <- getYesod
client <- liftIO . atomically $ do client <- liftIO . atomically $ do
@ -68,7 +66,7 @@ getHomeR = do
return c return c
defaultLayout $ do defaultLayout $ do
setTitle "Chat Page" setTitle "Chat Page"
addWidget [$hamlet|\ toWidget [$hamlet|\
\<!DOCTYPE html> \<!DOCTYPE html>
<h1>Chat Example <h1>Chat Example
@ -81,7 +79,7 @@ getHomeR = do
<script>var clientNumber = #{show client} <script>var clientNumber = #{show client}
|] |]
getCheckR :: Handler Chat RepJson getCheckR :: Handler RepJson
getCheckR = do getCheckR = do
liftIO $ putStrLn "Check" liftIO $ putStrLn "Check"
Chat clients _ _ <- getYesod Chat clients _ _ <- getYesod
@ -101,7 +99,7 @@ getCheckR = do
zipJson x y = jsonMap $ map (unpack *** jsonScalar . unpack) $ zip x y zipJson x y = jsonMap $ map (unpack *** jsonScalar . unpack) $ zip x y
getPostR :: Handler Chat RepJson getPostR :: Handler RepJson
getPostR = do getPostR = do
liftIO $ putStrLn "Post" liftIO $ putStrLn "Post"
Chat clients _ _ <- getYesod Chat clients _ _ <- getYesod
@ -122,4 +120,5 @@ main :: IO ()
main = do main = do
clients <- newTVarIO [] clients <- newTVarIO []
next <- newTVarIO 0 next <- newTVarIO 0
warpDebug 3000 $ Chat clients next $ static "static" s <- static "static"
warpDebug 3000 $ Chat clients next s

View File

@ -3,14 +3,23 @@
> {-# LANGUAGE TypeFamilies #-} > {-# LANGUAGE TypeFamilies #-}
> {-# LANGUAGE MultiParamTypeClasses #-} > {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE OverloadedStrings #-} > {-# LANGUAGE OverloadedStrings #-}
> {-# LANGUAGE CPP #-}
> import Yesod > import Yesod
> import Data.Monoid (mempty) > import Data.Monoid (mempty)
> import Data.Text (Text) > import Data.Text (Text)
To work on both ghc6 and ghc7
#if GHC7
# define QQ(x) x
#else
# define QQ(x) $x
#endif
> data I18N = I18N > data I18N = I18N
> mkYesod "I18N" [$parseRoutes| > mkYesod "I18N" [QQ(parseRoutes)|
> / HomepageR GET > / HomepageR GET
> /set/#Text SetLangR GET > /set/#Text SetLangR GET
> |] > |]
@ -29,7 +38,7 @@
> ] > ]
> defaultLayout $ do > defaultLayout $ do
> setTitle "I18N Homepage" > setTitle "I18N Homepage"
> addHamlet [$hamlet| > addHamlet [QQ(hamlet)|
> <h1>#{hello} > <h1>#{hello}
> <p>In other languages: > <p>In other languages:
> <ul> > <ul>

View File

@ -2,8 +2,11 @@
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} {-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
import Text.Hamlet import Text.Hamlet
import qualified Data.ByteString.Lazy as L import Yesod.Widget
import Data.Text (Text, cons) import Data.Text (Text, cons)
import qualified Data.Text.Lazy.IO as L
import Text.Blaze.Renderer.Text (renderHtml)
data Person = Person data Person = Person
{ name :: String { name :: String
@ -18,12 +21,12 @@ renderUrls :: PersonUrls -> [(Text, Text)] -> Text
renderUrls Homepage _ = "/" renderUrls Homepage _ = "/"
renderUrls (PersonPage name) _ = '/' `cons` name renderUrls (PersonPage name) _ = '/' `cons` name
footer :: Hamlet url footer :: HtmlUrl url
footer = [$hamlet|\ footer = [$hamlet|\
<div id="footer">Thank you, come again <div id="footer">Thank you, come again
|] |]
template :: Person -> Hamlet PersonUrls template :: Person -> HtmlUrl PersonUrls
template person = [$hamlet| template person = [$hamlet|
!!! !!!
@ -31,8 +34,8 @@ template person = [$hamlet|
<head> <head>
<title>Hamlet Demo <title>Hamlet Demo
<body> <body>
<h1>Information on #{string (name person)} <h1>Information on #{name person}
<p>#{string (name person)} is #{string (age person)} years old. <p>#{name person} is #{age person} years old.
<h2> <h2>
$if isMarried person $if isMarried person
\Married \Married
@ -40,7 +43,7 @@ template person = [$hamlet|
\Not married \Not married
<ul> <ul>
$forall child <- children person $forall child <- children person
<li>#{string child} <li>#{child}
<p> <p>
<a href="@{page person}">See the page. <a href="@{page person}">See the page.
\^{footer} \^{footer}
@ -55,7 +58,7 @@ main = do
, isMarried = True , isMarried = True
, children = ["Adam", "Ben", "Chris"] , children = ["Adam", "Ben", "Chris"]
} }
L.putStrLn $ renderHamlet renderUrls $ template person L.putStrLn $ renderHtml $ (template person) renderUrls
\end{code} \end{code}
Outputs (new lines added for readability): Outputs (new lines added for readability):

View File

@ -15,6 +15,8 @@ extra-source-files: static/yesod/ajax/script.js,
static/yesod/ajax/style.css, static/yesod/ajax/style.css,
static/chat.js static/chat.js
flag ghc7
Executable yesod-blog Executable yesod-blog
Main-is: src/blog.lhs Main-is: src/blog.lhs
Build-depends: base >= 4 && < 5, Build-depends: base >= 4 && < 5,
@ -40,6 +42,8 @@ Executable yesod-pretty-yaml
Executable yesod-i18n Executable yesod-i18n
Main-is: src/i18n.lhs Main-is: src/i18n.lhs
if flag(ghc7)
cpp-options: -DGHC7
Executable yesod-session Executable yesod-session
Main-is: src/session.lhs Main-is: src/session.lhs
@ -62,7 +66,7 @@ Executable yesod-persistent-synopsis
Executable yesod-hamlet-synopsis Executable yesod-hamlet-synopsis
Main-is: synopsis/hamlet.lhs Main-is: synopsis/hamlet.lhs
Build-depends: hamlet Build-depends: hamlet, yesod-core
Executable yesod-chat Executable yesod-chat
Main-is: src/chat.hs Main-is: src/chat.hs