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 client_session_key.aes
dist dist
cabal-dev/

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

@ -4,8 +4,9 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-}
> import Yesod > import Yesod
> import Yesod.Helpers.Static > import Yesod.Static
> import Data.Monoid (mempty) > import Data.Monoid (mempty)
> import Text.Blaze (string)
Like the blog example, we'll define some data first. 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] > { ajaxPages :: [Page]
> , ajaxStatic :: Static > , 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. 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. 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 > / HomeR GET
> /page/#String PageR GET > /page/#String PageR GET
> /static StaticR Static ajaxStatic > /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 :: IO ()
> main = do > main = do
> pages <- loadPages > pages <- loadPages
> let s = static "static/yesod/ajax" > s <- static "static/yesod/ajax"
> warpDebug 3000 $ Ajax pages s > 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. 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] } > 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: 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: And now the template itself:
> entryTemplate :: TemplateArgs -> Hamlet (Route Blog) > entryTemplate :: TemplateArgs -> HtmlUrl (Route Blog)
> entryTemplate args = [hamlet| > entryTemplate args = [hamlet|
> !!! > !!!
>
> <html> > <html>
> <head> > <head>
> <title>#{templateTitle args} > <title>#{templateTitle args}

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

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

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

@ -7,25 +7,26 @@
> import Data.Text (Text) > import Data.Text (Text)
> data FormExample = FormExample > data FormExample = FormExample
> type Handler = GHandler FormExample FormExample > mkYesod "FormExample" [parseRoutes|
> mkYesod "FormExample" [$parseRoutes|
> / RootR GET > / RootR GET
> |] > |]
> instance Yesod FormExample where approot _ = "" > 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. 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 } > data Person = Person { name :: Text, age :: Int }
> deriving Show > deriving Show
> personFormlet p = fieldsToTable $ Person > personFormlet p = renderTable $ Person
> <$> stringField "Name" (fmap name p) > <$> areq textField "Name" (fmap name p)
> <*> intField "Age" (fmap age 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". 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 :: Handler RepHtml
> getRootR = do > 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> <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 * Html
* Hamlet url (= (url -> [(String, String)] -> String) -> Html) * HtmlUrl (= (url -> [(String, String)] -> String) -> Html)
* GWidget s m () * GWidget s m ()
@ -13,15 +13,15 @@ your own instances.
> {-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell #-} > {-# LANGUAGE QuasiQuotes, TypeFamilies, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell #-}
> import Yesod > import Yesod
> import Text.Hamlet (shamlet)
> data NewHamlet = NewHamlet > data NewHamlet = NewHamlet
> mkYesod "NewHamlet" [$parseRoutes|/ RootR GET|] > mkYesod "NewHamlet" [$parseRoutes|/ RootR GET|]
> instance Yesod NewHamlet where approot _ = "" > instance Yesod NewHamlet where approot _ = ""
> type Widget = GWidget NewHamlet NewHamlet
> >
> myHtml :: Html > 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 > myInnerWidget = do
> addHamlet [$hamlet| > addHamlet [$hamlet|
> <div #inner>Inner widget > <div #inner>Inner widget
@ -31,14 +31,14 @@ your own instances.
>#inner >#inner
> color: red|] > color: red|]
> >
> myPlainTemplate :: Hamlet NewHamletRoute > myPlainTemplate :: HtmlUrl NewHamletRoute
> myPlainTemplate = [$hamlet| > myPlainTemplate = [hamlet|
> <p > <p
> <a href=@{RootR}>Link to home > <a href=@{RootR}>Link to home
> |] > |]
> >
> myWidget :: Widget () > myWidget :: Widget
> myWidget = [$hamlet| > myWidget = [whamlet|
> <h1>Embed another widget > <h1>Embed another widget
> \^{myInnerWidget} > \^{myInnerWidget}
> <h1>Embed a Hamlet > <h1>Embed a Hamlet

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

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

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

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

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

@ -3,10 +3,17 @@
> import Control.Applicative ((<$>), (<*>)) > import Control.Applicative ((<$>), (<*>))
> >
> data Session = Session > data Session = Session
> type Handler = GHandler Session Session > mkYesod "Session" [parseRoutes|
> mkYesod "Session" [$parseRoutes|
> / Root GET POST > / Root GET POST
> |] > |]
>
> instance Yesod Session where
> approot _ = ""
> clientSessionDuration _ = 1
>
> instance RenderMessage Session FormMessage where
> renderMessage _ _ = defaultFormMessage
>
> getRoot :: Handler RepHtml > getRoot :: Handler RepHtml
> getRoot = do > getRoot = do
> sess <- getSession > sess <- getSession
@ -20,12 +27,9 @@
> >
> postRoot :: Handler () > postRoot :: Handler ()
> postRoot = do > postRoot = do
> (key, val) <- runFormPost' $ (,) <$> stringInput "key" <*> stringInput "val" > (key, val) <- runInputPost $ (,) <$> ireq textField "key" <*> ireq textField "val"
> setSession key val > setSession key val
> liftIO $ print (key, val) > liftIO $ print (key, val)
> redirect RedirectTemporary Root > redirect RedirectTemporary Root
> >
> instance Yesod Session where
> approot _ = ""
> clientSessionDuration _ = 1
> main = warpDebug 3000 Session > main = warpDebug 3000 Session

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

@ -1,13 +1,13 @@
> {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-} > {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-}
> import Yesod > import Yesod
> import Yesod.Helpers.Static > import Yesod.Static
> import Yesod.Form.Jquery > import Yesod.Form.Jquery
> import Yesod.Form.Nic > import Yesod.Form.Nic
> import Control.Applicative > import Control.Applicative
> import Data.Text (unpack) > import Data.Text (unpack)
> import Text.Blaze (string)
> >
> data HW = HW { hwStatic :: Static } > data HW = HW { hwStatic :: Static }
> type Handler = GHandler HW HW
> mkYesod "HW" [$parseRoutes| > mkYesod "HW" [$parseRoutes|
> / RootR GET > / RootR GET
> /form FormR > /form FormR
@ -17,10 +17,13 @@
> instance Yesod HW where approot _ = "" > instance Yesod HW where approot _ = ""
> instance YesodJquery HW > instance YesodJquery HW
> instance YesodNic HW > instance YesodNic HW
> wrapper h = [$hamlet| > wrapper h = [hamlet|
> <#wrapper>^{h} > <#wrapper>^{h}
> <footer>Brought to you by Yesod Widgets&trade; > <footer>Brought to you by Yesod Widgets&trade;
> |] > |]
> instance RenderMessage HW FormMessage where
> renderMessage _ _ = defaultFormMessage
>
> getRootR = defaultLayout $ wrapper $ do > getRootR = defaultLayout $ wrapper $ do
> i <- lift newIdent > i <- lift newIdent
> setTitle $ string "Hello Widgets" > setTitle $ string "Hello Widgets"
@ -42,17 +45,17 @@
> addHtmlHead [$hamlet|<meta keywords=haskell|] > addHtmlHead [$hamlet|<meta keywords=haskell|]
> >
> handleFormR = do > handleFormR = do
> (res, form, enctype, nonce) <- runFormPost $ fieldsToTable $ (,,,,,,,,) > (res, form, enctype, nonce) <- runFormPost $ renderTable $ (,,,,,,,,)
> <$> stringField "My Field" Nothing > <$> aopt textField "My Field" Nothing
> <*> stringField "Another field" (Just "some default text") > <*> aopt textField "Another field" (Just "some default text")
> <*> intField "A number field" (Just 5) > <*> aopt intField "A number field" (Just 5)
> <*> jqueryDayField def "A day field" Nothing > <*> aopt jqueryDayField "A day field" Nothing
> <*> timeField "A time field" Nothing > <*> aopt timeField "A time field" Nothing
> <*> boolField "A checkbox" (Just False) > <*> aopt boolField "A checkbox" (Just False)
> <*> jqueryAutocompleteField AutoCompleteR "Autocomplete" Nothing > <*> aopt jqueryAutocompleteField AutoCompleteR "Autocomplete" Nothing
> <*> nicHtmlField "HTML" > <*> aopt nicHtmlField "HTML"
> (Just $ string "You can put <rich text> here") > (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 > let mhtml = case res of
> FormSuccess (_, _, _, _, _, _, _, x, _) -> Just x > FormSuccess (_, _, _, _, _, _, _, x, _) -> Just x
> _ -> Nothing > _ -> Nothing
@ -77,11 +80,11 @@
> |] > |]
> setTitle $ string "Form" > setTitle $ string "Form"
> >
> main = warpDebug 3000 $ HW $ static "static" > main = static "static" >>= (warpDebug 3000 . HW)
> >
> getAutoCompleteR :: Handler RepJson > getAutoCompleteR :: Handler RepJson
> getAutoCompleteR = do > getAutoCompleteR = do
> term <- runFormGet' $ stringInput "term" > term <- runInputGet $ ireq textField "term"
> jsonToRepJson $ jsonList > jsonToRepJson $ jsonList
> [ jsonScalar $ unpack term ++ "foo" > [ jsonScalar $ unpack term ++ "foo"
> , jsonScalar $ unpack term ++ "bar" > , 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. 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.Sqlite
> import Database.Persist.TH > import Database.Persist.TH
> import Control.Monad.IO.Class (liftIO) > import Control.Monad.IO.Class (liftIO)
> >
> mkPersist [$persist|Person > mkPersist sqlSettings [persist|Person
> name String Eq > name String Eq
> age Int Update > age Int Update
> |] > |]
@ -21,7 +21,7 @@ This example uses the sqlite backend for Persistent, since it can run in-memory
> liftIO $ print key > liftIO $ print key
> p1 <- get key > p1 <- get key
> liftIO $ print p1 > liftIO $ print p1
> update key [PersonAge 26] > update key [PersonAge =. 26]
> p2 <- get key > p2 <- get key
> liftIO $ print p2 > liftIO $ print p2
> p3 <- selectList [PersonName ==. "Michael"] [] > 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 Executable yesod-blog
Main-is: src/blog.lhs Main-is: src/blog.lhs
Build-depends: base >= 4 && < 5, Build-depends: base >= 4 && < 5,
yesod >= 0.8 && < 0.9 yesod >= 0.9
Executable yesod-ajax Executable yesod-ajax
Main-is: src/ajax.lhs Main-is: src/ajax.lhs
Build-depends: yesod-static Build-depends: yesod-static,
blaze-html,
yesod >= 0.9
Executable yesod-file-echo Executable yesod-file-echo
Main-is: src/file-echo.lhs Main-is: src/file-echo.lhs
Build-depends: text Build-depends: text,
yesod >= 0.9
Executable yesod-pretty-yaml Executable yesod-pretty-yaml
Main-is: src/pretty-yaml.lhs Main-is: src/pretty-yaml.lhs
Build-depends: data-object-yaml >= 0.3.0 && < 0.4, Build-depends: data-object-yaml >= 0.3.0 && < 0.4,
data-object >= 0.3.1 && < 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 Executable yesod-i18n
Main-is: src/i18n.lhs Main-is: src/i18n.lhs
@ -40,9 +44,9 @@ Executable yesod-i18n
Executable yesod-session Executable yesod-session
Main-is: src/session.lhs Main-is: src/session.lhs
Executable yesod-widgets -- Executable yesod-widgets
Main-is: src/widgets.lhs -- Main-is: src/widgets.lhs
Build-depends: yesod-form -- Build-depends: yesod-form
Executable yesod-generalized-hamlet Executable yesod-generalized-hamlet
Main-is: src/generalized-hamlet.lhs Main-is: src/generalized-hamlet.lhs