Remove the long-outdated examples
This commit is contained in:
Michael Snoyman
parent
8b9f8ea024
commit
ac6ab5b4d0
3
yesod-examples/.gitignore
vendored
3
yesod-examples/.gitignore
vendored
@ -1,3 +0,0 @@
|
||||
client_session_key.aes
|
||||
dist
|
||||
cabal-dev/
|
||||
@ -1,20 +0,0 @@
|
||||
Copyright (c) 2012 Michael Snoyman, http://www.yesodweb.com/
|
||||
|
||||
Permission is hereby granted, free of charge, to any person obtaining
|
||||
a copy of this software and associated documentation files (the
|
||||
"Software"), to deal in the Software without restriction, including
|
||||
without limitation the rights to use, copy, modify, merge, publish,
|
||||
distribute, sublicense, and/or sell copies of the Software, and to
|
||||
permit persons to whom the Software is furnished to do so, subject to
|
||||
the following conditions:
|
||||
|
||||
The above copyright notice and this permission notice shall be
|
||||
included in all copies or substantial portions of the Software.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
|
||||
LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
|
||||
OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
|
||||
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||||
@ -1,3 +0,0 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
import Distribution.Simple
|
||||
main = defaultMain
|
||||
@ -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
|
||||
|]
|
||||
@ -1,116 +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, MultiParamTypeClasses, OverloadedStrings #-}
|
||||
> import Yesod
|
||||
> import Yesod.Static
|
||||
> import Data.Text (Text, unpack)
|
||||
|
||||
Like the blog example, we'll define some data first.
|
||||
|
||||
> data Page = Page
|
||||
> { pageName :: Text
|
||||
> , pageSlug :: Text
|
||||
> , pageContent :: Text
|
||||
> }
|
||||
|
||||
> 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/#Text 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|
|
||||
> \<!DOCTYPE html>
|
||||
>
|
||||
> <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 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 :: Text -> Handler RepHtmlJson
|
||||
> getPageR slug = do
|
||||
> Ajax pages _ <- getYesod
|
||||
> case filter (\e -> pageSlug e == slug) pages of
|
||||
> [] -> notFound
|
||||
> page:_ -> defaultLayoutJson (do
|
||||
> setTitle $ toHtml $ pageName page
|
||||
> addHamlet $ html page
|
||||
> ) (json page)
|
||||
> where
|
||||
> html page = [hamlet|
|
||||
> <h1>#{pageName page}
|
||||
> <article>#{pageContent page}
|
||||
> |]
|
||||
> json page = jsonMap
|
||||
> [ ("name", jsonScalar $ unpack $ pageName page)
|
||||
> , ("content", jsonScalar $ unpack $ pageContent page)
|
||||
> ]
|
||||
|
||||
<p>We first try and find the appropriate Page, returning a 404 if it's not there. We then use the applyLayoutJson function, which is really the heart of this example. It allows you an easy way to create responses that will be either HTML or JSON, and which use the default layout in the HTML responses. It takes four arguments: 1) the title of the HTML page, 2) some value, 3) a function from that value to a Hamlet value, and 4) a function from that value to a Json value.</p>
|
||||
|
||||
<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
|
||||
> s <- static "static/yesod/ajax"
|
||||
> warpDebug 3000 $ Ajax pages s
|
||||
|
||||
And just to avoid some warnings...
|
||||
|
||||
> _ignored :: Widget
|
||||
> _ignored = undefined ajaxPages
|
||||
@ -1,120 +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">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] }
|
||||
|
||||
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 -> HtmlUrl (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
|
||||
|
||||
And this is just to avoid some warnings...
|
||||
|
||||
> _ignored :: Widget
|
||||
> _ignored = undefined blogEntries
|
||||
@ -1,122 +0,0 @@
|
||||
{-# LANGUAGE TemplateHaskell, QuasiQuotes, TypeFamilies #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Main where
|
||||
|
||||
import Yesod
|
||||
import Yesod.Static
|
||||
|
||||
import Control.Concurrent.STM
|
||||
|
||||
import Control.Arrow ((***))
|
||||
import Data.Text (Text, unpack)
|
||||
|
||||
-- speaker and content
|
||||
data Message = Message Text Text
|
||||
|
||||
-- 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 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"
|
||||
toWidget [hamlet|
|
||||
!!!
|
||||
|
||||
<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 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 :: [Text] -> [Text] -> Json
|
||||
zipJson x y = jsonMap $ map (unpack *** jsonScalar . unpack) $ zip x y
|
||||
|
||||
getPostR :: Handler 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
|
||||
s <- static "static"
|
||||
warpDebug 3000 $ Chat clients next s
|
||||
@ -1,37 +0,0 @@
|
||||
> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
|
||||
|
||||
> import Yesod
|
||||
> 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 :: Handler RepHtml
|
||||
> getHomepage = defaultLayout $ do
|
||||
> setTitle "Upload a file"
|
||||
> addHamlet [hamlet|
|
||||
> <form method=post action=. enctype=multipart/form-data>
|
||||
> File name:
|
||||
> <input type=file name=file
|
||||
> <input type=submit
|
||||
> |]
|
||||
|
||||
> postHomepage :: Handler [(ContentType, Content)]
|
||||
> postHomepage = do
|
||||
> (_, files) <- runRequestBody
|
||||
> fi <- maybe notFound return $ lookup "file" files
|
||||
> return [(S8.pack $ T.unpack $ fileContentType fi, toContent $ fileContent fi)]
|
||||
|
||||
> main :: IO ()
|
||||
> main = warpDebug 3000 Echo
|
||||
|
||||
To avoid warnings
|
||||
|
||||
> _ignored :: Widget
|
||||
> _ignored = undefined
|
||||
@ -1,55 +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, MultiParamTypeClasses, TemplateHaskell #-}
|
||||
> import Yesod hiding (Form)
|
||||
> import Control.Applicative
|
||||
> import Data.Text (Text)
|
||||
|
||||
> data FormExample = FormExample
|
||||
> mkYesod "FormExample" [parseRoutes|
|
||||
> / RootR GET
|
||||
> |]
|
||||
> type Form a = Html -> MForm FormExample FormExample (FormResult a, Widget)
|
||||
> type Formlet a = Maybe a -> Form a
|
||||
> instance Yesod FormExample where approot _ = ""
|
||||
> instance RenderMessage FormExample FormMessage where
|
||||
> renderMessage _ _ = defaultFormMessage
|
||||
|
||||
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 :: Formlet Person
|
||||
> personFormlet p = renderTable $ Person
|
||||
> <$> areq textField "Name" (fmap name p)
|
||||
> <*> areq 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 :: IO ()
|
||||
> main = warpDebug 3000 FormExample
|
||||
@ -1,56 +0,0 @@
|
||||
> {-# LANGUAGE QuasiQuotes #-}
|
||||
> {-# LANGUAGE TemplateHaskell #-}
|
||||
> {-# LANGUAGE TypeFamilies #-}
|
||||
> {-# LANGUAGE MultiParamTypeClasses #-}
|
||||
> {-# LANGUAGE OverloadedStrings #-}
|
||||
> {-# LANGUAGE CPP #-}
|
||||
|
||||
> import Yesod
|
||||
> import Data.Text (Text)
|
||||
|
||||
> data 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", "Español")
|
||||
> , ("he", "עִבְרִית")
|
||||
> ]
|
||||
> 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":_) = "שלום"
|
||||
> chooseHello ("es":_) = "¡Hola!"
|
||||
> chooseHello (_:rest) = chooseHello rest
|
||||
|
||||
> getSetLangR :: Text -> Handler ()
|
||||
> getSetLangR lang = do
|
||||
> setLanguage lang
|
||||
> redirect RedirectTemporary HomepageR
|
||||
|
||||
> main :: IO ()
|
||||
> main = warpDebug 3000 I18N
|
||||
|
||||
> _ignored :: Widget
|
||||
> _ignored = undefined
|
||||
@ -1,66 +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, 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
|
||||
|
||||
> mkYesod "PY" [parseRoutes|
|
||||
> / Homepage GET POST
|
||||
> |]
|
||||
|
||||
> instance Yesod PY where approot _ = ""
|
||||
|
||||
> template :: Maybe (HtmlUrl url) -> HtmlUrl 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 -> HtmlUrl 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
|
||||
|
||||
> _ignored :: Widget
|
||||
> _ignored = undefined
|
||||
@ -1,39 +0,0 @@
|
||||
> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
|
||||
> import Yesod
|
||||
> import Control.Applicative ((<$>), (<*>))
|
||||
>
|
||||
> data Session = Session
|
||||
> mkYesod "Session" [parseRoutes|
|
||||
> / Root GET POST
|
||||
> |]
|
||||
>
|
||||
> instance Yesod Session where
|
||||
> approot _ = ""
|
||||
> clientSessionDuration _ = 1
|
||||
>
|
||||
> instance RenderMessage Session FormMessage where
|
||||
> renderMessage _ _ = defaultFormMessage
|
||||
>
|
||||
> 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) <- runInputPost $ (,) <$> ireq textField "key" <*> ireq textField "val"
|
||||
> setSession key val
|
||||
> liftIO $ print (key, val)
|
||||
> redirect RedirectTemporary Root
|
||||
>
|
||||
> main :: IO ()
|
||||
> main = warpDebug 3000 Session
|
||||
|
||||
> _ignored :: Widget
|
||||
> _ignored = undefined
|
||||
@ -1,92 +0,0 @@
|
||||
> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-}
|
||||
> import Yesod
|
||||
> import Yesod.Static
|
||||
> import Yesod.Form.Jquery
|
||||
> import Yesod.Form.Nic
|
||||
> import Control.Applicative
|
||||
> import Data.Text (unpack)
|
||||
> import Text.Blaze (string)
|
||||
>
|
||||
> data HW = HW { hwStatic :: Static }
|
||||
> 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™
|
||||
> |]
|
||||
> instance RenderMessage HW FormMessage where
|
||||
> renderMessage _ _ = defaultFormMessage
|
||||
>
|
||||
> 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 $ renderTable $ (,,,,,,,,)
|
||||
> <$> aopt textField "My Field" Nothing
|
||||
> <*> aopt textField "Another field" (Just "some default text")
|
||||
> <*> aopt intField "A number field" (Just 5)
|
||||
> <*> aopt jqueryDayField "A day field" Nothing
|
||||
> <*> aopt timeField "A time field" Nothing
|
||||
> <*> aopt boolField "A checkbox" (Just False)
|
||||
> <*> aopt jqueryAutocompleteField AutoCompleteR "Autocomplete" Nothing
|
||||
> <*> aopt nicHtmlField "HTML"
|
||||
> (Just $ string "You can put <rich text> here")
|
||||
> <*> aopt emailField "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 = static "static" >>= (warpDebug 3000 . HW)
|
||||
>
|
||||
> getAutoCompleteR :: Handler RepJson
|
||||
> getAutoCompleteR = do
|
||||
> term <- runInputGet $ ireq textField "term"
|
||||
> jsonToRepJson $ jsonList
|
||||
> [ jsonScalar $ unpack term ++ "foo"
|
||||
> , jsonScalar $ unpack term ++ "bar"
|
||||
> , jsonScalar $ unpack term ++ "baz"
|
||||
> ]
|
||||
@ -1,21 +0,0 @@
|
||||
$(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();
|
||||
});
|
||||
}
|
||||
@ -1,9 +0,0 @@
|
||||
$(function(){
|
||||
$("#navbar a").click(function(){
|
||||
$.getJSON($(this).attr("href"), {}, function(o){
|
||||
$("h1").html(o.name);
|
||||
$("article").html(o.content);
|
||||
});
|
||||
return false;
|
||||
});
|
||||
});
|
||||
@ -1,11 +0,0 @@
|
||||
#navbar {
|
||||
width: 100px;
|
||||
float: left;
|
||||
background: #eee;
|
||||
padding: 1em;
|
||||
list-style: none;
|
||||
}
|
||||
|
||||
#content {
|
||||
margin-left: 230px;
|
||||
}
|
||||
@ -1,74 +0,0 @@
|
||||
\begin{code}
|
||||
{-# LANGUAGE QuasiQuotes, OverloadedStrings #-}
|
||||
|
||||
import Text.Hamlet
|
||||
import Data.Text (Text, cons)
|
||||
import qualified Data.Text.Lazy.IO as L
|
||||
import Text.Blaze.Renderer.Text (renderHtml)
|
||||
|
||||
|
||||
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 :: HtmlUrl url
|
||||
footer = [hamlet|
|
||||
<div id="footer">Thank you, come again
|
||||
|]
|
||||
|
||||
template :: Person -> HtmlUrl PersonUrls
|
||||
template person = [hamlet|
|
||||
!!!
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>Hamlet Demo
|
||||
<body>
|
||||
<h1>Information on #{name person}
|
||||
<p>#{name person} is #{age person} years old.
|
||||
<h2>
|
||||
$if isMarried person
|
||||
\Married
|
||||
$else
|
||||
\Not married
|
||||
<ul>
|
||||
$forall child <- children person
|
||||
<li>#{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 $ renderHtml $ (template person) renderUrls
|
||||
\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>
|
||||
@ -1,42 +0,0 @@
|
||||
This example uses the sqlite backend for Persistent, since it can run in-memory and has no external dependencies.
|
||||
|
||||
> {-# LANGUAGE GADTs, TypeFamilies, GeneralizedNewtypeDeriving, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
|
||||
>
|
||||
> import Database.Persist.Sqlite
|
||||
> import Database.Persist.TH
|
||||
> import Control.Monad.IO.Class (liftIO)
|
||||
>
|
||||
> mkPersist sqlSettings [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 [PersonName ==. "Michael"] []
|
||||
> liftIO $ print p3
|
||||
> delete key
|
||||
> p4 <- selectList [PersonName ==. "Michael"] []
|
||||
> 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>
|
||||
|
||||
> _ignored :: PersonId
|
||||
> _ignored = undefined personName personAge
|
||||
@ -1,75 +0,0 @@
|
||||
Name: yesod-examples
|
||||
Version: 0.9.0
|
||||
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
|
||||
|
||||
flag ghc7
|
||||
|
||||
Executable yesod-blog
|
||||
Main-is: src/blog.lhs
|
||||
Build-depends: base >= 4 && < 5,
|
||||
yesod >= 0.9
|
||||
|
||||
Executable yesod-ajax
|
||||
Main-is: src/ajax.lhs
|
||||
Build-depends: yesod-static,
|
||||
blaze-html >= 0.4.1.3 && < 0.5,
|
||||
yesod >= 0.9
|
||||
|
||||
Executable yesod-file-echo
|
||||
Main-is: src/file-echo.lhs
|
||||
Build-depends: text >= 0.9 && < 0.12,
|
||||
yesod >= 0.9
|
||||
|
||||
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.1.4 && < 0.10,
|
||||
yesod >= 0.9
|
||||
|
||||
Executable yesod-i18n
|
||||
Main-is: src/i18n.lhs
|
||||
if flag(ghc7)
|
||||
cpp-options: -DGHC7
|
||||
|
||||
Executable yesod-session
|
||||
Main-is: src/session.lhs
|
||||
|
||||
-- Executable yesod-widgets
|
||||
-- Main-is: src/widgets.lhs
|
||||
-- Build-depends: yesod-form
|
||||
|
||||
Executable yesod-form
|
||||
Main-is: src/form.lhs
|
||||
|
||||
Executable yesod-persistent-synopsis
|
||||
Main-is: synopsis/persistent.lhs
|
||||
Build-depends: transformers >= 0.2.2 && < 0.3,
|
||||
persistent-sqlite >= 0.6 && < 0.7,
|
||||
persistent-template >= 0.6 && < 0.7
|
||||
extra-libraries: sqlite3
|
||||
|
||||
Executable yesod-hamlet-synopsis
|
||||
Main-is: synopsis/hamlet.lhs
|
||||
Build-depends: hamlet, yesod-core
|
||||
|
||||
Executable yesod-chat
|
||||
Main-is: src/chat.hs
|
||||
Build-depends: stm
|
||||
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/yesodweb/yesod
|
||||
Loading…
Reference in New Issue
Block a user