haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

yesod-examples updated (finally)

Browse Source
This commit is contained in:
Michael Snoyman 2011-11-30 08:20:15 +02:00
parent 3ed230de2c
commit e571a1aefe
12 changed files with 80 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
yesod-examples/src/ajax.lhs
View File

@ -5,15 +5,14 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
> import Yesod > import Yesod
> import Yesod.Static > import Yesod.Static
> import Data.Monoid (mempty) > import Data.Text (Text, unpack)
> import Text.Blaze (string)
Like the blog example, we'll define some data first. Like the blog example, we'll define some data first.
> data Page = Page > data Page = Page
> { pageName :: String > { pageName :: Text
> , pageSlug :: String > , pageSlug :: Text
> , pageContent :: String > , pageContent :: Text
> } > }
> loadPages :: IO [Page] > loadPages :: IO [Page]
@ -36,7 +35,7 @@ Now the routes; we'll have a homepage, a pattern for the pages, and use a static
> mkYesod "Ajax" [parseRoutes| > mkYesod "Ajax" [parseRoutes|
> / HomeR GET > / HomeR GET
> /page/#String PageR GET > /page/#Text PageR GET
> /static StaticR Static ajaxStatic > /static StaticR Static ajaxStatic
> |] > |]
@ -49,7 +48,7 @@ Now the routes; we'll have a homepage, a pattern for the pages, and use a static
> defaultLayout widget = do > defaultLayout widget = do
> Ajax pages _ <- getYesod > Ajax pages _ <- getYesod
> content <- widgetToPageContent widget > content <- widgetToPageContent widget
> hamletToRepHtml [$hamlet| > hamletToRepHtml [hamlet|
> \<!DOCTYPE html> > \<!DOCTYPE html>
> >
> <html> > <html>
@ -80,23 +79,23 @@ Now the routes; we'll have a homepage, a pattern for the pages, and use a static
And now the cool part: a handler that returns either HTML or JSON data, depending on the request headers. And now the cool part: a handler that returns either HTML or JSON data, depending on the request headers.
> getPageR :: String -> Handler RepHtmlJson > getPageR :: Text -> Handler RepHtmlJson
> getPageR slug = do > getPageR slug = do
> Ajax pages _ <- getYesod > Ajax pages _ <- getYesod
> case filter (\e -> pageSlug e == slug) pages of > case filter (\e -> pageSlug e == slug) pages of
> [] -> notFound > [] -> notFound
> page:_ -> defaultLayoutJson (do > page:_ -> defaultLayoutJson (do
> setTitle $ string $ pageName page > setTitle $ toHtml $ pageName page
> addHamlet $ html page > addHamlet $ html page
> ) (json page) > ) (json page)
> where > where
> html page = [$hamlet| > html page = [hamlet|
> <h1>#{pageName page} > <h1>#{pageName page}
> <article>#{pageContent page} > <article>#{pageContent page}
> |] > |]
> json page = jsonMap > json page = jsonMap
> [ ("name", jsonScalar $ pageName page) > [ ("name", jsonScalar $ unpack $ pageName page)
> , ("content", jsonScalar $ pageContent page) > , ("content", jsonScalar $ unpack $ pageContent page)
> ] > ]
<p>We first try and find the appropriate Page, returning a 404 if it's not there. We then use the applyLayoutJson function, which is really the heart of this example. It allows you an easy way to create responses that will be either HTML or JSON, and which use the default layout in the HTML responses. It takes four arguments: 1) the title of the HTML page, 2) some value, 3) a function from that value to a Hamlet value, and 4) a function from that value to a Json value.</p> <p>We first try and find the appropriate Page, returning a 404 if it's not there. We then use the applyLayoutJson function, which is really the heart of this example. It allows you an easy way to create responses that will be either HTML or JSON, and which use the default layout in the HTML responses. It takes four arguments: 1) the title of the HTML page, 2) some value, 3) a function from that value to a Hamlet value, and 4) a function from that value to a Json value.</p>
@ -110,3 +109,8 @@ And now the cool part: a handler that returns either HTML or JSON data, dependin
> pages <- loadPages > pages <- loadPages
> s <- static "static/yesod/ajax" > s <- static "static/yesod/ajax"
> warpDebug 3000 $ Ajax pages s > warpDebug 3000 $ Ajax pages s
And just to avoid some warnings...
> _ignored :: Widget
> _ignored = undefined ajaxPages

