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 #-}
> import Yesod
> import Yesod.Static
> import Data.Monoid (mempty)
> import Text.Blaze (string)
> import Data.Text (Text, unpack)
Like the blog example, we'll define some data first.
> data Page = Page
> { pageName :: String
> , pageSlug :: String
> , pageContent :: String
> { pageName :: Text
> , pageSlug :: Text
> , pageContent :: Text
> }
> 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|
> / HomeR GET
> /page/#String PageR GET
> /page/#Text PageR GET
> /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
> Ajax pages _ <- getYesod
> content <- widgetToPageContent widget
> hamletToRepHtml [$hamlet|
> hamletToRepHtml [hamlet|
> \<!DOCTYPE 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.
> getPageR :: String -> Handler RepHtmlJson
> getPageR :: Text -> Handler RepHtmlJson
> getPageR slug = do
> Ajax pages _ <- getYesod
> case filter (\e -> pageSlug e == slug) pages of
> [] -> notFound
> page:_ -> defaultLayoutJson (do
> setTitle $ string $ pageName page
> setTitle $ toHtml $ pageName page
> addHamlet $ html page
> ) (json page)
> where
> html page = [$hamlet|
> html page = [hamlet|
> <h1>#{pageName page}
> <article>#{pageContent page}
> |]
> json page = jsonMap
> [ ("name", jsonScalar $ pageName page)
> , ("content", jsonScalar $ pageContent page)
> [ ("name", jsonScalar $ unpack $ pageName 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>
@ -110,3 +109,8 @@ And now the cool part: a handler that returns either HTML or JSON data, dependin
> pages <- loadPages
> s <- static "static/yesod/ajax"
> 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
> entries <- loadEntries
> 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 Control.Concurrent.STM
import Control.Concurrent.STM.TChan
import Control.Concurrent.STM.TVar
import Control.Arrow ((***))
import Data.Text (Text, unpack)
@ -27,7 +25,7 @@ data Chat = Chat
staticFiles "static"
mkYesod "Chat" [$parseRoutes|
mkYesod "Chat" [parseRoutes|
/ HomeR GET
/check CheckR GET
/post PostR GET
@ -38,18 +36,17 @@ instance Yesod Chat where
approot _ = ""
defaultLayout widget = do
content <- widgetToPageContent widget
hamletToRepHtml [$hamlet|\
\<!DOCTYPE html>
hamletToRepHtml [hamlet|
!!!
<html>
<head>
<title>#{pageTitle content}
<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js">
<script src="@{StaticR chat_js}">
\^{pageHead content}
<body>
\^{pageBody content}
\
<html>
<head>
<title>#{pageTitle content}
<script src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js">
<script src="@{StaticR chat_js}">
^{pageHead content}
<body>
^{pageBody content}
|]
getHomeR :: Handler RepHtml
@ -66,8 +63,8 @@ getHomeR = do
return c
defaultLayout $ do
setTitle "Chat Page"
toWidget [$hamlet|\
\<!DOCTYPE html>
toWidget [hamlet|
!!!
<h1>Chat Example
<form>
@ -97,6 +94,7 @@ getCheckR = do
let Message s c = first
jsonToRepJson $ zipJson ["sender", "content"] [s,c]
zipJson :: [Text] -> [Text] -> Json
zipJson x y = jsonMap $ map (unpack *** jsonScalar . unpack) $ zip x y
getPostR :: Handler RepJson

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

@ -1,10 +1,8 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
> import Yesod
> import Data.Monoid (mempty)
> import qualified Data.ByteString.Char8 as S8
> import qualified Data.Text as T
> import Text.Blaze (string)
> data Echo = Echo
@ -14,18 +12,26 @@
> instance Yesod Echo where approot _ = ""
> getHomepage :: Handler RepHtml
> getHomepage = defaultLayout $ do
> setTitle $ string "Upload a file"
> addHamlet [$hamlet|
> %form!method=post!action=.!enctype=multipart/form-data
> setTitle "Upload a file"
> addHamlet [hamlet|
> <form method=post action=. enctype=multipart/form-data>
> File name:
> %input!type=file!name=file
> %input!type=submit
> <input type=file name=file
> <input type=submit
> |]
> postHomepage :: Handler [(ContentType, Content)]
> postHomepage = do
> (_, files) <- runRequestBody
> fi <- maybe notFound return $ lookup "file" files
> return [(S8.pack $ T.unpack $ fileContentType fi, toContent $ fileContent fi)]
> main :: IO ()
> 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 #-}
> import Yesod
> import Yesod hiding (Form)
> import Control.Applicative
> import Data.Text (Text)
@ -10,6 +10,8 @@
> mkYesod "FormExample" [parseRoutes|
> / 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 RenderMessage FormExample FormMessage where
> 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 }
> deriving Show
> personFormlet :: Formlet Person
> personFormlet p = renderTable $ Person
> <$> areq textField "Name" (fmap name 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>
> addHamlet [$hamlet|
> addHamlet [hamlet|
> <p>Last result: #{show res}
> <form enctype="#{enctype}">
> <table>
> \^{form}
> ^{form}
> <tr>
> <td colspan="2">
> <input type="submit">
> |]
>
> main :: IO ()
> 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 #-}
> import Yesod
> import Data.Monoid (mempty)
> 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
> mkYesod "I18N" [QQ(parseRoutes)|
> mkYesod "I18N" [parseRoutes|
> / HomepageR GET
> /set/#Text SetLangR GET
> |]
@ -38,7 +29,7 @@ To work on both ghc6 and ghc7
> ]
> defaultLayout $ do
> setTitle "I18N Homepage"
> addHamlet [QQ(hamlet)|
> addHamlet [hamlet|
> <h1>#{hello}
> <p>In other languages:
> <ul>
@ -60,3 +51,6 @@ To work on both ghc6 and ghc7
> main :: IO ()
> main = warpDebug 3000 I18N
> _ignored :: Widget
> _ignored = undefined

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

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

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

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

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

@ -2,7 +2,6 @@
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
import Text.Hamlet
import Yesod.Widget
import Data.Text (Text, cons)
import qualified Data.Text.Lazy.IO as L
import Text.Blaze.Renderer.Text (renderHtml)
@ -19,15 +18,15 @@ data PersonUrls = Homepage | PersonPage Text
renderUrls :: PersonUrls -> [(Text, Text)] -> Text
renderUrls Homepage _ = "/"
renderUrls (PersonPage name) _ = '/' `cons` name
renderUrls (PersonPage name') _ = '/' `cons` name'
footer :: HtmlUrl url
footer = [$hamlet|\
footer = [hamlet|
<div id="footer">Thank you, come again
|]
template :: Person -> HtmlUrl PersonUrls
template person = [$hamlet|
template person = [hamlet|
!!!
<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})
[(PersonId 1,Person {personName = "Michael", personAge = 26})]
[]</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
-- Build-depends: yesod-form
Executable yesod-generalized-hamlet
Main-is: src/generalized-hamlet.lhs
Executable yesod-form
Main-is: src/form.lhs
@ -63,6 +60,7 @@ Executable yesod-persistent-synopsis
Build-depends: transformers >= 0.2.2 && < 0.3,
persistent-sqlite >= 0.6 && < 0.7,
persistent-template >= 0.6 && < 0.7
extra-libraries: sqlite3
Executable yesod-hamlet-synopsis
Main-is: synopsis/hamlet.lhs