diff --git a/yesod-examples/src/ajax.lhs b/yesod-examples/src/ajax.lhs index 3618204f..9396aef1 100644 --- a/yesod-examples/src/ajax.lhs +++ b/yesod-examples/src/ajax.lhs @@ -5,15 +5,14 @@ > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} > import Yesod > import Yesod.Static -> import Data.Monoid (mempty) -> import Text.Blaze (string) +> import Data.Text (Text, unpack) Like the blog example, we'll define some data first. > data Page = Page -> { pageName :: String -> , pageSlug :: String -> , pageContent :: String +> { pageName :: Text +> , pageSlug :: Text +> , pageContent :: Text > } > loadPages :: IO [Page] @@ -36,7 +35,7 @@ Now the routes; we'll have a homepage, a pattern for the pages, and use a static > mkYesod "Ajax" [parseRoutes| > / HomeR GET -> /page/#String PageR GET +> /page/#Text PageR GET > /static StaticR Static ajaxStatic > |] @@ -49,7 +48,7 @@ Now the routes; we'll have a homepage, a pattern for the pages, and use a static > defaultLayout widget = do > Ajax pages _ <- getYesod > content <- widgetToPageContent widget -> hamletToRepHtml [$hamlet| +> hamletToRepHtml [hamlet| > \ > > @@ -80,23 +79,23 @@ Now the routes; we'll have a homepage, a pattern for the pages, and use a static And now the cool part: a handler that returns either HTML or JSON data, depending on the request headers. -> getPageR :: String -> Handler RepHtmlJson +> getPageR :: Text -> Handler RepHtmlJson > getPageR slug = do > Ajax pages _ <- getYesod > case filter (\e -> pageSlug e == slug) pages of > [] -> notFound > page:_ -> defaultLayoutJson (do -> setTitle $ string $ pageName page +> setTitle $ toHtml $ pageName page > addHamlet $ html page > ) (json page) > where -> html page = [$hamlet| +> html page = [hamlet| >

#{pageName page} >
#{pageContent page} > |] > json page = jsonMap -> [ ("name", jsonScalar $ pageName page) -> , ("content", jsonScalar $ pageContent page) +> [ ("name", jsonScalar $ unpack $ pageName page) +> , ("content", jsonScalar $ unpack $ 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.

@@ -110,3 +109,8 @@ And now the cool part: a handler that returns either HTML or JSON data, dependin > pages <- loadPages > s <- static "static/yesod/ajax" > warpDebug 3000 $ Ajax pages s + +And just to avoid some warnings... + +> _ignored :: Widget +> _ignored = undefined ajaxPages diff --git a/yesod-examples/src/blog.lhs b/yesod-examples/src/blog.lhs index 65fd2bdd..8e59cdd9 100644 --- a/yesod-examples/src/blog.lhs +++ b/yesod-examples/src/blog.lhs @@ -113,3 +113,8 @@ All that's left now is the main function. Yesod is built on top of WAI, so you c > main = do > entries <- loadEntries > warpDebug 3000 $ Blog entries + +And this is just to avoid some warnings... + +> _ignored :: Widget +> _ignored = undefined blogEntries diff --git a/yesod-examples/src/chat.hs b/yesod-examples/src/chat.hs index d0551238..eb138906 100644 --- a/yesod-examples/src/chat.hs +++ b/yesod-examples/src/chat.hs @@ -9,8 +9,6 @@ import Yesod import Yesod.Static import Control.Concurrent.STM -import Control.Concurrent.STM.TChan -import Control.Concurrent.STM.TVar import Control.Arrow ((***)) import Data.Text (Text, unpack) @@ -27,7 +25,7 @@ data Chat = Chat staticFiles "static" -mkYesod "Chat" [$parseRoutes| +mkYesod "Chat" [parseRoutes| / HomeR GET /check CheckR GET /post PostR GET @@ -38,18 +36,17 @@ instance Yesod Chat where approot _ = "" defaultLayout widget = do content <- widgetToPageContent widget - hamletToRepHtml [$hamlet|\ - \ + hamletToRepHtml [hamlet| +!!! - - - #{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} - \ +<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 @@ -66,8 +63,8 @@ getHomeR = do return c defaultLayout $ do setTitle "Chat Page" - toWidget [$hamlet|\ -\<!DOCTYPE html> + toWidget [hamlet| +!!! <h1>Chat Example <form> @@ -97,6 +94,7 @@ getCheckR = do 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 diff --git a/yesod-examples/src/file-echo.lhs b/yesod-examples/src/file-echo.lhs index fc490f83..ed86a365 100644 --- a/yesod-examples/src/file-echo.lhs +++ b/yesod-examples/src/file-echo.lhs @@ -1,10 +1,8 @@ > {-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} > import Yesod -> import Data.Monoid (mempty) > import qualified Data.ByteString.Char8 as S8 > import qualified Data.Text as T -> import Text.Blaze (string) > data Echo = Echo @@ -14,18 +12,26 @@ > instance Yesod Echo where approot _ = "" +> getHomepage :: Handler RepHtml > getHomepage = defaultLayout $ do -> setTitle $ string "Upload a file" -> addHamlet [$hamlet| -> %form!method=post!action=.!enctype=multipart/form-data +> setTitle "Upload a file" +> addHamlet [hamlet| +> <form method=post action=. enctype=multipart/form-data> > File name: -> %input!type=file!name=file -> %input!type=submit +> <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 diff --git a/yesod-examples/src/form.lhs b/yesod-examples/src/form.lhs index 57855e51..927fb6fa 100644 --- a/yesod-examples/src/form.lhs +++ b/yesod-examples/src/form.lhs @@ -2,7 +2,7 @@ > {-# LANGUAGE TypeFamilies, QuasiQuotes, OverloadedStrings, MultiParamTypeClasses, TemplateHaskell #-} -> import Yesod +> import Yesod hiding (Form) > import Control.Applicative > import Data.Text (Text) @@ -10,6 +10,8 @@ > 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 @@ -18,6 +20,7 @@ Next, we'll declare a Person datatype with a name and age. After that, we'll cre > 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) @@ -38,14 +41,15 @@ We use an applicative approach and stay mostly declarative. The "fmap name p" bi <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| +> addHamlet [hamlet| > <p>Last result: #{show res} > <form enctype="#{enctype}"> > <table> -> \^{form} +> ^{form} > <tr> > <td colspan="2"> > <input type="submit"> > |] > +> main :: IO () > main = warpDebug 3000 FormExample diff --git a/yesod-examples/src/generalized-hamlet.lhs b/yesod-examples/src/generalized-hamlet.lhs deleted file mode 100644 index 01d7dc78..00000000 --- a/yesod-examples/src/generalized-hamlet.lhs +++ /dev/null @@ -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 - -* HtmlUrl (= (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, MultiParamTypeClasses, OverloadedStrings, TemplateHaskell #-} -> import Yesod -> import Text.Hamlet (shamlet) -> data NewHamlet = NewHamlet -> mkYesod "NewHamlet" [$parseRoutes|/ RootR GET|] -> instance Yesod NewHamlet where approot _ = "" -> -> myHtml :: Html -> myHtml = [shamlet|<p>Just don't use any URLs in here!|] -> -> myInnerWidget :: Widget -> myInnerWidget = do -> addHamlet [$hamlet| -> <div #inner>Inner widget -> #{myHtml} -> |] -> addCassius [$cassius| ->#inner -> color: red|] -> -> myPlainTemplate :: HtmlUrl NewHamletRoute -> myPlainTemplate = [hamlet| -> <p -> <a href=@{RootR}>Link to home -> |] -> -> myWidget :: Widget -> myWidget = [whamlet| -> <h1>Embed another widget -> \^{myInnerWidget} -> <h1>Embed a Hamlet -> \^{addHamlet myPlainTemplate} -> |] -> -> getRootR :: GHandler NewHamlet NewHamlet RepHtml -> getRootR = defaultLayout myWidget -> -> main :: IO () -> main = warpDebug 3000 NewHamlet diff --git a/yesod-examples/src/i18n.lhs b/yesod-examples/src/i18n.lhs index 12bd0f52..99eb47a6 100644 --- a/yesod-examples/src/i18n.lhs +++ b/yesod-examples/src/i18n.lhs @@ -6,20 +6,11 @@ > {-# LANGUAGE CPP #-} > import Yesod -> import Data.Monoid (mempty) > import Data.Text (Text) -To work on both ghc6 and ghc7 - -#if GHC7 -# define QQ(x) x -#else -# define QQ(x) $x -#endif - > data I18N = I18N -> mkYesod "I18N" [QQ(parseRoutes)| +> mkYesod "I18N" [parseRoutes| > / HomepageR GET > /set/#Text SetLangR GET > |] @@ -38,7 +29,7 @@ To work on both ghc6 and ghc7 > ] > defaultLayout $ do > setTitle "I18N Homepage" -> addHamlet [QQ(hamlet)| +> addHamlet [hamlet| > <h1>#{hello} > <p>In other languages: > <ul> @@ -60,3 +51,6 @@ To work on both ghc6 and ghc7 > main :: IO () > main = warpDebug 3000 I18N + +> _ignored :: Widget +> _ignored = undefined diff --git a/yesod-examples/src/pretty-yaml.lhs b/yesod-examples/src/pretty-yaml.lhs index c8d8bbcf..f8786553 100644 --- a/yesod-examples/src/pretty-yaml.lhs +++ b/yesod-examples/src/pretty-yaml.lhs @@ -10,14 +10,14 @@ > data PY = PY -> mkYesod "PY" [$parseRoutes| +> mkYesod "PY" [parseRoutes| > / Homepage GET POST > |] > instance Yesod PY where approot _ = "" > template :: Maybe (HtmlUrl url) -> HtmlUrl url -> template myaml = [$hamlet| +> template myaml = [hamlet| > !!! > > <html> @@ -46,13 +46,13 @@ > hamletToRepHtml $ template $ Just $ objToHamlet so > objToHamlet :: StringObject -> HtmlUrl url -> objToHamlet (Scalar s) = [$hamlet|#{s}|] -> objToHamlet (Sequence list) = [$hamlet| +> objToHamlet (Scalar s) = [hamlet|#{s}|] +> objToHamlet (Sequence list) = [hamlet| > <ul > $forall o <- list > <li>^{objToHamlet o} > |] -> objToHamlet (Mapping pairs) = [$hamlet| +> objToHamlet (Mapping pairs) = [hamlet| > <dl > $forall pair <- pairs > <dt>#{fst pair} @@ -61,3 +61,6 @@ > main :: IO () > main = warpDebug 3000 PY + +> _ignored :: Widget +> _ignored = undefined diff --git a/yesod-examples/src/session.lhs b/yesod-examples/src/session.lhs index 0de63ed5..083783c7 100644 --- a/yesod-examples/src/session.lhs +++ b/yesod-examples/src/session.lhs @@ -17,7 +17,7 @@ > getRoot :: Handler RepHtml > getRoot = do > sess <- getSession -> hamletToRepHtml [$hamlet| +> hamletToRepHtml [hamlet| > <form method=post > <input type=text name=key > <input type=text name=val @@ -32,4 +32,8 @@ > liftIO $ print (key, val) > redirect RedirectTemporary Root > +> main :: IO () > main = warpDebug 3000 Session + +> _ignored :: Widget +> _ignored = undefined diff --git a/yesod-examples/synopsis/hamlet.lhs b/yesod-examples/synopsis/hamlet.lhs index a700a1ec..c885ccbc 100644 --- a/yesod-examples/synopsis/hamlet.lhs +++ b/yesod-examples/synopsis/hamlet.lhs @@ -2,7 +2,6 @@ {-# LANGUAGE QuasiQuotes, OverloadedStrings #-} import Text.Hamlet -import Yesod.Widget import Data.Text (Text, cons) import qualified Data.Text.Lazy.IO as L import Text.Blaze.Renderer.Text (renderHtml) @@ -19,15 +18,15 @@ data PersonUrls = Homepage | PersonPage Text renderUrls :: PersonUrls -> [(Text, Text)] -> Text renderUrls Homepage _ = "/" -renderUrls (PersonPage name) _ = '/' `cons` name +renderUrls (PersonPage name') _ = '/' `cons` name' footer :: HtmlUrl url -footer = [$hamlet|\ +footer = [hamlet| <div id="footer">Thank you, come again |] template :: Person -> HtmlUrl PersonUrls -template person = [$hamlet| +template person = [hamlet| !!! <html> diff --git a/yesod-examples/synopsis/persistent.lhs b/yesod-examples/synopsis/persistent.lhs index 1737a81b..095a01c6 100644 --- a/yesod-examples/synopsis/persistent.lhs +++ b/yesod-examples/synopsis/persistent.lhs @@ -37,3 +37,6 @@ 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 diff --git a/yesod-examples/yesod-examples.cabal b/yesod-examples/yesod-examples.cabal index 0f0bc0b6..8b6c3a0c 100644 --- a/yesod-examples/yesod-examples.cabal +++ b/yesod-examples/yesod-examples.cabal @@ -52,9 +52,6 @@ Executable yesod-session -- Main-is: src/widgets.lhs -- Build-depends: yesod-form -Executable yesod-generalized-hamlet - Main-is: src/generalized-hamlet.lhs - Executable yesod-form Main-is: src/form.lhs @@ -63,6 +60,7 @@ Executable yesod-persistent-synopsis 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