packages feed

yesod-examples 0.4.0 → 0.5.0

raw patch · 11 files changed

+86/−198 lines, 11 filesdep ~hamletdep ~persistent-sqlitedep ~yesod

Dependency ranges changed: hamlet, persistent-sqlite, yesod

Files

hamlet/synopsis.lhs view
@@ -16,9 +16,9 @@     } data PersonUrls = Homepage | PersonPage String -renderUrls :: PersonUrls -> String-renderUrls Homepage = "/"-renderUrls (PersonPage name) = '/' : name+renderUrls :: PersonUrls -> [(String, String)] -> String+renderUrls Homepage _ = "/"+renderUrls (PersonPage name) _ = '/' : name  footer :: Hamlet url footer = [$hamlet|
persistent/synopsis.lhs view
@@ -14,11 +14,11 @@ > |] > > main :: IO ()-> main = withSqlite ":memory:" 8 $ runSqlite go+> main = withSqliteConn ":memory:" $ runSqlConn go >-> go :: SqliteReader IO ()+> go :: SqlPersist IO () > go = do->   initialize (undefined :: Person)+>   runMigration $ migrate (undefined :: Person) >   key <- insert $ Person "Michael" 25 >   liftIO $ print key >   p1 <- get key@@ -26,10 +26,10 @@ >   update key [PersonAge 26] >   p2 <- get key >   liftIO $ print p2->   p3 <- select [PersonNameEq "Michael"] []+>   p3 <- selectList [PersonNameEq "Michael"] [] 0 0 >   liftIO $ print p3 >   delete key->   p4 <- select [PersonNameEq "Michael"] []+>   p4 <- selectList [PersonNameEq "Michael"] [] 0 0 >   liftIO $ print p4  The output of the above is:
yesod-examples.cabal view
@@ -1,5 +1,5 @@ Name:                yesod-examples-Version:             0.4.0+Version:             0.5.0 Synopsis:            Example programs using the Yesod Web Framework. Description:         These are the same examples and tutorials found on the documentation site. Homepage:            http://docs.yesodweb.com/@@ -17,14 +17,11 @@ Executable helloworld   Main-is:             yesod/helloworld.lhs   Build-depends:       base >= 4 && < 5,-                       yesod >= 0.4.0 && < 0.5+                       yesod >= 0.5.0 && < 0.6  Executable blog   Main-is:             yesod/tutorial/blog.lhs -Executable chat-  Main-is:             yesod/tutorial/chat.lhs- Executable ajax   Main-is:             yesod/tutorial/ajax.lhs @@ -49,11 +46,11 @@ Executable persistent-synopsis   Main-is:             persistent/synopsis.lhs   Build-depends:       transformers >= 0.2.1 && < 0.3,-                       persistent-sqlite >= 0.1.0 && < 0.2+                       persistent-sqlite  Executable hamlet-synopsis   Main-is:             hamlet/synopsis.lhs-  Build-depends:       hamlet >= 0.4.0 && < 0.5+  Build-depends:       hamlet  source-repository head   type:     git
yesod/tutorial/ajax.lhs view
@@ -1,8 +1,6 @@ --- title: AJAX -- Tutorials -- Yesod ----**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**- We're going to write a very simple AJAX application. It will be a simple site with a few pages and a navbar; when you have Javascript, clicking on the links will load the pages via AJAX. Otherwise, it will use static HTML.  We're going to use jQuery for the Javascript, though anything would work just fine. Also, the AJAX responses will be served as JSON. Let's get started.@@ -31,6 +29,7 @@ >   { 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. @@ -50,9 +49,10 @@  > instance Yesod Ajax where >   approot _ = ""->   defaultLayout content = do+>   defaultLayout widget = do >   Ajax pages _ <- getYesod->   hamletToContent [$hamlet|+>   content <- widgetToPageContent widget+>   hamletToRepHtml [$hamlet| > !!! > %html >   %head@@ -74,7 +74,7 @@  Now we need our handler functions. We'll have the homepage simply redirect to the first page, so: -> getHomeR :: Handler Ajax ()+> getHomeR :: Handler () > getHomeR = do >   Ajax pages _ <- getYesod >   let first = head pages@@ -82,20 +82,23 @@  And now the cool part: a handler that returns either HTML or JSON data, depending on the request headers. -> getPageR :: String -> Handler Ajax RepHtmlJson+> getPageR :: String -> Handler RepHtmlJson > getPageR slug = do >   Ajax pages _ <- getYesod >   case filter (\e -> pageSlug e == slug) pages of >       [] -> notFound->       page:_ -> applyLayoutJson (pageName page) mempty (html page) (json page)+>       page:_ -> defaultLayoutJson (do+>           setTitle $ string $ pageName page+>           addBody $ html page+>           ) (json page) >  where >   html page = [$hamlet| > %h1 $pageName.page$ > %article $pageContent.page$ > |] >   json page = jsonMap->       [ ("name", jsonScalar $ string $ pageName page)->       , ("content", jsonScalar $ string $ pageContent page)+>       [ ("name", jsonScalar $ pageName page)+>       , ("content", jsonScalar $ pageContent page) >       ]  We first try and find the appropriate Page, returning a 404 if it's not there. We then use the applyLayoutJson function, which is really the heart of this example. It allows you an easy way to create responses that will be either HTML or JSON, and which use the default layout in the HTML responses. It takes four arguments: 1) the title of the HTML page, 2) some value, 3) a function from that value to a Hamlet value, and 4) a function from that value to a Json value.
yesod/tutorial/blog.lhs view
@@ -1,8 +1,6 @@ --- title: Blog -- Tutorials -- Yesod ----**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**- Well, just about every web framework I've seen starts with a blog tutorial- so here's mine! Actually, you'll see that this is actually a much less featureful blog than most, but gives a good introduction to Yesod basics. I recommend you start by [reading the terminology section]($root/yesod/terminology.html).  This file is literate Haskell, so we'll start off with our language pragmas and import statements. Basically every Yesod application will start off like this:@@ -30,6 +28,7 @@ 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: @@ -46,7 +45,7 @@  We defined two resource patterns for our blog: the homepage, and the page for each entry. For each of these, we are allowing only the GET request method. For the homepage, we want to simply redirect to the most recent entry, so we'll use: -> getHomeR :: Handler Blog ()+> getHomeR :: Handler () > getHomeR = do >   Blog entries <- getYesod >   let newest = last entries@@ -57,8 +56,8 @@ 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 ()+>   { templateTitle :: Html+>   , templateContent :: Html >   , templateNavbar :: [Nav] >   } @@ -66,7 +65,7 @@  > data Nav = Nav >   { navUrl :: Route Blog->   , navTitle :: Html ()+>   , navTitle :: Html >   }  And now the template itself:@@ -92,7 +91,7 @@  Finally, the entry route handler: -> getEntryR :: String -> Handler Blog RepHtml+> getEntryR :: String -> Handler RepHtml > getEntryR slug = do >   Blog entries <- getYesod >   case filter (\e -> entrySlug e == slug) entries of
− yesod/tutorial/chat.lhs 
@@ -1,126 +0,0 @@-----title: Chat -- Tutorials -- Yesod-----**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**--OK, maybe chat is a little over-reaching for this tutorial... but I like typing less, and chat is shorter than message board ;).--In this tutorial, we'll create an app that let's you log in and add messages. The server will display all messages to logged-in users.--> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}-> import Yesod-> import Yesod.Helpers.Auth-> import Control.Concurrent.MVar-> import Data.Monoid (mempty)--> data Message = Message->   { messageAuthor :: String->   , messageContent :: String->   }--Since we want to alter the list of messages, we're going to need a mutable variable. Note that this application- for simplicity- does not store any information on disk, so you'll lose your history on a server restart.--> data Chat = Chat->   { chatMsgs :: MVar [Message]->   , chatAuth :: Auth->   }--Yesod comes baked in with three different authentication methods: OpenId, Rpxnow and e-mail based. For those not familiar with Rpxnow, it's a service that makes it easy to log in through multiple backends, such as Google, Twitter, Yahoo, etc.--The e-mail method allows users to register an e-mail address, get a verification key by e-mail, set password and log in. As you might imagine, this requires some setup in general: usually, you'll have to add some database tables and configure e-mail sending. For testing, Yesod includes inMemoryEmailSettings, which uses an in-memory database and simply outputs verification information to standard error.--> loadChat :: IO Chat-> loadChat = do->   msgs <- newMVar []->   aes <- inMemoryEmailSettings->   return $ Chat msgs Auth->       { authIsOpenIdEnabled = True->       , authRpxnowApiKey = Just "c8043882f14387d7ad8dfc99a1a8dab2e028f690"->       , authEmailSettings = Just aes->       , authFacebook = Just ("134280699924829", "a7685e10c8977f5435e599aaf1d232eb", ["email"])->       }--There are three resource patterns: the homepage, the auth subsite, and the messages page. When you GET the messages page, it will give you the history. POSTing will allow you to add a message. The homepage will have login information.--> mkYesod "Chat" [$parseRoutes|-> /                  HomeR      GET-> /auth              AuthR      Auth chatAuth-> /messages          MessagesR  GET POST-> |]--And now let's hit the typeclasses; as usual, we need the Yesod typeclass. Now, we'll also add the YesodAuth typeclass. Like Yesod, it provides default values when possible. Since we need to provide a return URL for OpenID, we now need a valid value for approot instead of just an empty string.--> instance Yesod Chat where->   approot _ = "http://localhost:3000"--> instance YesodAuth Chat where->   defaultDest _ = MessagesR->   defaultLoginRoute _ = HomeR--This basically says "send users to MessagesR on login, and to HomeR when they *need* to login."--Now we'll write the homepage; that funny iframe bit at the bottom comes straight from RPXnow.--> getHomeR :: Handler Chat RepHtml-> getHomeR = applyLayout "Chat Home" mempty [$hamlet|-> %h1 OpenID-> %form!action=@AuthR.OpenIdForward@->   %input!type=text!name=openid->   %input!type=submit!value=Login-> %h1 Email (well, sort of)-> %form!method=post!action=@AuthR.EmailRegisterR@->   %input!type=email!name=email->   %input!type=submit!value=Register-> %h1 Facebook-> %a!href=@AuthR.StartFacebookR@ Facebook Connect-> %h1 Rpxnow-> <iframe src="http://yesod-test.rpxnow.com/openid/embed?token_url=@AuthR.RpxnowR@" scrolling="no" frameBorder="no" allowtransparency="true" style="width:400px;height:240px"></iframe>-> |]--Next, we'll write the GET handler for messages. We use the "requireCreds" to get the user's credentials. If the user it not logged in, they are redirected to the homepage.--> getMessagesR :: Handler Chat RepHtml-> getMessagesR = do->   creds <- requireCreds -- now we know we're logged in->   msgs' <- chatMsgs `fmap` getYesod->   msgs <- liftIO $ readMVar msgs'->   hamletToRepHtml $ template msgs creds->  where->   template msgs creds = [$hamlet|->       !!!->       %html->           %head->               %title Silly Chat Server->           %body->               %p Logged in as $credsIdent.creds$->               %p Your full creds: $show.creds$->               %form!method=post!action=@MessagesR@->                   Enter your message: ->                   %input!type=text!name=message!width=400->                   %input!type=submit->               %h1 Messages->               %dl->                   $forall msgs msg->                       %dt $messageAuthor.msg$->                       %dd $messageContent.msg$->   |]--Pretty straight-forward. Now we'll add the post handler.--> postMessagesR :: Handler Chat ()-> postMessagesR = do->   creds <- requireCreds -- now we know we're logged in->   message <- runFormPost' $ stringInput "message"->   msgs <- chatMsgs `fmap` getYesod->   let msg = Message (credsIdent creds) message->   liftIO $ modifyMVar_ msgs $ return . (:) msg->   redirect RedirectTemporary MessagesR--This includes a minor introduction to the Yesod.Form module. The second line in the do block essentially says to get the "message" POST parameter; there must be precisely one parameter and cannot be empty (ie, ""). The modifyMVar_ line simply tacks the new message onto the message MVar, and then we redirect to view the messages.--Finally, we'll do our standard main function.--> main :: IO ()-> main = do->   chat <- loadChat->   basicHandler 3000 chat
yesod/tutorial/file-echo.lhs view
@@ -1,5 +1,3 @@-**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**- > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}  > import Yesod@@ -13,7 +11,9 @@  > instance Yesod Echo where approot _ = "" -> getHomepage = applyLayout "Upload a file" mempty [$hamlet|+> getHomepage = defaultLayout $ do+>   setTitle $ string "Upload a file"+>   addBody [$hamlet| > %form!method=post!action=.!enctype=multipart/form-data >   File name: >   %input!type=file!name=file
yesod/tutorial/i18n.lhs view
@@ -1,7 +1,6 @@ --- title: Multi-lingual -- Tutorials -- Yesod ----**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**  > {-# LANGUAGE QuasiQuotes #-} > {-# LANGUAGE TemplateHaskell #-}@@ -11,6 +10,7 @@ > import Data.Monoid (mempty)  > data I18N = I18N+> type Handler = GHandler I18N I18N  > mkYesod "I18N" [$parseRoutes| > /            HomepageR GET@@ -20,7 +20,7 @@ > instance Yesod I18N where >     approot _ = "http://localhost:3000" -> getHomepageR :: Handler I18N RepHtml+> getHomepageR :: Handler RepHtml > getHomepageR = do >     ls <- languages >     let hello = chooseHello ls@@ -29,7 +29,9 @@ >             , ("es", "Spanish") >             , ("he", "Hebrew") >             ]->     applyLayout "I18N Homepage" mempty [$hamlet|+>     defaultLayout $ do+>       setTitle $ string "I18N Homepage"+>       addBody [$hamlet| > %h1 $hello$ > %p In other languages: > %ul@@ -44,7 +46,7 @@ > chooseHello ("es":_) = "Hola" > chooseHello (_:rest) = chooseHello rest -> getSetLangR :: String -> Handler I18N ()+> getSetLangR :: String -> Handler () > getSetLangR lang = do >     setLanguage lang >     redirect RedirectTemporary HomepageR
yesod/tutorial/pretty-yaml.lhs view
@@ -1,8 +1,6 @@ --- title: Pretty YAML -- Tutorials -- Yesod ----**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**- This example uses the [data-object-yaml package](http://hackage.haskell.org/package/data-object-yaml) to display YAML files as cleaned-up HTML. If you've read through the other tutorials, this one should be easy to follow.  > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}@@ -14,6 +12,7 @@ > import qualified Data.ByteString.Lazy as L  > data PY = PY+> type Handler = GHandler PY PY  > mkYesod "PY" [$parseRoutes| > / Homepage GET POST@@ -37,10 +36,10 @@ >             %div ^yaml^ > |] -> getHomepage :: Handler PY RepHtml+> getHomepage :: Handler RepHtml > getHomepage = hamletToRepHtml $ template Nothing -> postHomepage :: Handler PY RepHtml+> postHomepage :: Handler RepHtml > postHomepage = do >     rr <- getRequest >     (_, files) <- liftIO $ reqRequestBody rr
yesod/tutorial/session.lhs view
@@ -1,14 +1,13 @@-**NOTE: This tutorial requires the development version of Yesod (version 0.4.0). The [tutorial main page]($root/yesod/tutorial/) has instructions on setting up your environment.**- > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-} > import Yesod > import Control.Applicative ((<$>), (<*>)) >  > data Session = Session+> type Handler = GHandler Session Session > mkYesod "Session" [$parseRoutes| > / Root GET POST > |]-> getRoot :: Handler Session RepHtml+> getRoot :: Handler RepHtml > getRoot = do >     sess <- reqSession `fmap` getRequest >     hamletToRepHtml [$hamlet|@@ -19,7 +18,7 @@ > %h1 $show.sess$ > |] > -> postRoot :: Handler Session ()+> postRoot :: Handler () > postRoot = do >     (key, val) <- runFormPost' $ (,) <$> stringInput "key" <*> stringInput "val" >     setSession key val
yesod/tutorial/widgets.lhs view
@@ -1,10 +1,17 @@-> {-# LANGUAGE TypeFamilies, QuasiQuotes #-}+---+title: Widgets -- Tutorials -- Yesod+---++> {-# 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@@ -12,18 +19,22 @@ > /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 = applyLayoutW $ flip wrapWidget wrapper $ do+> getRootR = defaultLayout $ flip wrapWidget wrapper $ do >     i <- newIdent >     setTitle $ string "Hello Widgets"->     addStyle [$hamlet|\#$i${color:red}|]->     addStylesheet $ StaticR $ StaticRoute ["style.css"]+>     addStyle [$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"]+>     addScript $ StaticR $ StaticRoute ["script.js"] [] >     addBody [$hamlet| > %h1#$i$ Welcome to my first widget!!! > %p@@ -35,26 +46,30 @@ >     addHead [$hamlet|%meta!keywords=haskell|] >  > handleFormR = do->     (res, form, enctype) <- runFormPost $ (,,,,,,,,)->         <$> stringField (string "My Field") (string "Some tooltip info") Nothing->         <*> stringField (string "Another field") (string "") (Just "some default text")->         <*> intField (string "A number field") (string "some nums") (Just 5)->         <*> jqueryDayField (string "A day field") (string "") Nothing->         <*> timeField (string "A time field") (string "") Nothing->         <*> boolField (string "A checkbox") (string "") (Just False)->         <*> jqueryAutocompleteField AutoCompleteR->             (string "Autocomplete") (string "Try it!") Nothing->         <*> nicHtmlField (string "HTML") (string "")->                 (Just $ string "You can put rich text here")->         <*> maybeEmailField (string "An e-mail addres") mempty Nothing+>     (res, form, enctype) <- runFormPost $ fieldsToTable $ (,,,,,,,,)+>         <$> stringField "My Field" Nothing+>         <*> stringField "Another field" (Just "some default text")+>         <*> intField "A number field" (Just 5)+>         <*> jqueryDayField "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->     applyLayoutW $ do->         addStyle [$hamlet|\.tooltip{color:#666;font-style:italic}|]->         addStyle [$hamlet|textarea.html{width:300px;height:150px};|]->         wrapWidget (fieldsToTable form) $ \h -> [$hamlet|-> %form!method=post!enctype=$show.enctype$+>     defaultLayout $ do+>         addStyle [$cassius|+> .tooltip+>     color: #666+>     font-style: italic+> textarea.html+>     width: 300px+>     height: 150px|]+>         wrapWidget form $ \h -> [$hamlet|+> %form!method=post!enctype=$enctype$ >     %table >         ^h^ >         %tr@@ -67,11 +82,11 @@ >  > main = basicHandler 3000 $ HW $ fileLookupDir "static" typeByExt > -> getAutoCompleteR :: Handler HW RepJson+> getAutoCompleteR :: Handler RepJson > getAutoCompleteR = do >     term <- runFormGet' $ stringInput "term" >     jsonToRepJson $ jsonList->         [ jsonScalar $ string $ term ++ "foo"->         , jsonScalar $ string $ term ++ "bar"->         , jsonScalar $ string $ term ++ "baz"+>         [ jsonScalar $ term ++ "foo"+>         , jsonScalar $ term ++ "bar"+>         , jsonScalar $ term ++ "baz" >         ]