5
yesod-examples/src/blog.lhs
View File

@ -113,3 +113,8 @@ All that's left now is the main function. Yesod is built on top of WAI, so you c
> main = do > main = do
> entries <- loadEntries > entries <- loadEntries
> warpDebug 3000 $ Blog entries > warpDebug 3000 $ Blog entries
And this is just to avoid some warnings...
> _ignored :: Widget
> _ignored = undefined blogEntries

30
yesod-examples/src/chat.hs
View File

@ -9,8 +9,6 @@ import Yesod
import Yesod.Static import Yesod.Static
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TVar
import Control.Arrow ((***)) import Control.Arrow ((***))
import Data.Text (Text, unpack) import Data.Text (Text, unpack)
@ -27,7 +25,7 @@ data Chat = Chat
staticFiles "static" staticFiles "static"
mkYesod "Chat" [$parseRoutes| mkYesod "Chat" [parseRoutes|
/ HomeR GET / HomeR GET
/check CheckR GET /check CheckR GET
/post PostR GET /post PostR GET
@ -38,18 +36,17 @@ instance Yesod Chat where
approot _ = "" approot _ = ""
defaultLayout widget = do defaultLayout widget = do
content <- widgetToPageContent widget content <- widgetToPageContent widget
hamletToRepHtml [$hamlet|\ hamletToRepHtml [hamlet|
\<!DOCTYPE html> !!!
<html> <html>
<head> <head>
<title>#{pageTitle content} <title>#{pageTitle content}
<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"> <script src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js">
<script src="@{StaticR chat_js}"> <script src="@{StaticR chat_js}">
\^{pageHead content} ^{pageHead content}
<body> <body>
\^{pageBody content} ^{pageBody content}
\
|] |]
getHomeR :: Handler RepHtml getHomeR :: Handler RepHtml
@ -66,8 +63,8 @@ getHomeR = do
return c return c
defaultLayout $ do defaultLayout $ do
setTitle "Chat Page" setTitle "Chat Page"
toWidget [$hamlet|\ toWidget [hamlet|
\<!DOCTYPE html> !!!
<h1>Chat Example <h1>Chat Example
<form> <form>
@ -97,6 +94,7 @@ getCheckR = do
let Message s c = first let Message s c = first
jsonToRepJson $ zipJson ["sender", "content"] [s,c] jsonToRepJson $ zipJson ["sender", "content"] [s,c]
zipJson :: [Text] -> [Text] -> Json
zipJson x y = jsonMap $ map (unpack *** jsonScalar . unpack) $ zip x y zipJson x y = jsonMap $ map (unpack *** jsonScalar . unpack) $ zip x y
getPostR :: Handler RepJson getPostR :: Handler RepJson

20
yesod-examples/src/file-echo.lhs
View File

@ -1,10 +1,8 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
> import Yesod > import Yesod
> import Data.Monoid (mempty)
> import qualified Data.ByteString.Char8 as S8 > import qualified Data.ByteString.Char8 as S8
> import qualified Data.Text as T > import qualified Data.Text as T
> import Text.Blaze (string)
> data Echo = Echo > data Echo = Echo
@ -14,18 +12,26 @@
> instance Yesod Echo where approot _ = "" > instance Yesod Echo where approot _ = ""
> getHomepage :: Handler RepHtml
> getHomepage = defaultLayout $ do > getHomepage = defaultLayout $ do
> setTitle $ string "Upload a file" > setTitle "Upload a file"
> addHamlet [$hamlet| > addHamlet [hamlet|
> %form!method=post!action=.!enctype=multipart/form-data > <form method=post action=. enctype=multipart/form-data>
> File name: > File name:
> %input!type=file!name=file > <input type=file name=file
> %input!type=submit > <input type=submit
> |] > |]
> postHomepage :: Handler [(ContentType, Content)]
> postHomepage = do > postHomepage = do
> (_, files) <- runRequestBody > (_, files) <- runRequestBody
> fi <- maybe notFound return $ lookup "file" files > fi <- maybe notFound return $ lookup "file" files
> return [(S8.pack $ T.unpack $ fileContentType fi, toContent $ fileContent fi)] > return [(S8.pack $ T.unpack $ fileContentType fi, toContent $ fileContent fi)]
> main :: IO ()
> main = warpDebug 3000 Echo > main = warpDebug 3000 Echo
To avoid warnings
> _ignored :: Widget
> _ignored = undefined

10
yesod-examples/src/form.lhs
View File

@ -2,7 +2,7 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-} > {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-}
> import Yesod > import Yesod hiding (Form)
> import Control.Applicative > import Control.Applicative
> import Data.Text (Text) > import Data.Text (Text)
@ -10,6 +10,8 @@
> mkYesod "FormExample" [parseRoutes| > mkYesod "FormExample" [parseRoutes|
> / RootR GET > / RootR GET
> |] > |]
> type Form a = Html -> MForm FormExample FormExample (FormResult a, Widget)
> type Formlet a = Maybe a -> Form a
> instance Yesod FormExample where approot _ = "" > instance Yesod FormExample where approot _ = ""
> instance RenderMessage FormExample FormMessage where > instance RenderMessage FormExample FormMessage where
> renderMessage _ _ = defaultFormMessage > renderMessage _ _ = defaultFormMessage
@ -18,6 +20,7 @@ Next, we'll declare a Person datatype with a name and age. After that, we'll cre
> data Person = Person { name :: Text, age :: Int } > data Person = Person { name :: Text, age :: Int }
> deriving Show > deriving Show
> personFormlet :: Formlet Person
> personFormlet p = renderTable $ Person > personFormlet p = renderTable $ Person
> <$> areq textField "Name" (fmap name p) > <$> areq textField "Name" (fmap name p)
> <*> areq intField "Age" (fmap age p) > <*> areq intField "Age" (fmap age p)
@ -38,14 +41,15 @@ We use an applicative approach and stay mostly declarative. The "fmap name p" bi
<p>extractBody returns the HTML of a widget and "passes" all of the other declarations (the CSS, Javascript, etc) up to the parent widget. The rest of this is just standard Hamlet code and our main function.</p> <p>extractBody returns the HTML of a widget and "passes" all of the other declarations (the CSS, Javascript, etc) up to the parent widget. The rest of this is just standard Hamlet code and our main function.</p>
> addHamlet [$hamlet| > addHamlet [hamlet|
> <p>Last result: #{show res} > <p>Last result: #{show res}
> <form enctype="#{enctype}"> > <form enctype="#{enctype}">
> <table> > <table>
> \^{form} > ^{form}
> <tr> > <tr>
> <td colspan="2"> > <td colspan="2">
> <input type="submit"> > <input type="submit">
> |] > |]
> >
> main :: IO ()
> main = warpDebug 3000 FormExample > main = warpDebug 3000 FormExample

52
yesod-examples/src/generalized-hamlet.lhs
View File

@ -1,52 +0,0 @@
This example shows how generalized hamlet templates allow the creation of
different types of values. The key component here is the HamletValue typeclass.
Yesod has instances for:
* Html
* HtmlUrl (= (url -> [(String, String)] -> String) -> Html)
* GWidget s m ()
This example uses all three. You are of course free in your own code to make
your own instances.
> {-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell #-}
> import Yesod
> import Text.Hamlet (shamlet)
> data NewHamlet = NewHamlet
> mkYesod "NewHamlet" [$parseRoutes|/ RootR GET|]
> instance Yesod NewHamlet where approot _ = ""
>
> myHtml :: Html
> myHtml = [shamlet|<p>Just don't use any URLs in here!|]
>
> myInnerWidget :: Widget
> myInnerWidget = do
> addHamlet [$hamlet|
> <div #inner>Inner widget
> #{myHtml}
> |]
> addCassius [$cassius|
>#inner
> color: red|]
>
> myPlainTemplate :: HtmlUrl NewHamletRoute
> myPlainTemplate = [hamlet|
> <p
> <a href=@{RootR}>Link to home
> |]
>
> myWidget :: Widget
> myWidget = [whamlet|
> <h1>Embed another widget
> \^{myInnerWidget}
> <h1>Embed a Hamlet
> \^{addHamlet myPlainTemplate}
> |]
>
> getRootR :: GHandler NewHamlet NewHamlet RepHtml
> getRootR = defaultLayout myWidget
>
> main :: IO ()
> main = warpDebug 3000 NewHamlet

16
yesod-examples/src/i18n.lhs
View File

@ -6,20 +6,11 @@
> {-# LANGUAGE CPP #-} > {-# LANGUAGE CPP #-}
> import Yesod > import Yesod
> 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" [QQ(parseRoutes)| > mkYesod "I18N" [parseRoutes|
> / HomepageR GET > / HomepageR GET
> /set/#Text SetLangR GET > /set/#Text SetLangR GET
> |] > |]
@ -38,7 +29,7 @@ To work on both ghc6 and ghc7
> ] > ]
> defaultLayout $ do > defaultLayout $ do
> setTitle "I18N Homepage" > setTitle "I18N Homepage"
> addHamlet [QQ(hamlet)| > addHamlet [hamlet|
> <h1>#{hello} > <h1>#{hello}
> <p>In other languages: > <p>In other languages:
> <ul> > <ul>
@ -60,3 +51,6 @@ To work on both ghc6 and ghc7
> main :: IO () > main :: IO ()
> main = warpDebug 3000 I18N > main = warpDebug 3000 I18N
> _ignored :: Widget
> _ignored = undefined

13
yesod-examples/src/pretty-yaml.lhs
View File

@ -10,14 +10,14 @@
> data PY = PY > data PY = PY
> mkYesod "PY" [$parseRoutes| > mkYesod "PY" [parseRoutes|
> / Homepage GET POST > / Homepage GET POST
> |] > |]
> instance Yesod PY where approot _ = "" > instance Yesod PY where approot _ = ""
> template :: Maybe (HtmlUrl url) -> HtmlUrl url > template :: Maybe (HtmlUrl url) -> HtmlUrl url
> template myaml = [$hamlet| > template myaml = [hamlet|
> !!! > !!!
> >
> <html> > <html>
@ -46,13 +46,13 @@
> hamletToRepHtml $ template $ Just $ objToHamlet so > hamletToRepHtml $ template $ Just $ objToHamlet so
> objToHamlet :: StringObject -> HtmlUrl url > objToHamlet :: StringObject -> HtmlUrl url
> objToHamlet (Scalar s) = [$hamlet|#{s}|] > objToHamlet (Scalar s) = [hamlet|#{s}|]
> objToHamlet (Sequence list) = [$hamlet| > objToHamlet (Sequence list) = [hamlet|
> <ul > <ul
> $forall o <- list > $forall o <- list
> <li>^{objToHamlet o} > <li>^{objToHamlet o}
> |] > |]
> objToHamlet (Mapping pairs) = [$hamlet| > objToHamlet (Mapping pairs) = [hamlet|
> <dl > <dl
> $forall pair <- pairs > $forall pair <- pairs
> <dt>#{fst pair} > <dt>#{fst pair}
@ -61,3 +61,6 @@
> main :: IO () > main :: IO ()
> main = warpDebug 3000 PY > main = warpDebug 3000 PY
> _ignored :: Widget
> _ignored = undefined

6
yesod-examples/src/session.lhs
View File

@ -17,7 +17,7 @@
> getRoot :: Handler RepHtml > getRoot :: Handler RepHtml
> getRoot = do > getRoot = do
> sess <- getSession > sess <- getSession
> hamletToRepHtml [$hamlet| > hamletToRepHtml [hamlet|
> <form method=post > <form method=post
> <input type=text name=key > <input type=text name=key
> <input type=text name=val > <input type=text name=val
@ -32,4 +32,8 @@
> liftIO $ print (key, val) > liftIO $ print (key, val)
> redirect RedirectTemporary Root > redirect RedirectTemporary Root
> >
> main :: IO ()
> main = warpDebug 3000 Session > main = warpDebug 3000 Session
> _ignored :: Widget
> _ignored = undefined

7
yesod-examples/synopsis/hamlet.lhs
View File

@ -2,7 +2,6 @@
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} {-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
import Text.Hamlet import Text.Hamlet
import Yesod.Widget
import Data.Text (Text, cons) import Data.Text (Text, cons)
import qualified Data.Text.Lazy.IO as L import qualified Data.Text.Lazy.IO as L
import Text.Blaze.Renderer.Text (renderHtml) import Text.Blaze.Renderer.Text (renderHtml)
@ -19,15 +18,15 @@ data PersonUrls = Homepage | PersonPage Text
renderUrls :: PersonUrls -> [(Text, Text)] -> Text renderUrls :: PersonUrls -> [(Text, Text)] -> Text
renderUrls Homepage _ = "/" renderUrls Homepage _ = "/"
renderUrls (PersonPage name) _ = '/' `cons` name renderUrls (PersonPage name') _ = '/' `cons` name'
footer :: HtmlUrl url footer :: HtmlUrl url
footer = [$hamlet|\ footer = [hamlet|
<div id="footer">Thank you, come again <div id="footer">Thank you, come again
|] |]
template :: Person -> HtmlUrl PersonUrls template :: Person -> HtmlUrl PersonUrls
template person = [$hamlet| template person = [hamlet|
!!! !!!
<html> <html>

3
yesod-examples/synopsis/persistent.lhs
View File

@ -37,3 +37,6 @@ Just (Person {personName = "Michael", personAge = 25})
Just (Person {personName = "Michael", personAge = 26}) Just (Person {personName = "Michael", personAge = 26})
[(PersonId 1,Person {personName = "Michael", personAge = 26})] [(PersonId 1,Person {personName = "Michael", personAge = 26})]
[]</pre></code> []</pre></code>
> _ignored :: PersonId
> _ignored = undefined personName personAge

4
yesod-examples/yesod-examples.cabal
View File

@ -52,9 +52,6 @@ Executable yesod-session
-- Main-is: src/widgets.lhs -- Main-is: src/widgets.lhs
-- Build-depends: yesod-form -- Build-depends: yesod-form
Executable yesod-generalized-hamlet
Main-is: src/generalized-hamlet.lhs
Executable yesod-form Executable yesod-form
Main-is: src/form.lhs Main-is: src/form.lhs
@ -63,6 +60,7 @@ Executable yesod-persistent-synopsis
Build-depends: transformers >= 0.2.2 && < 0.3, Build-depends: transformers >= 0.2.2 && < 0.3,
persistent-sqlite >= 0.6 && < 0.7, persistent-sqlite >= 0.6 && < 0.7,
persistent-template >= 0.6 && < 0.7 persistent-template >= 0.6 && < 0.7
extra-libraries: sqlite3
Executable yesod-hamlet-synopsis Executable yesod-hamlet-synopsis
Main-is: synopsis/hamlet.lhs Main-is: synopsis/hamlet.lhs