haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

get most examples compiling under 0.9

Browse Source
This commit is contained in:
Greg Weber 2011-09-08 22:41:08 -07:00
parent acee39587c
commit 064b8da896
12 changed files with 71 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
yesod-examples/.gitignore vendored
View File

@ -1,2 +1,3 @@
client_session_key.aes
dist
cabal-dev/

8
yesod-examples/src/ajax.lhs
View File

@ -4,8 +4,9 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
> import Yesod
> import Yesod.Helpers.Static
> import Yesod.Static
> import Data.Monoid (mempty)
> import Text.Blaze (string)
Like the blog example, we'll define some data first.
@ -26,7 +27,6 @@ Like the blog example, we'll define some data first.
> { 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.
@ -34,7 +34,7 @@ Next we'll generate a function for each file in our static folder. This way, we
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|
> mkYesod "Ajax" [parseRoutes|
> / HomeR GET
> /page/#String PageR GET
> /static StaticR Static ajaxStatic
@ -108,5 +108,5 @@ And now the cool part: a handler that returns either HTML or JSON data, dependin
> main :: IO ()
> main = do
> pages <- loadPages
> let s = static "static/yesod/ajax"
> s <- static "static/yesod/ajax"
> warpDebug 3000 $ Ajax pages s

4
yesod-examples/src/blog.lhs
View File

@ -25,7 +25,6 @@ Since normally you'll need to perform an IO action to load up your entries from
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:
@ -67,10 +66,9 @@ The Nav datatype will contain navigation information (ie, the URL and title) of
And now the template itself:
> entryTemplate :: TemplateArgs -> Hamlet (Route Blog)
> entryTemplate :: TemplateArgs -> HtmlUrl (Route Blog)
> entryTemplate args = [hamlet|
> !!!
>
> <html>
> <head>
> <title>#{templateTitle args}

3
yesod-examples/src/file-echo.lhs
View File

@ -4,10 +4,11 @@
> import Data.Monoid (mempty)
> import qualified Data.ByteString.Char8 as S8
> import qualified Data.Text as T
> import Text.Blaze (string)
> data Echo = Echo
> mkYesod "Echo" [$parseRoutes|
> mkYesod "Echo" [parseRoutes|
> / Homepage GET POST
> |]

13
yesod-examples/src/form.lhs
View File

@ -7,25 +7,26 @@
> import Data.Text (Text)
> data FormExample = FormExample
> type Handler = GHandler FormExample FormExample
> mkYesod "FormExample" [$parseRoutes|
> mkYesod "FormExample" [parseRoutes|
> / RootR GET
> |]
> 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 p = fieldsToTable $ Person
> <$> stringField "Name" (fmap name p)
> <*> intField "Age" (fmap age p)
> 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
> ((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>

16
yesod-examples/src/generalized-hamlet.lhs
View File

@ -4,7 +4,7 @@ Yesod has instances for:
* Html
* Hamlet url (= (url -> [(String, String)] -> String) -> Html)
* HtmlUrl (= (url -> [(String, String)] -> String) -> Html)
* GWidget s m ()
@ -13,15 +13,15 @@ your own instances.
> {-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell #-}
> import Yesod
> import Text.Hamlet (shamlet)
> 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!|]
> myHtml = [shamlet|<p>Just don't use any URLs in here!|]
>
> myInnerWidget :: Widget ()
> myInnerWidget :: Widget
> myInnerWidget = do
> addHamlet [$hamlet|
> <div #inner>Inner widget
@ -31,14 +31,14 @@ your own instances.
>#inner
> color: red|]
>
> myPlainTemplate :: Hamlet NewHamletRoute
> myPlainTemplate = [$hamlet|
> myPlainTemplate :: HtmlUrl NewHamletRoute
> myPlainTemplate = [hamlet|
> <p
> <a href=@{RootR}>Link to home
> |]
>
> myWidget :: Widget ()
> myWidget = [$hamlet|
> myWidget :: Widget
> myWidget = [whamlet|
> <h1>Embed another widget
> \^{myInnerWidget}
> <h1>Embed a Hamlet

1
yesod-examples/src/i18n.lhs
View File

@ -9,7 +9,6 @@
> import Data.Text (Text)
> data I18N = I18N
> type Handler = GHandler I18N I18N
> mkYesod "I18N" [$parseRoutes|
> / HomepageR GET

5
yesod-examples/src/pretty-yaml.lhs
View File

@ -9,7 +9,6 @@
> import qualified Data.ByteString.Lazy as L
> data PY = PY
> type Handler = GHandler PY PY
> mkYesod "PY" [$parseRoutes|
> / Homepage GET POST
@ -17,7 +16,7 @@
> instance Yesod PY where approot _ = ""
> template :: Maybe (Hamlet url) -> Hamlet url
> template :: Maybe (HtmlUrl url) -> HtmlUrl url
> template myaml = [$hamlet|
> !!!
>
@ -46,7 +45,7 @@
> so <- liftIO $ decode $ B.concat $ L.toChunks $ fileContent fi
> hamletToRepHtml $ template $ Just $ objToHamlet so
> objToHamlet :: StringObject -> Hamlet url
> objToHamlet :: StringObject -> HtmlUrl url
> objToHamlet (Scalar s) = [$hamlet|#{s}|]
> objToHamlet (Sequence list) = [$hamlet|
> <ul

24
yesod-examples/src/session.lhs
View File

@ -3,10 +3,17 @@
> import Control.Applicative ((<$>), (<*>))
>
> data Session = Session
> type Handler = GHandler Session Session
> mkYesod "Session" [$parseRoutes|
> 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
@ -20,12 +27,9 @@
>
> 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
> (key, val) <- runInputPost $ (,) <$> ireq textField "key" <*> ireq textField "val"
> setSession key val
> liftIO $ print (key, val)
> redirect RedirectTemporary Root
>
> main = warpDebug 3000 Session

33
yesod-examples/src/widgets.lhs
View File

@ -1,13 +1,13 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-}
> import Yesod
> import Yesod.Helpers.Static
> 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 }
> type Handler = GHandler HW HW
> mkYesod "HW" [$parseRoutes|
> / RootR GET
> /form FormR
@ -17,10 +17,13 @@
> instance Yesod HW where approot _ = ""
> instance YesodJquery HW
> instance YesodNic HW
> wrapper h = [$hamlet|
> wrapper h = [hamlet|
> <#wrapper>^{h}
> <footer>Brought to you by Yesod Widgets&trade;
> |]
> instance RenderMessage HW FormMessage where
> renderMessage _ _ = defaultFormMessage
>
> getRootR = defaultLayout $ wrapper $ do
> i <- lift newIdent
> setTitle $ string "Hello Widgets"
@ -42,17 +45,17 @@
> 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"
> (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")
> <*> maybeEmailField "An e-mail addres" Nothing
> <*> aopt emailField "An e-mail addres" Nothing
> let mhtml = case res of
> FormSuccess (_, _, _, _, _, _, _, x, _) -> Just x
> _ -> Nothing
@ -77,11 +80,11 @@
> |]
> setTitle $ string "Form"
>
> main = warpDebug 3000 $ HW $ static "static"
> main = static "static" >>= (warpDebug 3000 . HW)
>
> getAutoCompleteR :: Handler RepJson
> getAutoCompleteR = do
> term <- runFormGet' $ stringInput "term"
> term <- runInputGet $ ireq textField "term"
> jsonToRepJson $ jsonList
> [ jsonScalar $ unpack term ++ "foo"
> , jsonScalar $ unpack term ++ "bar"

6
yesod-examples/synopsis/persistent.lhs
View File

@ -1,12 +1,12 @@
This example uses the sqlite backend for Persistent, since it can run in-memory and has no external dependencies.
> {-# LANGUAGE TypeFamilies, GeneralizedNewtypeDeriving, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
> {-# LANGUAGE GADTs, TypeFamilies, GeneralizedNewtypeDeriving, QuasiQuotes, TemplateHaskell, OverloadedStrings #-}
>
> import Database.Persist.Sqlite
> import Database.Persist.TH
> import Control.Monad.IO.Class (liftIO)
>
> mkPersist [$persist|Person
> mkPersist sqlSettings [persist|Person
> name String Eq
> age Int Update
> |]
@ -21,7 +21,7 @@ This example uses the sqlite backend for Persistent, since it can run in-memory
> liftIO $ print key
> p1 <- get key
> liftIO $ print p1
> update key [PersonAge 26]
> update key [PersonAge =. 26]
> p2 <- get key
> liftIO $ print p2
> p3 <- selectList [PersonName ==. "Michael"] []

18
yesod-examples/yesod-examples.cabal
View File

@ -18,21 +18,25 @@ extra-source-files: static/yesod/ajax/script.js,
Executable yesod-blog
Main-is: src/blog.lhs
Build-depends: base >= 4 && < 5,
yesod >= 0.8 && < 0.9
yesod >= 0.9
Executable yesod-ajax
Main-is: src/ajax.lhs
Build-depends: yesod-static
Build-depends: yesod-static,
blaze-html,
yesod >= 0.9
Executable yesod-file-echo
Main-is: src/file-echo.lhs
Build-depends: text
Build-depends: text,
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 && < 0.10
bytestring >= 0.9 && < 0.10,
yesod >= 0.9
Executable yesod-i18n
Main-is: src/i18n.lhs
@ -40,9 +44,9 @@ Executable yesod-i18n
Executable yesod-session
Main-is: src/session.lhs
Executable yesod-widgets
Main-is: src/widgets.lhs
Build-depends: yesod-form
-- Executable yesod-widgets
-- Main-is: src/widgets.lhs
-- Build-depends: yesod-form
Executable yesod-generalized-hamlet
Main-is: src/generalized-hamlet.lhs