packages feed

yesod-examples 0.6.0.2 → 0.6.1

raw patch · 25 files changed

+835/−688 lines, 25 filesdep +stmnew-component:exe:chat

Dependencies added: stm

Files

+ src/MkToForm2.hs view
@@ -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+|]
+ src/ajax.lhs view
@@ -0,0 +1,111 @@+<p>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.</p>++<p>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.</p>++> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}+> 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+> |]++<p>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.</p>++<p>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.</p>++> instance Yesod Ajax where+>   approot _ = ""+>   defaultLayout widget = do+>   Ajax pages _ <- getYesod+>   content <- widgetToPageContent widget+>   hamletToRepHtml [$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^+> |]++<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 static = fileLookupDir "static/yesod/ajax" typeByExt+>   basicHandler 3000 $ Ajax pages static
+ src/blog.lhs view
@@ -0,0 +1,116 @@+<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.html">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 #-}+> 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#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 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
+ src/chat.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Yesod+import Yesod.Handler+import Yesod.Helpers.Static++import Control.Concurrent.STM+import Control.Concurrent.STM.TChan+import Control.Concurrent.STM.TVar++import Control.Arrow ((***))++-- speaker and content+data Message = Message String String++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|+    !!!+    %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|+!!!+%h1 Chat Example+%form+    %textarea!cols=80!rows=20!name=chat+    %p+        %input!type=text!size=15!name=name#name+        %input!type=text!size=60!name=send#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 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 (id *** jsonScalar) $ 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+  let static = fileLookupDir "static" typeByExt+  basicHandler 3000 $ Chat clients next static
+ src/file-echo.lhs view
@@ -0,0 +1,29 @@+> {-# 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 = 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+>   rr <- getRequest+>   (_, files) <- liftIO $ reqRequestBody rr+>   fi <- maybe notFound return $ lookup "file" files+>   return [(fileContentType fi, toContent $ fileContent fi)]++> main = basicHandler 3000 Echo
+ src/form.lhs view
@@ -0,0 +1,48 @@+<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 #-}+> import Yesod+> import Control.Applicative+> 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 :: String, 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 = basicHandler 3000 FormExample
+ src/generalized-hamlet.lhs view
@@ -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 #-}+> 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|+>   #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 = basicHandler 3000 NewHamlet
+ src/i18n.lhs view
@@ -0,0 +1,51 @@+> {-# LANGUAGE QuasiQuotes #-}+> {-# LANGUAGE TemplateHaskell #-}+> {-# LANGUAGE TypeFamilies #-}++> import Yesod+> import Data.Monoid (mempty)++> data I18N = I18N+> type Handler = GHandler I18N I18N++> mkYesod "I18N" [$parseRoutes|+> /            HomepageR GET+> /set/#String 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")+>             , ("es", "Spanish")+>             , ("he", "Hebrew")+>             ]+>     defaultLayout $ do+>       setTitle $ string "I18N Homepage"+>       addHamlet [$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 ()+> getSetLangR lang = do+>     setLanguage lang+>     redirect RedirectTemporary HomepageR++> main :: IO ()+> main = basicHandler 3000 I18N
+ src/mkToForm.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE TypeFamilies, QuasiQuotes, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+import Yesod+import Yesod.Helpers.Crud+import Yesod.Form.Jquery+import Yesod.Form.Nic+import Database.Persist.Sqlite+import Database.Persist.TH+import Data.Time (Day)+import MkToForm2++jqueryDayField' :: YesodJquery m => FormFieldSettings -> FormletField s m Day+jqueryDayField' = jqueryDayField def+mkToForm (undefined :: Entry)++instance Item Entry where+    itemTitle = entryTitle++data Blog = Blog { pool :: ConnectionPool }++type EntryCrud = Crud Blog Entry++mkYesod "Blog" [$parseRoutes|+/ RootR GET+/entry/#EntryId EntryR GET+/admin AdminR EntryCrud defaultCrud+|]++instance Yesod Blog where+    approot _ = "http://localhost:3000"++instance YesodPersist Blog where+    type YesodDB Blog = SqlPersist+    runDB db = fmap pool getYesod >>= runSqlPool db++instance YesodJquery Blog+instance YesodNic Blog++getRootR = do+    entries <- runDB $ selectList [] [EntryDayDesc] 0 0+    defaultLayout $ do+        setTitle $ string "Yesod Blog Tutorial Homepage"+        addHamlet [$hamlet|+%h1 Archive+%ul+    $forall entries entry+        %li+            %a!href=@EntryR.fst.entry@ $entryTitle.snd.entry$+%p+    %a!href=@AdminR.CrudListR@ Admin+|]++getEntryR entryid = do+    entry <- runDB $ get404 entryid+    defaultLayout $ do+        setTitle $ string $ entryTitle entry+        addHamlet [$hamlet|+%h1 $entryTitle.entry$+%h2 $show.entryDay.entry$+$entryContent.entry$+|]++withBlog f = withSqlitePool "blog.db3" 8 $ \pool -> do+    flip runSqlPool pool $ runMigration $ do+        migrate (undefined :: Entry)+    f $ Blog pool++main = withBlog $ basicHandler 3000
+ src/pretty-yaml.lhs view
@@ -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 #-}++> 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 myaml yaml+>             %div ^yaml^+> |]++> getHomepage :: Handler RepHtml+> getHomepage = hamletToRepHtml $ template Nothing++> postHomepage :: Handler 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
+ src/session.lhs view
@@ -0,0 +1,31 @@+> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}+> 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 = basicHandler 3000 Session
+ src/widgets.lhs view
@@ -0,0 +1,89 @@+> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings #-}+> import Yesod+> import Yesod.Widget+> import Yesod.Helpers.Static+> import Yesod.Form.Jquery+> import Yesod.Form.Nic+> import Control.Applicative+> +> 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&trade;+> |]+> getRootR = defaultLayout $ wrapper $ do+>     i <- 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 mhtml html+>         $html$+> |]+>         setTitle $ string "Form"+> +> main = basicHandler 3000 $ HW $ fileLookupDir "static" typeByExt+> +> getAutoCompleteR :: Handler RepJson+> getAutoCompleteR = do+>     term <- runFormGet' $ stringInput "term"+>     jsonToRepJson $ jsonList+>         [ jsonScalar $ term ++ "foo"+>         , jsonScalar $ term ++ "bar"+>         , jsonScalar $ term ++ "baz"+>         ]
+ static/chat.js view
@@ -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();+    });+}
yesod-examples.cabal view
@@ -1,5 +1,5 @@ Name:                yesod-examples-Version:             0.6.0.2+Version:             0.6.1 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/@@ -8,49 +8,50 @@ Author:              Michael Snoyman Maintainer:          michael@snoyman.com Stability:           Experimental-Category:            Web+Category:            Web, Yesod Build-type:          Simple Cabal-version:       >=1.6 extra-source-files:  static/yesod/ajax/script.js,-                     static/yesod/ajax/style.css+                     static/yesod/ajax/style.css,+                     static/chat.js  Executable blog-  Main-is:             yesod/tutorial/blog.lhs+  Main-is:             src/blog.lhs   Build-depends:       base >= 4 && < 5,                        yesod >= 0.6 && < 0.7  Executable ajax-  Main-is:             yesod/tutorial/ajax.lhs+  Main-is:             src/ajax.lhs  Executable file-echo-  Main-is:             yesod/tutorial/file-echo.lhs+  Main-is:             src/file-echo.lhs  Executable pretty-yaml-  Main-is:             yesod/tutorial/pretty-yaml.lhs+  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 i18n-  Main-is:             yesod/tutorial/i18n.lhs+  Main-is:             src/i18n.lhs  Executable session-  Main-is:             yesod/tutorial/session.lhs+  Main-is:             src/session.lhs  Executable widgets-  Main-is:             yesod/tutorial/widgets.lhs+  Main-is:             src/widgets.lhs  Executable generalized-hamlet-  Main-is:             yesod/tutorial/generalized-hamlet.lhs+  Main-is:             src/generalized-hamlet.lhs  Executable form-  Main-is:             yesod/tutorial/form.lhs+  Main-is:             src/form.lhs  Executable mkToForm   Main-is:             mkToForm.hs   Build-depends:       time,                        persistent >= 0.3 && < 0.4-  hs-source-dirs:      yesod/tutorial+  hs-source-dirs:      src   other-modules:       MkToForm2  Executable persistent-synopsis@@ -61,6 +62,10 @@ Executable hamlet-synopsis   Main-is:             synopsis/hamlet.lhs   Build-depends:       hamlet++Executable chat+  Main-is:             src/chat.hs+  Build-depends:       stm  source-repository head   type:     git
− yesod/tutorial/MkToForm2.hs 
@@ -1,15 +0,0 @@-{-# 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-|]
− yesod/tutorial/ajax.lhs 
@@ -1,111 +0,0 @@-<p>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.</p>--<p>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.</p>--> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}-> 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-> |]--<p>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.</p>--<p>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.</p>--> instance Yesod Ajax where->   approot _ = ""->   defaultLayout widget = do->   Ajax pages _ <- getYesod->   content <- widgetToPageContent widget->   hamletToRepHtml [$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^-> |]--<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 static = fileLookupDir "static/yesod/ajax" typeByExt->   basicHandler 3000 $ Ajax pages static
− yesod/tutorial/blog.lhs 
@@ -1,116 +0,0 @@-<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.html">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 #-}-> 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#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 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/file-echo.lhs 
@@ -1,29 +0,0 @@-> {-# 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 = 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->   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/form.lhs 
@@ -1,48 +0,0 @@-<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 #-}-> import Yesod-> import Control.Applicative-> 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 :: String, 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 = basicHandler 3000 FormExample
− yesod/tutorial/generalized-hamlet.lhs 
@@ -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--* 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 #-}-> 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|->   #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 = basicHandler 3000 NewHamlet
− yesod/tutorial/i18n.lhs 
@@ -1,51 +0,0 @@-> {-# LANGUAGE QuasiQuotes #-}-> {-# LANGUAGE TemplateHaskell #-}-> {-# LANGUAGE TypeFamilies #-}--> import Yesod-> import Data.Monoid (mempty)--> data I18N = I18N-> type Handler = GHandler I18N I18N--> mkYesod "I18N" [$parseRoutes|-> /            HomepageR GET-> /set/#String 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")->             , ("es", "Spanish")->             , ("he", "Hebrew")->             ]->     defaultLayout $ do->       setTitle $ string "I18N Homepage"->       addHamlet [$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 ()-> getSetLangR lang = do->     setLanguage lang->     redirect RedirectTemporary HomepageR--> main :: IO ()-> main = basicHandler 3000 I18N
− yesod/tutorial/mkToForm.hs 
@@ -1,69 +0,0 @@-{-# LANGUAGE TypeFamilies, QuasiQuotes, GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-import Yesod-import Yesod.Helpers.Crud-import Yesod.Form.Jquery-import Yesod.Form.Nic-import Database.Persist.Sqlite-import Database.Persist.TH-import Data.Time (Day)-import MkToForm2--jqueryDayField' :: YesodJquery m => FormFieldSettings -> FormletField s m Day-jqueryDayField' = jqueryDayField def-mkToForm (undefined :: Entry)--instance Item Entry where-    itemTitle = entryTitle--data Blog = Blog { pool :: ConnectionPool }--type EntryCrud = Crud Blog Entry--mkYesod "Blog" [$parseRoutes|-/ RootR GET-/entry/#EntryId EntryR GET-/admin AdminR EntryCrud defaultCrud-|]--instance Yesod Blog where-    approot _ = "http://localhost:3000"--instance YesodPersist Blog where-    type YesodDB Blog = SqlPersist-    runDB db = fmap pool getYesod >>= runSqlPool db--instance YesodJquery Blog-instance YesodNic Blog--getRootR = do-    entries <- runDB $ selectList [] [EntryDayDesc] 0 0-    defaultLayout $ do-        setTitle $ string "Yesod Blog Tutorial Homepage"-        addHamlet [$hamlet|-%h1 Archive-%ul-    $forall entries entry-        %li-            %a!href=@EntryR.fst.entry@ $entryTitle.snd.entry$-%p-    %a!href=@AdminR.CrudListR@ Admin-|]--getEntryR entryid = do-    entry <- runDB $ get404 entryid-    defaultLayout $ do-        setTitle $ string $ entryTitle entry-        addHamlet [$hamlet|-%h1 $entryTitle.entry$-%h2 $show.entryDay.entry$-$entryContent.entry$-|]--withBlog f = withSqlitePool "blog.db3" 8 $ \pool -> do-    flip runSqlPool pool $ runMigration $ do-        migrate (undefined :: Entry)-    f $ Blog pool--main = withBlog $ basicHandler 3000
− yesod/tutorial/pretty-yaml.lhs 
@@ -1,64 +0,0 @@-<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 #-}--> 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 myaml yaml->             %div ^yaml^-> |]--> getHomepage :: Handler RepHtml-> getHomepage = hamletToRepHtml $ template Nothing--> postHomepage :: Handler 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 
@@ -1,31 +0,0 @@-> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}-> 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 = basicHandler 3000 Session
− yesod/tutorial/widgets.lhs 
@@ -1,89 +0,0 @@-> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings #-}-> import Yesod-> import Yesod.Widget-> import Yesod.Helpers.Static-> import Yesod.Form.Jquery-> import Yesod.Form.Nic-> import Control.Applicative-> -> 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&trade;-> |]-> getRootR = defaultLayout $ wrapper $ do->     i <- 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 mhtml html->         $html$-> |]->         setTitle $ string "Form"-> -> main = basicHandler 3000 $ HW $ fileLookupDir "static" typeByExt-> -> getAutoCompleteR :: Handler RepJson-> getAutoCompleteR = do->     term <- runFormGet' $ stringInput "term"->     jsonToRepJson $ jsonList->         [ jsonScalar $ term ++ "foo"->         , jsonScalar $ term ++ "bar"->         , jsonScalar $ term ++ "baz"->         ]