diff --git a/yesod-examples/.gitignore b/yesod-examples/.gitignore new file mode 100644 index 00000000..47451091 --- /dev/null +++ b/yesod-examples/.gitignore @@ -0,0 +1,2 @@ +client_session_key.aes +dist diff --git a/yesod-examples/LICENSE b/yesod-examples/LICENSE new file mode 100644 index 00000000..b0140c5d --- /dev/null +++ b/yesod-examples/LICENSE @@ -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. diff --git a/yesod-examples/README b/yesod-examples/README new file mode 100644 index 00000000..e69de29b diff --git a/yesod-examples/Setup.hs b/yesod-examples/Setup.hs new file mode 100644 index 00000000..cd7dc327 --- /dev/null +++ b/yesod-examples/Setup.hs @@ -0,0 +1,3 @@ +#!/usr/bin/env runhaskell +import Distribution.Simple +main = defaultMain diff --git a/yesod-examples/src/MkToForm2.hs b/yesod-examples/src/MkToForm2.hs new file mode 100644 index 00000000..1cedbeb5 --- /dev/null +++ b/yesod-examples/src/MkToForm2.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TypeFamilies, QuasiQuotes, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +module MkToForm2 where + +import Yesod +import Data.Time (Day) + +mkPersist [$persist| +Entry + title String + day Day Desc toFormField=YesodJquery.jqueryDayField' + content Html toFormField=YesodNic.nicHtmlField + deriving +|] diff --git a/yesod-examples/src/ajax.lhs b/yesod-examples/src/ajax.lhs new file mode 100644 index 00000000..7bbfaec9 --- /dev/null +++ b/yesod-examples/src/ajax.lhs @@ -0,0 +1,112 @@ +

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, MultiParamTypeClasses, OverloadedStrings #-} +> import Yesod +> import Yesod.Helpers.Static +> import Data.Monoid (mempty) + +Like the blog example, 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 +> } +> type Handler = GHandler Ajax Ajax + +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 widget = do +> Ajax pages _ <- getYesod +> content <- widgetToPageContent widget +> hamletToRepHtml [$hamlet| +> \ +> +> +> +> #{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 id="navbar"> +> $forall page <- pages +> <li> +> <a href="@{PageR (pageSlug page)}">#{pageName page} +> <div id="content"> +> \^{pageBody content} +> |] + +<p>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 <a href="/static/yesod/ajax/style.css">style.css</a> and <a href="/static/yesod/ajax/script.js">script.js</a> files, so I won't describe them here.</p> + +<p>Now we need our handler functions. We'll have the homepage simply redirect to the first page, so:</p> + +> getHomeR :: Handler () +> 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 RepHtmlJson +> getPageR slug = do +> Ajax pages _ <- getYesod +> case filter (\e -> pageSlug e == slug) pages of +> [] -> notFound +> page:_ -> defaultLayoutJson (do +> setTitle $ string $ pageName page +> addHamlet $ html page +> ) (json page) +> where +> html page = [$hamlet| +> <h1>#{pageName page} +> <article>#{pageContent page} +> |] +> json page = jsonMap +> [ ("name", jsonScalar $ pageName page) +> , ("content", jsonScalar $ 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>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.</p> + +<p>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.</p> + +> main :: IO () +> main = do +> pages <- loadPages +> let s = static "static/yesod/ajax" +> warpDebug 3000 $ Ajax pages s diff --git a/yesod-examples/src/blog.lhs b/yesod-examples/src/blog.lhs new file mode 100644 index 00000000..16ba08b6 --- /dev/null +++ b/yesod-examples/src/blog.lhs @@ -0,0 +1,117 @@ +<p>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 <a href="/book/basics">reading the basics chapter</a>.</p> + +<p>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:</p> + +> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} +> 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] } +> type Handler = GHandler Blog Blog + +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 () +> 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 id="nav"> +> $forall nav <- templateNavbar args +> <li> +> <a href="@{navUrl nav}">#{navTitle nav} +> <div id="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 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 = toHtml $ entryTitle entry +> , templateContent = toHtml $ entryContent entry +> , templateNavbar = nav +> } +> hamletToRepHtml $ entryTemplate tempArgs +> where +> toNav :: Entry -> Nav +> toNav e = Nav +> { navUrl = EntryR $ entrySlug e +> , navTitle = toHtml $ 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 +> warpDebug 3000 $ Blog entries diff --git a/yesod-examples/src/chat.hs b/yesod-examples/src/chat.hs new file mode 100644 index 00000000..b02a47fc --- /dev/null +++ b/yesod-examples/src/chat.hs @@ -0,0 +1,125 @@ +{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import Yesod +import Yesod.Helpers.Static + +import Control.Concurrent.STM +import Control.Concurrent.STM.TChan +import Control.Concurrent.STM.TVar + +import Control.Arrow ((***)) +import Data.Text (Text, unpack) + +-- speaker and content +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 +data Chat = Chat + { chatClients :: TVar [(Int, TChan Message)] + , nextClient :: TVar Int + , chatStatic :: Static + } + +staticFiles "static" + +mkYesod "Chat" [$parseRoutes| +/ HomeR GET +/check CheckR GET +/post PostR GET +/static StaticR Static chatStatic +|] + +instance Yesod Chat where + approot _ = "" + defaultLayout widget = do + content <- widgetToPageContent widget + hamletToRepHtml [$hamlet|\ + \<!DOCTYPE html> + + <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 Chat RepHtml +getHomeR = do + Chat clients next _ <- getYesod + client <- liftIO . atomically $ do + c <- readTVar next + writeTVar next (c+1) + cs <- readTVar clients + chan <- case cs of + [] -> newTChan + (_,x):_ -> dupTChan x + writeTVar clients ((c,chan) : cs) + return c + defaultLayout $ do + setTitle "Chat Page" + addWidget [$hamlet|\ +\<!DOCTYPE html> + +<h1>Chat Example +<form> + <textarea cols="80" rows="20" name="chat"> + <p> + <input type="text" size="15" name="name" id="name"> + <input type="text" size="60" name="send" id="send"> + <input type="submit" value="Send"> +<script>var clientNumber = #{show client} +|] + +getCheckR :: Handler Chat RepJson +getCheckR = do + liftIO $ putStrLn "Check" + Chat clients _ _ <- getYesod + client <- do + c <- lookupGetParam "client" + case c of + Nothing -> invalidArgs ["No client value in Check request"] + Just c' -> return $ read $ unpack c' + cs <- liftIO . atomically $ readTVar clients + chan <- case lookup client cs of + Nothing -> invalidArgs ["Bad client value"] + Just ch -> return ch + -- block until there's something there + first <- liftIO . atomically $ readTChan chan + let Message s c = first + jsonToRepJson $ zipJson ["sender", "content"] [s,c] + +zipJson x y = jsonMap $ map (unpack *** jsonScalar . unpack) $ zip x y + +getPostR :: Handler Chat RepJson +getPostR = do + liftIO $ putStrLn "Post" + Chat clients _ _ <- getYesod + (sender,content) <- do + s <- lookupGetParam "name" + c <- lookupGetParam "send" + case (s,c) of + (Just s', Just c') -> return (s', c') + _ -> invalidArgs ["Either name or send not provided."] + liftIO . atomically $ do + cs <- readTVar clients + let chan = snd . head $ cs -- doesn't matter which one we use, they're all duplicates + writeTChan chan (Message sender content) + + jsonToRepJson $ jsonScalar "success" + +main :: IO () +main = do + clients <- newTVarIO [] + next <- newTVarIO 0 + warpDebug 3000 $ Chat clients next $ static "static" diff --git a/yesod-examples/src/file-echo.lhs b/yesod-examples/src/file-echo.lhs new file mode 100644 index 00000000..dfbb1299 --- /dev/null +++ b/yesod-examples/src/file-echo.lhs @@ -0,0 +1,30 @@ +> {-# 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 + +> data Echo = Echo + +> mkYesod "Echo" [$parseRoutes| +> / Homepage GET POST +> |] + +> instance Yesod Echo where approot _ = "" + +> getHomepage = defaultLayout $ do +> setTitle $ string "Upload a file" +> addHamlet [$hamlet| +> %form!method=post!action=.!enctype=multipart/form-data +> File name: +> %input!type=file!name=file +> %input!type=submit +> |] + +> postHomepage = do +> (_, files) <- runRequestBody +> fi <- maybe notFound return $ lookup "file" files +> return [(S8.pack $ T.unpack $ fileContentType fi, toContent $ fileContent fi)] + +> main = warpDebug 3000 Echo diff --git a/yesod-examples/src/form.lhs b/yesod-examples/src/form.lhs new file mode 100644 index 00000000..a9d8d14d --- /dev/null +++ b/yesod-examples/src/form.lhs @@ -0,0 +1,50 @@ +<p>Forms can be a tedious part of web development since they require synchronization of code in many different areas: the HTML form declaration, parsing of the form and reconstructing a datatype from the raw values. The Yesod form library simplifies things greatly. We'll start off with a basic application.</p> + + +> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-} +> import Yesod +> import Control.Applicative +> import Data.Text (Text) + +> data FormExample = FormExample +> type Handler = GHandler FormExample FormExample +> mkYesod "FormExample" [$parseRoutes| +> / RootR GET +> |] +> instance Yesod FormExample where approot _ = "" + +Next, we'll declare a Person datatype with a name and age. After that, we'll create a formlet. A formlet is a declarative approach to forms. It takes a Maybe value and constructs either a blank form, a form based on the original value, or a form based on the values submitted by the user. It also attempts to construct a datatype, failing on validation errors. + +> data Person = Person { name :: Text, age :: Int } +> deriving Show +> personFormlet p = fieldsToTable $ Person +> <$> stringField "Name" (fmap name p) +> <*> intField "Age" (fmap age p) + +We use an applicative approach and stay mostly declarative. The "fmap name p" bit is just a way to get the name from within a value of type "Maybe Person". + +> getRootR :: Handler RepHtml +> getRootR = do +> (res, wform, enctype) <- runFormGet $ personFormlet Nothing + +<p>We use runFormGet to bind to GET (query-string) parameters; we could also use runFormPost. The "Nothing" is the initial value of the form. You could also supply a "Just Person" value if you like. There is a three-tuple returned, containing the parsed value, the HTML form as a widget and the encoding type for the form.</p> + +<p>We use a widget for the form since it allows embedding CSS and Javascript code in forms directly. This allows unobtrusive adding of rich Javascript controls like date pickers.</p> + +> defaultLayout $ do +> setTitle "Form Example" +> form <- extractBody wform + +<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| +> <p>Last result: #{show res} +> <form enctype="#{enctype}"> +> <table> +> \^{form} +> <tr> +> <td colspan="2"> +> <input type="submit"> +> |] +> +> main = warpDebug 3000 FormExample diff --git a/yesod-examples/src/generalized-hamlet.lhs b/yesod-examples/src/generalized-hamlet.lhs new file mode 100644 index 00000000..d7a5f490 --- /dev/null +++ b/yesod-examples/src/generalized-hamlet.lhs @@ -0,0 +1,52 @@ +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 + +* Hamlet url (= (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 +> data NewHamlet = NewHamlet +> mkYesod "NewHamlet" [$parseRoutes|/ RootR GET|] +> instance Yesod NewHamlet where approot _ = "" +> type Widget = GWidget NewHamlet NewHamlet +> +> myHtml :: Html +> myHtml = [$hamlet|<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 :: Hamlet NewHamletRoute +> myPlainTemplate = [$hamlet| +> <p +> <a href=@{RootR}>Link to home +> |] +> +> myWidget :: Widget () +> myWidget = [$hamlet| +> <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 diff --git a/yesod-examples/src/i18n.lhs b/yesod-examples/src/i18n.lhs new file mode 100644 index 00000000..37db3042 --- /dev/null +++ b/yesod-examples/src/i18n.lhs @@ -0,0 +1,54 @@ +> {-# LANGUAGE QuasiQuotes #-} +> {-# LANGUAGE TemplateHaskell #-} +> {-# LANGUAGE TypeFamilies #-} +> {-# LANGUAGE MultiParamTypeClasses #-} +> {-# LANGUAGE OverloadedStrings #-} + +> import Yesod +> import Data.Monoid (mempty) +> import Data.Text (Text) + +> data I18N = I18N +> type Handler = GHandler I18N I18N + +> mkYesod "I18N" [$parseRoutes| +> / HomepageR GET +> /set/#Text SetLangR GET +> |] + +> instance Yesod I18N where +> approot _ = "http://localhost:3000" + +> getHomepageR :: Handler RepHtml +> getHomepageR = do +> ls <- languages +> let hello = chooseHello ls +> let choices = +> [ ("en", "English") :: (Text, Text) +> , ("es", "Spanish") +> , ("he", "Hebrew") +> ] +> defaultLayout $ do +> setTitle "I18N Homepage" +> addHamlet [$hamlet| +> <h1>#{hello} +> <p>In other languages: +> <ul> +> $forall choice <- choices +> <li> +> <a href="@{SetLangR (fst choice)}">#{snd choice} +> |] + +> chooseHello :: [Text] -> Text +> chooseHello [] = "Hello" +> chooseHello ("he":_) = "Shalom" +> chooseHello ("es":_) = "Hola" +> chooseHello (_:rest) = chooseHello rest + +> getSetLangR :: Text -> Handler () +> getSetLangR lang = do +> setLanguage lang +> redirect RedirectTemporary HomepageR + +> main :: IO () +> main = warpDebug 3000 I18N diff --git a/yesod-examples/src/pretty-yaml.lhs b/yesod-examples/src/pretty-yaml.lhs new file mode 100644 index 00000000..97f69682 --- /dev/null +++ b/yesod-examples/src/pretty-yaml.lhs @@ -0,0 +1,64 @@ +<p>This example uses the <a href="http://hackage.haskell.org/package/data-object-yaml">data-object-yaml package</a> to display YAML files as cleaned-up HTML. If you've read through the other tutorials, this one should be easy to follow.</p> + +> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} + +> 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 +> type Handler = GHandler 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 yaml <- myaml +> <div>^{yaml} +> |] + +> getHomepage :: Handler RepHtml +> getHomepage = hamletToRepHtml $ template Nothing + +> postHomepage :: Handler RepHtml +> postHomepage = do +> (_, files) <- runRequestBody +> 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 o <- list +> <li>^{objToHamlet o} +> |] +> objToHamlet (Mapping pairs) = [$hamlet| +> <dl +> $forall pair <- pairs +> <dt>#{fst pair} +> <dd>^{objToHamlet $ snd pair} +> |] + +> main :: IO () +> main = warpDebug 3000 PY diff --git a/yesod-examples/src/session.lhs b/yesod-examples/src/session.lhs new file mode 100644 index 00000000..9977bd04 --- /dev/null +++ b/yesod-examples/src/session.lhs @@ -0,0 +1,31 @@ +> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} +> import Yesod +> import Control.Applicative ((<$>), (<*>)) +> +> data Session = Session +> type Handler = GHandler Session Session +> mkYesod "Session" [$parseRoutes| +> / Root GET POST +> |] +> getRoot :: Handler RepHtml +> getRoot = do +> sess <- getSession +> hamletToRepHtml [$hamlet| +> <form method=post +> <input type=text name=key +> <input type=text name=val +> <input type=submit +> <h1>#{show sess} +> |] +> +> postRoot :: Handler () +> 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 = warpDebug 3000 Session diff --git a/yesod-examples/src/tmp.hamlet b/yesod-examples/src/tmp.hamlet new file mode 100644 index 00000000..e69de29b diff --git a/yesod-examples/src/widgets.lhs b/yesod-examples/src/widgets.lhs new file mode 100644 index 00000000..cfa2b449 --- /dev/null +++ b/yesod-examples/src/widgets.lhs @@ -0,0 +1,89 @@ +> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-} +> import Yesod +> import Yesod.Helpers.Static +> import Yesod.Form.Jquery +> import Yesod.Form.Nic +> import Control.Applicative +> import Data.Text (unpack) +> +> data HW = HW { hwStatic :: Static } +> type Handler = GHandler HW HW +> mkYesod "HW" [$parseRoutes| +> / RootR GET +> /form FormR +> /static StaticR Static hwStatic +> /autocomplete AutoCompleteR GET +> |] +> instance Yesod HW where approot _ = "" +> instance YesodJquery HW +> instance YesodNic HW +> wrapper h = [$hamlet| +> <#wrapper>^{h} +> <footer>Brought to you by Yesod Widgets™ +> |] +> getRootR = defaultLayout $ wrapper $ do +> i <- lift newIdent +> setTitle $ string "Hello Widgets" +> addCassius [$cassius| +> #$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"] [] +> addHamlet [$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. :( +> |] +> addHtmlHead [$hamlet|<meta keywords=haskell|] +> +> handleFormR = do +> (res, form, enctype, nonce) <- runFormPost $ fieldsToTable $ (,,,,,,,,) +> <$> stringField "My Field" Nothing +> <*> stringField "Another field" (Just "some default text") +> <*> intField "A number field" (Just 5) +> <*> jqueryDayField def "A day field" Nothing +> <*> timeField "A time field" Nothing +> <*> boolField "A checkbox" (Just False) +> <*> jqueryAutocompleteField AutoCompleteR "Autocomplete" Nothing +> <*> nicHtmlField "HTML" +> (Just $ string "You can put <rich text> here") +> <*> maybeEmailField "An e-mail addres" Nothing +> let mhtml = case res of +> FormSuccess (_, _, _, _, _, _, _, x, _) -> Just x +> _ -> Nothing +> defaultLayout $ do +> addCassius [$cassius| +> .tooltip +> color: #666 +> font-style: italic +> textarea.html +> width: 300px +> height: 150px|] +> addWidget [$hamlet| +> <form method="post" enctype="#{enctype}"> +> <table> +> \^{form} +> <tr> +> <td colspan="2"> +> \#{nonce} +> <input type="submit"> +> $maybe html <- mhtml +> \#{html} +> |] +> setTitle $ string "Form" +> +> main = warpDebug 3000 $ HW $ static "static" +> +> getAutoCompleteR :: Handler RepJson +> getAutoCompleteR = do +> term <- runFormGet' $ stringInput "term" +> jsonToRepJson $ jsonList +> [ jsonScalar $ unpack term ++ "foo" +> , jsonScalar $ unpack term ++ "bar" +> , jsonScalar $ unpack term ++ "baz" +> ] diff --git a/yesod-examples/static/chat.js b/yesod-examples/static/chat.js new file mode 100644 index 00000000..3959f93c --- /dev/null +++ b/yesod-examples/static/chat.js @@ -0,0 +1,21 @@ +$(document).ready(function () { + $("form").submit(function (e) { + e.preventDefault(); + $.getJSON("/post", { name: $("#name").attr("value"), send: $("#send").attr("value") }, function(o) { }); + $("#send").attr("value", ""); + }); + + checkIn(); + +}); + +function checkIn () { + $.getJSON("/check", { client: clientNumber }, function(o) { + //alert("response: " + o); + var ta = $("textarea"); + ta.html(ta.html() + o.sender + ": " + o.content + "\n"); + ta.scrollTop(10000); + + checkIn(); + }); +} diff --git a/yesod-examples/static/yesod/ajax/script.js b/yesod-examples/static/yesod/ajax/script.js new file mode 100644 index 00000000..2ddfba79 --- /dev/null +++ b/yesod-examples/static/yesod/ajax/script.js @@ -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; + }); +}); diff --git a/yesod-examples/static/yesod/ajax/style.css b/yesod-examples/static/yesod/ajax/style.css new file mode 100644 index 00000000..6c780186 --- /dev/null +++ b/yesod-examples/static/yesod/ajax/style.css @@ -0,0 +1,11 @@ +#navbar { + width: 100px; + float: left; + background: #eee; + padding: 1em; + list-style: none; +} + +#content { + margin-left: 230px; +} diff --git a/yesod-examples/synopsis/hamlet.lhs b/yesod-examples/synopsis/hamlet.lhs new file mode 100644 index 00000000..7f3e2b05 --- /dev/null +++ b/yesod-examples/synopsis/hamlet.lhs @@ -0,0 +1,72 @@ +\begin{code} +{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} + +import Text.Hamlet +import qualified Data.ByteString.Lazy as L +import Data.Text (Text, cons) + +data Person = Person + { name :: String + , age :: String + , page :: PersonUrls + , isMarried :: Bool + , children :: [String] + } +data PersonUrls = Homepage | PersonPage Text + +renderUrls :: PersonUrls -> [(Text, Text)] -> Text +renderUrls Homepage _ = "/" +renderUrls (PersonPage name) _ = '/' `cons` name + +footer :: Hamlet url +footer = [$hamlet|\ +<div id="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 child <- children person + <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> diff --git a/yesod-examples/synopsis/persistent.lhs b/yesod-examples/synopsis/persistent.lhs new file mode 100644 index 00000000..c0eb27c9 --- /dev/null +++ b/yesod-examples/synopsis/persistent.lhs @@ -0,0 +1,39 @@ +This example uses the sqlite backend for Persistent, since it can run in-memory and has no external dependencies. + +> {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, QuasiQuotes, TemplateHaskell, OverloadedStrings #-} +> +> import Database.Persist.Sqlite +> import Database.Persist.TH +> import Control.Monad.IO.Class (liftIO) +> +> mkPersist [$persist|Person +> name String Eq +> age Int Update +> |] +> +> main :: IO () +> main = withSqliteConn ":memory:" $ runSqlConn go +> +> go :: SqlPersist IO () +> go = do +> runMigration $ migrate (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 <- selectList [PersonNameEq "Michael"] [] 0 0 +> liftIO $ print p3 +> delete key +> p4 <- selectList [PersonNameEq "Michael"] [] 0 0 +> liftIO $ print p4 + +The output of the above is: + +<code><pre>PersonId 1 +Just (Person {personName = "Michael", personAge = 25}) +Just (Person {personName = "Michael", personAge = 26}) +[(PersonId 1,Person {personName = "Michael", personAge = 26})] +[]</pre></code> diff --git a/yesod-examples/yesod-examples.cabal b/yesod-examples/yesod-examples.cabal new file mode 100644 index 00000000..661640e0 --- /dev/null +++ b/yesod-examples/yesod-examples.cabal @@ -0,0 +1,69 @@ +Name: yesod-examples +Version: 0.8.0.3 +Synopsis: Example programs using the Yesod Web Framework. +Description: These are the same examples and tutorials found on the documentation site. +Homepage: http://www.yesodweb.com/ +License: BSD3 +License-file: LICENSE +Author: Michael Snoyman +Maintainer: michael@snoyman.com +Stability: Experimental +Category: Web, Yesod +Build-type: Simple +Cabal-version: >=1.6 +extra-source-files: static/yesod/ajax/script.js, + static/yesod/ajax/style.css, + static/chat.js + +Executable yesod-blog + Main-is: src/blog.lhs + Build-depends: base >= 4 && < 5, + yesod >= 0.8 && < 0.9 + +Executable yesod-ajax + Main-is: src/ajax.lhs + Build-depends: yesod-static + +Executable yesod-file-echo + Main-is: src/file-echo.lhs + Build-depends: text + +Executable yesod-pretty-yaml + Main-is: src/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 yesod-i18n + Main-is: src/i18n.lhs + +Executable yesod-session + Main-is: src/session.lhs + +Executable yesod-widgets + 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 + +Executable yesod-persistent-synopsis + Main-is: synopsis/persistent.lhs + Build-depends: transformers >= 0.2.1 && < 0.3, + persistent-sqlite, + persistent-template + +Executable yesod-hamlet-synopsis + Main-is: synopsis/hamlet.lhs + Build-depends: hamlet + +Executable yesod-chat + Main-is: src/chat.hs + Build-depends: stm + +source-repository head + type: git + location: git://github.com/snoyberg/yesod-examples.git