yesod-examples (empty) → 0.4.0
raw patch · 16 files changed
+855/−0 lines, 16 filesdep +basedep +bytestringdep +data-objectsetup-changed
Dependencies added: base, bytestring, data-object, data-object-yaml, hamlet, persistent-sqlite, transformers, yesod
Files
- LICENSE +30/−0
- Setup.hs +3/−0
- hamlet/synopsis.lhs +73/−0
- persistent/synopsis.lhs +41/−0
- static/yesod/ajax/script.js +9/−0
- static/yesod/ajax/style.css +11/−0
- yesod-examples.cabal +60/−0
- yesod/helloworld.lhs +12/−0
- yesod/tutorial/ajax.lhs +111/−0
- yesod/tutorial/blog.lhs +120/−0
- yesod/tutorial/chat.lhs +126/−0
- yesod/tutorial/file-echo.lhs +29/−0
- yesod/tutorial/i18n.lhs +53/−0
- yesod/tutorial/pretty-yaml.lhs +68/−0
- yesod/tutorial/session.lhs +32/−0
- yesod/tutorial/widgets.lhs +77/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Michael Snoyman 2010++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Michael Snoyman nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ hamlet/synopsis.lhs view
@@ -0,0 +1,73 @@+---+title: Synopsis - Hamlet+---+\begin{code}+{-# LANGUAGE QuasiQuotes #-}++import Text.Hamlet+import qualified Data.ByteString.Lazy as L++data Person = Person+ { name :: String+ , age :: String+ , page :: PersonUrls+ , isMarried :: Bool+ , children :: [String]+ }+data PersonUrls = Homepage | PersonPage String++renderUrls :: PersonUrls -> String+renderUrls Homepage = "/"+renderUrls (PersonPage name) = '/' : name++footer :: Hamlet url+footer = [$hamlet|+#footer Thank you, come again+|]++template :: Person -> Hamlet PersonUrls+template person = [$hamlet|+!!!+%html+ %head+ %title Hamlet Demo+ %body+ %h1 Information on $string.name.person$+ %p $string.name.person$ is $string.age.person$ years old.+ %h2+ $if isMarried.person+ Married+ $else+ Not married+ %ul+ $forall children.person child+ %li $string.child$+ %p+ %a!href=@page.person@ See the page.+ ^footer^+|]++main :: IO ()+main = do+ let person = Person+ { name = "Michael"+ , age = "twenty five & a half"+ , page = PersonPage "michael"+ , isMarried = True+ , children = ["Adam", "Ben", "Chris"]+ }+ L.putStrLn $ renderHamlet renderUrls $ template person+\end{code}++Outputs (new lines added for readability):+<code><pre>+ <!DOCTYPE html>+ <html><head><title>Hamlet Demo</title></head><body>+ <h1>Information on Michael</h1>+ <p>Michael is twenty five & a half years old.</p>+ <h2>Married</h2>+ <ul><li>Adam</li><li>Ben</li><li>Chris</li></ul>+ <p><a href="/michael">See the page.</a></p>+ <div id="footer">Thank you, come again</div>+ </body></html>+</pre></code>
+ persistent/synopsis.lhs view
@@ -0,0 +1,41 @@+---+title: Synopsis - Persistent+---+This example uses the sqlite backend for Persistent, since it can run in-memory and has no external dependencies.++> {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, QuasiQuotes #-}+>+> import Database.Persist.Sqlite+> import Control.Monad.IO.Class (liftIO)+>+> mkPersist [$persist|Person+> name String Eq+> age Int update+> |]+>+> main :: IO ()+> main = withSqlite ":memory:" 8 $ runSqlite go+>+> go :: SqliteReader IO ()+> go = do+> initialize (undefined :: Person)+> key <- insert $ Person "Michael" 25+> liftIO $ print key+> p1 <- get key+> liftIO $ print p1+> update key [PersonAge 26]+> p2 <- get key+> liftIO $ print p2+> p3 <- select [PersonNameEq "Michael"] []+> liftIO $ print p3+> delete key+> p4 <- select [PersonNameEq "Michael"] []+> liftIO $ print p4++The output of the above is:++ PersonId 1+ Just (Person {personName = "Michael", personAge = 25})+ Just (Person {personName = "Michael", personAge = 26})+ [(PersonId 1,Person {personName = "Michael", personAge = 26})]+ []
+ static/yesod/ajax/script.js view
@@ -0,0 +1,9 @@+$(function(){+ $("#navbar a").click(function(){+ $.getJSON($(this).attr("href"), {}, function(o){+ $("h1").html(o.name);+ $("article").html(o.content);+ });+ return false;+ });+});
+ static/yesod/ajax/style.css view
@@ -0,0 +1,11 @@+#navbar {+ width: 100px;+ float: left;+ background: #eee;+ padding: 1em;+ list-style: none;+}++#content {+ margin-left: 230px;+}
+ yesod-examples.cabal view
@@ -0,0 +1,60 @@+Name: yesod-examples+Version: 0.4.0+Synopsis: Example programs using the Yesod Web Framework.+Description: These are the same examples and tutorials found on the documentation site.+Homepage: http://docs.yesodweb.com/+License: BSD3+License-file: LICENSE+Author: Michael Snoyman+Maintainer: michael@snoyman.com+Stability: Experimental+Category: Web+Build-type: Simple+Cabal-version: >=1.6+extra-source-files: static/yesod/ajax/script.js,+ static/yesod/ajax/style.css++Executable helloworld+ Main-is: yesod/helloworld.lhs+ Build-depends: base >= 4 && < 5,+ yesod >= 0.4.0 && < 0.5++Executable blog+ Main-is: yesod/tutorial/blog.lhs++Executable chat+ Main-is: yesod/tutorial/chat.lhs++Executable ajax+ Main-is: yesod/tutorial/ajax.lhs++Executable file-echo+ Main-is: yesod/tutorial/file-echo.lhs++Executable pretty-yaml+ Main-is: yesod/tutorial/pretty-yaml.lhs+ Build-depends: data-object-yaml >= 0.3.0 && < 0.4,+ data-object >= 0.3.1 && < 0.4,+ bytestring >= 0.9 && < 0.10++Executable i18n+ Main-is: yesod/tutorial/i18n.lhs++Executable session+ Main-is: yesod/tutorial/session.lhs++Executable widgets+ Main-is: yesod/tutorial/widgets.lhs++Executable persistent-synopsis+ Main-is: persistent/synopsis.lhs+ Build-depends: transformers >= 0.2.1 && < 0.3,+ persistent-sqlite >= 0.1.0 && < 0.2++Executable hamlet-synopsis+ Main-is: hamlet/synopsis.lhs+ Build-depends: hamlet >= 0.4.0 && < 0.5++source-repository head+ type: git+ location: git://github.com/snoyberg/yesoddocs.git
+ yesod/helloworld.lhs view
@@ -0,0 +1,12 @@+---+title: Hello World -- Yesod+---+The following will serve the text "Hello World!" on port 3000 as plain text.++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}+> import Yesod+> data HelloWorld = HelloWorld+> mkYesod "HelloWorld" [$parseRoutes|/ Home GET|]+> instance Yesod HelloWorld where approot _ = ""+> getHome = return $ RepPlain $ toContent "Hello World!"+> main = basicHandler 3000 HelloWorld
+ yesod/tutorial/ajax.lhs view
@@ -0,0 +1,111 @@+---+title: AJAX -- Tutorials -- Yesod+---+**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**++We're going to write a very simple AJAX application. It will be a simple site with a few pages and a navbar; when you have Javascript, clicking on the links will load the pages via AJAX. Otherwise, it will use static HTML.++We're going to use jQuery for the Javascript, though anything would work just fine. Also, the AJAX responses will be served as JSON. Let's get started.++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}+> import Yesod+> import Yesod.Helpers.Static+> import Data.Monoid (mempty)++Like the [blog tutorial](blog.html), we'll define some data first.++> data Page = Page+> { pageName :: String+> , pageSlug :: String+> , pageContent :: String+> }++> loadPages :: IO [Page]+> loadPages = return+> [ Page "Page 1" "page-1" "My first page"+> , Page "Page 2" "page-2" "My second page"+> , Page "Page 3" "page-3" "My third page"+> ]++> data Ajax = Ajax+> { ajaxPages :: [Page]+> , ajaxStatic :: Static+> }++Next we'll generate a function for each file in our static folder. This way, we get a compiler warning when trying to using a file which does not exist.++> staticFiles "static/yesod/ajax"++Now the routes; we'll have a homepage, a pattern for the pages, and use a static subsite for the Javascript and CSS files.++> mkYesod "Ajax" [$parseRoutes|+> / HomeR GET+> /page/#String PageR GET+> /static StaticR Static ajaxStatic+> |]++That third line there is the syntax for a subsite: Static is the datatype for the subsite argument; siteStatic returns the site itself (parse, render and dispatch functions); and ajaxStatic gets the subsite argument from the master argument.++Now, we'll define the Yesod instance. We'll still use a dummy approot value, but we're also going to define a default layout.++> instance Yesod Ajax where+> approot _ = ""+> defaultLayout content = do+> Ajax pages _ <- getYesod+> hamletToContent [$hamlet|+> !!!+> %html+> %head+> %title $pageTitle.content$+> %link!rel=stylesheet!href=@StaticR.style_css@+> %script!src="http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"+> %script!src=@StaticR.script_js@+> ^pageHead.content^+> %body+> %ul#navbar+> $forall pages page+> %li+> %a!href=@PageR.pageSlug.page@ $pageName.page$+> #content+> ^pageBody.content^+> |]++The Hamlet template refers to style_css and style_js; these were generated by the call to staticFiles above. There's nothing Yesod-specific about the [style.css]($root/static/yesod/ajax/style.css) and [script.js]($root/static/yesod/ajax/script.js) files, so I won't describe them here.++Now we need our handler functions. We'll have the homepage simply redirect to the first page, so:++> getHomeR :: Handler Ajax ()+> getHomeR = do+> Ajax pages _ <- getYesod+> let first = head pages+> redirect RedirectTemporary $ PageR $ pageSlug first++And now the cool part: a handler that returns either HTML or JSON data, depending on the request headers.++> getPageR :: String -> Handler Ajax RepHtmlJson+> getPageR slug = do+> Ajax pages _ <- getYesod+> case filter (\e -> pageSlug e == slug) pages of+> [] -> notFound+> page:_ -> applyLayoutJson (pageName page) mempty (html page) (json page)+> where+> html page = [$hamlet|+> %h1 $pageName.page$+> %article $pageContent.page$+> |]+> json page = jsonMap+> [ ("name", jsonScalar $ string $ pageName page)+> , ("content", jsonScalar $ string $ pageContent page)+> ]++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.++Under the scenes, the Json monad is really just using the Hamlet monad, so it gets all of the benefits thereof, namely interleaved IO and enumerator output. It is pretty straight-forward to generate JSON output by using the three functions jsonMap, jsonList and jsonMap. One thing to note: the input to jsonScalar must be HtmlContent; this helps avoid cross-site scripting attacks, by ensuring that any HTML entities will be escaped.++And now our typical main function. We need two parameters to build our Ajax value: the pages, and the static loader. We'll load up from a local directory.++> main :: IO ()+> main = do+> pages <- loadPages+> let static = fileLookupDir "static/yesod/ajax" typeByExt+> basicHandler 3000 $ Ajax pages static
+ yesod/tutorial/blog.lhs view
@@ -0,0 +1,120 @@+---+title: Blog -- Tutorials -- Yesod+---+**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**++Well, just about every web framework I've seen starts with a blog tutorial- so here's mine! Actually, you'll see that this is actually a much less featureful blog than most, but gives a good introduction to Yesod basics. I recommend you start by [reading the terminology section]($root/yesod/terminology.html).++This file is literate Haskell, so we'll start off with our language pragmas and import statements. Basically every Yesod application will start off like this:++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}+> import Yesod++Next, we'll define the blog entry information. Usually, we would want to store the data in a database and allow users to modify them, but we'll simplify for the moment.++> data Entry = Entry+> { entryTitle :: String+> , entrySlug :: String -- ^ used in the URL+> , entryContent :: String+> }++Since normally you'll need to perform an IO action to load up your entries from a database, we'll define the loadEntries function to be in the IO monad.++> loadEntries :: IO [Entry]+> loadEntries = return+> [ Entry "Entry 1" "entry-1" "My first entry"+> , Entry "Entry 2" "entry-2" "My second entry"+> , Entry "Entry 3" "entry-3" "My third entry"+> ]++Each Yesod application needs to define the site argument. You can use this for storing anything that should be loaded before running your application. For example, you might store a database connection there. In our case, we'll store our list of entries.++> data Blog = Blog { blogEntries :: [Entry] }++Now we use the first "magical" Yesod set of functions: mkYesod and parseRoutes. If you want to see *exactly* what they do, look at their Haddock docs. For now, we'll try to keep this tutorial simple:++> mkYesod "Blog" [$parseRoutes|+> / HomeR GET+> /entry/#String EntryR GET+> |]++Usually, the next thing you want to do after a call to mkYesod is to create an instance of Yesod. Every Yesod app needs this; it is a centralized place to define some settings. All settings but approot have sensible defaults. In general, you should put in a valid, fully-qualified URL for your approot, but you can sometimes get away with just doing this:++> instance Yesod Blog where approot _ = ""++This only works if you application is being served from the root of your webserver, and if you never use features like sitemaps and atom feeds that need absolute URLs.++We defined two resource patterns for our blog: the homepage, and the page for each entry. For each of these, we are allowing only the GET request method. For the homepage, we want to simply redirect to the most recent entry, so we'll use:++> getHomeR :: Handler Blog ()+> getHomeR = do+> Blog entries <- getYesod+> let newest = last entries+> redirect RedirectTemporary $ EntryR $ entrySlug newest++We go ahead and send a 302 redirect request to the entry resource. Notice how we at no point need to construct a String to redirect to; this is the beauty of type-safe URLs.++Next we'll define a template for entry pages. Normally, I tend to just define them within the handler function, but it's easier to follow if they're separate. Also for clarity, I'll define a datatype for the template arguments. It would also be possible to simply use the Entry datatype with some filter functions, but I'll save that for a later tutorial.++> data TemplateArgs = TemplateArgs+> { templateTitle :: Html ()+> , templateContent :: Html ()+> , templateNavbar :: [Nav]+> }++The Nav datatype will contain navigation information (ie, the URL and title) of each entry.++> data Nav = Nav+> { navUrl :: Route Blog+> , navTitle :: Html ()+> }++And now the template itself:++> entryTemplate :: TemplateArgs -> Hamlet (Route Blog)+> entryTemplate args = [$hamlet|+> !!!+> %html+> %head+> %title $templateTitle.args$+> %body+> %h1 Yesod Sample Blog+> %h2 $templateTitle.args$+> %ul#nav+> $forall templateNavbar.args nav+> %li+> %a!href=@navUrl.nav@ $navTitle.nav$+> #content+> $templateContent.args$+> |]++Hopefully, that is fairly easy to follow; if not, please review the Hamlet documentation. Just remember that dollar signs mean Html variables, and at signs mean URLs.++Finally, the entry route handler:++> getEntryR :: String -> Handler Blog RepHtml+> getEntryR slug = do+> Blog entries <- getYesod+> case filter (\e -> entrySlug e == slug) entries of+> [] -> notFound+> (entry:_) -> do+> let nav = reverse $ map toNav entries+> let tempArgs = TemplateArgs+> { templateTitle = string $ entryTitle entry+> , templateContent = string $ entryContent entry+> , templateNavbar = nav+> }+> hamletToRepHtml $ entryTemplate tempArgs+> where+> toNav :: Entry -> Nav+> toNav e = Nav+> { navUrl = EntryR $ entrySlug e+> , navTitle = string $ entryTitle e+> }++All that's left now is the main function. Yesod is built on top of WAI, so you can use any WAI handler you wish. For the tutorials, we'll use the basicHandler that comes built-in with Yesod: it serves content via CGI if the appropriate environment variables are available, otherwise with simpleserver.++> main :: IO ()+> main = do+> entries <- loadEntries+> basicHandler 3000 $ Blog entries
+ yesod/tutorial/chat.lhs view
@@ -0,0 +1,126 @@+---+title: Chat -- Tutorials -- Yesod+---+**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**++OK, maybe chat is a little over-reaching for this tutorial... but I like typing less, and chat is shorter than message board ;).++In this tutorial, we'll create an app that let's you log in and add messages. The server will display all messages to logged-in users.++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}+> import Yesod+> import Yesod.Helpers.Auth+> import Control.Concurrent.MVar+> import Data.Monoid (mempty)++> data Message = Message+> { messageAuthor :: String+> , messageContent :: String+> }++Since we want to alter the list of messages, we're going to need a mutable variable. Note that this application- for simplicity- does not store any information on disk, so you'll lose your history on a server restart.++> data Chat = Chat+> { chatMsgs :: MVar [Message]+> , chatAuth :: Auth+> }++Yesod comes baked in with three different authentication methods: OpenId, Rpxnow and e-mail based. For those not familiar with Rpxnow, it's a service that makes it easy to log in through multiple backends, such as Google, Twitter, Yahoo, etc.++The e-mail method allows users to register an e-mail address, get a verification key by e-mail, set password and log in. As you might imagine, this requires some setup in general: usually, you'll have to add some database tables and configure e-mail sending. For testing, Yesod includes inMemoryEmailSettings, which uses an in-memory database and simply outputs verification information to standard error.++> loadChat :: IO Chat+> loadChat = do+> msgs <- newMVar []+> aes <- inMemoryEmailSettings+> return $ Chat msgs Auth+> { authIsOpenIdEnabled = True+> , authRpxnowApiKey = Just "c8043882f14387d7ad8dfc99a1a8dab2e028f690"+> , authEmailSettings = Just aes+> , authFacebook = Just ("134280699924829", "a7685e10c8977f5435e599aaf1d232eb", ["email"])+> }++There are three resource patterns: the homepage, the auth subsite, and the messages page. When you GET the messages page, it will give you the history. POSTing will allow you to add a message. The homepage will have login information.++> mkYesod "Chat" [$parseRoutes|+> / HomeR GET+> /auth AuthR Auth chatAuth+> /messages MessagesR GET POST+> |]++And now let's hit the typeclasses; as usual, we need the Yesod typeclass. Now, we'll also add the YesodAuth typeclass. Like Yesod, it provides default values when possible. Since we need to provide a return URL for OpenID, we now need a valid value for approot instead of just an empty string.++> instance Yesod Chat where+> approot _ = "http://localhost:3000"++> instance YesodAuth Chat where+> defaultDest _ = MessagesR+> defaultLoginRoute _ = HomeR++This basically says "send users to MessagesR on login, and to HomeR when they *need* to login."++Now we'll write the homepage; that funny iframe bit at the bottom comes straight from RPXnow.++> getHomeR :: Handler Chat RepHtml+> getHomeR = applyLayout "Chat Home" mempty [$hamlet|+> %h1 OpenID+> %form!action=@AuthR.OpenIdForward@+> %input!type=text!name=openid+> %input!type=submit!value=Login+> %h1 Email (well, sort of)+> %form!method=post!action=@AuthR.EmailRegisterR@+> %input!type=email!name=email+> %input!type=submit!value=Register+> %h1 Facebook+> %a!href=@AuthR.StartFacebookR@ Facebook Connect+> %h1 Rpxnow+> <iframe src="http://yesod-test.rpxnow.com/openid/embed?token_url=@AuthR.RpxnowR@" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px"></iframe>+> |]++Next, we'll write the GET handler for messages. We use the "requireCreds" to get the user's credentials. If the user it not logged in, they are redirected to the homepage.++> getMessagesR :: Handler Chat RepHtml+> getMessagesR = do+> creds <- requireCreds -- now we know we're logged in+> msgs' <- chatMsgs `fmap` getYesod+> msgs <- liftIO $ readMVar msgs'+> hamletToRepHtml $ template msgs creds+> where+> template msgs creds = [$hamlet|+> !!!+> %html+> %head+> %title Silly Chat Server+> %body+> %p Logged in as $credsIdent.creds$+> %p Your full creds: $show.creds$+> %form!method=post!action=@MessagesR@+> Enter your message: +> %input!type=text!name=message!width=400+> %input!type=submit+> %h1 Messages+> %dl+> $forall msgs msg+> %dt $messageAuthor.msg$+> %dd $messageContent.msg$+> |]++Pretty straight-forward. Now we'll add the post handler.++> postMessagesR :: Handler Chat ()+> postMessagesR = do+> creds <- requireCreds -- now we know we're logged in+> message <- runFormPost' $ stringInput "message"+> msgs <- chatMsgs `fmap` getYesod+> let msg = Message (credsIdent creds) message+> liftIO $ modifyMVar_ msgs $ return . (:) msg+> redirect RedirectTemporary MessagesR++This includes a minor introduction to the Yesod.Form module. The second line in the do block essentially says to get the "message" POST parameter; there must be precisely one parameter and cannot be empty (ie, ""). The modifyMVar_ line simply tacks the new message onto the message MVar, and then we redirect to view the messages.++Finally, we'll do our standard main function.++> main :: IO ()+> main = do+> chat <- loadChat+> basicHandler 3000 chat
+ yesod/tutorial/file-echo.lhs view
@@ -0,0 +1,29 @@+**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}++> import Yesod+> import Data.Monoid (mempty)++> data Echo = Echo++> mkYesod "Echo" [$parseRoutes|+> / Homepage GET POST+> |]++> instance Yesod Echo where approot _ = ""++> getHomepage = applyLayout "Upload a file" mempty [$hamlet|+> %form!method=post!action=.!enctype=multipart/form-data+> File name:+> %input!type=file!name=file+> %input!type=submit+> |]++> postHomepage = do+> rr <- getRequest+> (_, files) <- liftIO $ reqRequestBody rr+> fi <- maybe notFound return $ lookup "file" files+> return [(fileContentType fi, toContent $ fileContent fi)]++> main = basicHandler 3000 Echo
+ yesod/tutorial/i18n.lhs view
@@ -0,0 +1,53 @@+---+title: Multi-lingual -- Tutorials -- Yesod+---+**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**++> {-# LANGUAGE QuasiQuotes #-}+> {-# LANGUAGE TemplateHaskell #-}+> {-# LANGUAGE TypeFamilies #-}++> import Yesod+> import Data.Monoid (mempty)++> data I18N = I18N++> mkYesod "I18N" [$parseRoutes|+> / HomepageR GET+> /set/#String SetLangR GET+> |]++> instance Yesod I18N where+> approot _ = "http://localhost:3000"++> getHomepageR :: Handler I18N RepHtml+> getHomepageR = do+> ls <- languages+> let hello = chooseHello ls+> let choices =+> [ ("en", "English")+> , ("es", "Spanish")+> , ("he", "Hebrew")+> ]+> applyLayout "I18N Homepage" mempty [$hamlet|+> %h1 $hello$+> %p In other languages:+> %ul+> $forall choices choice+> %li+> %a!href=@SetLangR.fst.choice@ $snd.choice$+> |]++> chooseHello :: [String] -> String+> chooseHello [] = "Hello"+> chooseHello ("he":_) = "שלום"+> chooseHello ("es":_) = "Hola"+> chooseHello (_:rest) = chooseHello rest++> getSetLangR :: String -> Handler I18N ()+> getSetLangR lang = do+> setLanguage lang+> redirect RedirectTemporary HomepageR++> main :: IO ()+> main = basicHandler 3000 I18N
+ yesod/tutorial/pretty-yaml.lhs view
@@ -0,0 +1,68 @@+---+title: Pretty YAML -- Tutorials -- Yesod+---+**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**++This example uses the [data-object-yaml package](http://hackage.haskell.org/package/data-object-yaml) to display YAML files as cleaned-up HTML. If you've read through the other tutorials, this one should be easy to follow.++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}++> import Yesod+> import Data.Object+> import Data.Object.Yaml+> import qualified Data.ByteString as B+> import qualified Data.ByteString.Lazy as L++> data PY = PY++> mkYesod "PY" [$parseRoutes|+> / Homepage GET POST+> |]++> instance Yesod PY where approot _ = ""++> template :: Maybe (Hamlet url) -> Hamlet url+> template myaml = [$hamlet|+> !!!+> %html+> %head+> %meta!charset=utf-8+> %title Pretty YAML+> %body+> %form!method=post!action=.!enctype=multipart/form-data+> File name:+> %input!type=file!name=yaml+> %input!type=submit+> $maybe myaml yaml+> %div ^yaml^+> |]++> getHomepage :: Handler PY RepHtml+> getHomepage = hamletToRepHtml $ template Nothing++> postHomepage :: Handler PY RepHtml+> postHomepage = do+> rr <- getRequest+> (_, files) <- liftIO $ reqRequestBody rr+> fi <- case lookup "yaml" files of+> Nothing -> invalidArgs ["yaml: Missing input"]+> Just x -> return x+> so <- liftIO $ decode $ B.concat $ L.toChunks $ fileContent fi+> hamletToRepHtml $ template $ Just $ objToHamlet so++> objToHamlet :: StringObject -> Hamlet url+> objToHamlet (Scalar s) = [$hamlet|$s$|]+> objToHamlet (Sequence list) = [$hamlet|+> %ul+> $forall list o+> %li ^objToHamlet.o^+> |]+> objToHamlet (Mapping pairs) = [$hamlet|+> %dl+> $forall pairs pair+> %dt $fst.pair$+> %dd ^objToHamlet.snd.pair^+> |]++> main :: IO ()+> main = basicHandler 3000 PY
+ yesod/tutorial/session.lhs view
@@ -0,0 +1,32 @@+**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}+> import Yesod+> import Control.Applicative ((<$>), (<*>))+> +> data Session = Session+> mkYesod "Session" [$parseRoutes|+> / Root GET POST+> |]+> getRoot :: Handler Session RepHtml+> getRoot = do+> sess <- reqSession `fmap` getRequest+> hamletToRepHtml [$hamlet|+> %form!method=post+> %input!type=text!name=key+> %input!type=text!name=val+> %input!type=submit+> %h1 $show.sess$+> |]+> +> postRoot :: Handler Session ()+> postRoot = do+> (key, val) <- runFormPost' $ (,) <$> stringInput "key" <*> stringInput "val"+> setSession key val+> liftIO $ print (key, val)+> redirect RedirectTemporary Root+> +> instance Yesod Session where+> approot _ = ""+> clientSessionDuration _ = 1+> main = basicHandler 3000 Session
+ yesod/tutorial/widgets.lhs view
@@ -0,0 +1,77 @@+> {-# LANGUAGE TypeFamilies, QuasiQuotes #-}+> import Yesod+> import Yesod.Widget+> import Yesod.Helpers.Static+> import Control.Applicative+> +> data HW = HW { hwStatic :: Static }+> mkYesod "HW" [$parseRoutes|+> / RootR GET+> /form FormR+> /static StaticR Static hwStatic+> /autocomplete AutoCompleteR GET+> |]+> instance Yesod HW where approot _ = ""+> wrapper h = [$hamlet|+> #wrapper ^h^+> %footer Brought to you by Yesod Widgets™+> |]+> getRootR = applyLayoutW $ flip wrapWidget wrapper $ do+> i <- newIdent+> setTitle $ string "Hello Widgets"+> addStyle [$hamlet|\#$i${color:red}|]+> addStylesheet $ StaticR $ StaticRoute ["style.css"]+> addStylesheetRemote "http://localhost:3000/static/style2.css"+> addScriptRemote "http://ajax.googleapis.com/ajax/libs/jquery/1.4.2/jquery.min.js"+> addScript $ StaticR $ StaticRoute ["script.js"]+> addBody [$hamlet|+> %h1#$i$ Welcome to my first widget!!!+> %p+> %a!href=@RootR@ Recursive link.+> %p+> %a!href=@FormR@ Check out the form.+> %p.noscript Your script did not load. :(+> |]+> addHead [$hamlet|%meta!keywords=haskell|]+> +> handleFormR = do+> (res, form, enctype) <- runFormPost $ (,,,,,,,,)+> <$> stringField (string "My Field") (string "Some tooltip info") Nothing+> <*> stringField (string "Another field") (string "") (Just "some default text")+> <*> intField (string "A number field") (string "some nums") (Just 5)+> <*> jqueryDayField (string "A day field") (string "") Nothing+> <*> timeField (string "A time field") (string "") Nothing+> <*> boolField (string "A checkbox") (string "") (Just False)+> <*> jqueryAutocompleteField AutoCompleteR+> (string "Autocomplete") (string "Try it!") Nothing+> <*> nicHtmlField (string "HTML") (string "")+> (Just $ string "You can put rich text here")+> <*> maybeEmailField (string "An e-mail addres") mempty Nothing+> let mhtml = case res of+> FormSuccess (_, _, _, _, _, _, _, x, _) -> Just x+> _ -> Nothing+> applyLayoutW $ do+> addStyle [$hamlet|\.tooltip{color:#666;font-style:italic}|]+> addStyle [$hamlet|textarea.html{width:300px;height:150px};|]+> wrapWidget (fieldsToTable form) $ \h -> [$hamlet|+> %form!method=post!enctype=$show.enctype$+> %table+> ^h^+> %tr+> %td!colspan=2+> %input!type=submit+> $maybe mhtml html+> $html$+> |]+> setTitle $ string "Form"+> +> main = basicHandler 3000 $ HW $ fileLookupDir "static" typeByExt+> +> getAutoCompleteR :: Handler HW RepJson+> getAutoCompleteR = do+> term <- runFormGet' $ stringInput "term"+> jsonToRepJson $ jsonList+> [ jsonScalar $ string $ term ++ "foo"+> , jsonScalar $ string $ term ++ "bar"+> , jsonScalar $ string $ term ++ "baz"+> ]