get all examples compiling
This commit is contained in:
parent
e6c67df5c2
commit
e636c11c03
@ -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
|
||||||
|
|||||||
@ -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>
|
||||||
|
|||||||
@ -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):
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user