Added two basic examples

Yesod.hs

@@ -19,6 +19,9 @@ module Yesod
     , module Yesod.Definitions
     , module Yesod.Handler
     , module Yesod.Resource
+    , module Data.Object.Html
+    , module Yesod.Rep
+    , module Data.Convertible.Text
     , Application
     ) where
 
@@ -29,3 +32,6 @@ import Yesod.Definitions
 import Yesod.Handler
 import Yesod.Resource
 import Hack (Application)
+import Yesod.Rep
+import Data.Object.Html
+import Data.Convertible.Text

Yesod/Helpers/Auth.hs

@@ -26,9 +26,6 @@ import qualified Web.Authenticate.Rpxnow as Rpxnow
 import qualified Web.Authenticate.OpenId as OpenId
 import Data.Enumerable
 
-import Data.Object.Html
-import Data.Convertible.Text
-
 import Yesod
 import Yesod.Constants
 

Yesod/Helpers/Sitemap.hs

@@ -86,13 +86,15 @@ instance HasReps SitemapResponse where
         [ (TypeXml, return . cs)
         ]
 
-sitemap :: Yesod yesod => IO [SitemapUrl] -> Handler yesod SitemapResponse
+sitemap :: YesodApproot yesod
+        => IO [SitemapUrl]
+        -> Handler yesod SitemapResponse
 sitemap urls' = do
     yesod <- getYesod
     urls <- liftIO urls'
     return $ SitemapResponse urls $ approot yesod
 
-robots :: Yesod yesod => Handler yesod Plain
+robots :: YesodApproot yesod => Handler yesod Plain
 robots = do
     yesod <- getYesod
     return $ plain $ "Sitemap: " ++ unApproot (approot yesod)

Yesod/Resource.hs

@@ -38,6 +38,10 @@ import Data.Char (isDigit)
 
 import Language.Haskell.TH.Syntax
 import Language.Haskell.TH.Quote
+{- Debugging
+import Language.Haskell.TH.Ppr
+import System.IO
+-}
 
 import Data.Typeable (Typeable)
 import Control.Exception (Exception)
@@ -263,7 +267,10 @@ instance Exception RepeatedVerb
 rpnodesTHCheck :: [RPNode] -> Q Exp
 rpnodesTHCheck nodes = do
     nodes' <- runIO $ checkRPNodes nodes
-    -- For debugging purposes runIO $ putStrLn $ pprint res
+    {- For debugging purposes
+    rpnodesTH nodes' >>= runIO . putStrLn . pprint
+    runIO $ hFlush stdout
+    -}
     rpnodesTH nodes'
 
 notFoundVerb :: Verb -> Handler yesod a
@@ -338,11 +345,6 @@ countParams (RP rpps) = helper 0 rpps where
     helper i (Static _:rest) = helper i rest
     helper i (_:rest) = helper (i + 1) rest
 
-instance Lift RPNode where
-    lift (RPNode rp vm) = do
-        rp' <- lift rp
-        vm' <- liftVerbMap vm $ countParams rp
-        return $ TupE [rp', vm']
 instance Lift RP where
     lift (RP rpps) = do
         rpps' <- lift rpps
@@ -365,14 +367,17 @@ liftVerbMap :: VerbMap -> Int -> Q Exp
 liftVerbMap (AllVerbs s) _ = do
     cr <- [|(.) (fmap chooseRep)|]
     return $ cr `AppE` ((VarE $ mkName s) `AppE` (VarE $ mkName "verb"))
-liftVerbMap (Verbs vs) params =
-      return $ CaseE (VarE $ mkName "verb")
-             $ map helper vs ++ [whenNotFound]
+liftVerbMap (Verbs vs) params = do
+    cr0 <- [|fmap chooseRep|]
+    cr1 <- [|(.) (fmap chooseRep)|]
+    let cr = if params == 0 then cr0 else cr1
+    return $ CaseE (VarE $ mkName "verb")
+           $ map (helper cr) vs ++ [whenNotFound]
         where
-            helper :: (Verb, String) -> Match
-            helper (v, f) =
+            helper :: Exp -> (Verb, String) -> Match
+            helper cr (v, f) =
                 Match (ConP (mkName $ show v) [])
-                      (NormalB $ VarE $ mkName f)
+                      (NormalB $ cr `AppE` VarE (mkName f))
                       []
             whenNotFound :: Match
             whenNotFound =

Yesod/Yesod.hs

@@ -1,6 +1,7 @@
 -- | The basic typeclass for a Yesod application.
 module Yesod.Yesod
     ( Yesod (..)
+    , YesodApproot (..)
     , toHackApp
     ) where
 
@@ -35,6 +36,7 @@ class Yesod a where
     errorHandler :: ErrorResult -> Handler a RepChooser
     errorHandler = defaultErrorHandler
 
+class Yesod a => YesodApproot a where
     -- | An absolute URL to the root of the application.
     approot :: a -> Approot
 

examples/hellotemplate.lhs

@@ -0,0 +1,22 @@
+\begin{code}
+{-# LANGUAGE QuasiQuotes #-}
+
+import Yesod
+import Hack.Handler.SimpleServer
+
+data HelloWorld = HelloWorld
+instance Yesod HelloWorld where
+    handlers = [$resources|
+/:
+    Get: helloWorld
+|]
+
+helloWorld :: Handler HelloWorld TemplateFile
+helloWorld = return $ TemplateFile "examples/template.html" $ cs
+                [ ("title", "Hello world!")
+                , ("content", "Hey look!! I'm <auto escaped>!")
+                ]
+
+main :: IO ()
+main = putStrLn "Running..." >> run 3000 (toHackApp HelloWorld)
+\end{code}

examples/helloworld.lhs

@@ -0,0 +1,19 @@
+\begin{code}
+{-# LANGUAGE QuasiQuotes #-}
+
+import Yesod
+import Hack.Handler.SimpleServer
+
+data HelloWorld = HelloWorld
+instance Yesod HelloWorld where
+    handlers = [$resources|
+/:
+    Get: helloWorld
+|]
+
+helloWorld :: Handler HelloWorld HtmlObject
+helloWorld = return $ cs "Hello world!"
+
+main :: IO ()
+main = putStrLn "Running..." >> run 3000 (toHackApp HelloWorld)
+\end{code}

examples/template.html

@@ -0,0 +1,26 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8">
+    <title>$o.title$</title>
+    <style>
+      body {
+        background-color: #ffc;
+      }
+
+      #wrapper {
+        width: 600px;
+        margin: 2em auto;
+        background-color: #fefefe;
+        border: 1px solid black;
+        padding: 1em;
+        font-family: sans-serif;
+      }
+    </style>
+  </head>
+  <body>
+    <div id="wrapper">
+      $o.content$
+    </div>
+  </body>
+</html>

test/quasi-resource.hs

@@ -2,8 +2,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 
 import Yesod
-import Yesod.Rep
-import Data.Object.Html
 
 data MyYesod = MyYesod
 
@@ -11,18 +9,18 @@ instance Show (Handler MyYesod RepChooser) where show _ = "Another handler"
 
 getStatic :: Verb -> [String] -> Handler MyYesod HtmlObject
 getStatic v p = return $ toHtmlObject ["getStatic", show v, show p]
-pageIndex :: Handler MyYesod RepChooser
-pageIndex = return $ chooseRep $ toHtmlObject ["pageIndex"]
+pageIndex :: Handler MyYesod HtmlObject
+pageIndex = return $ toHtmlObject ["pageIndex"]
 pageAdd :: Handler MyYesod RepChooser
 pageAdd = return $ chooseRep $ toHtmlObject ["pageAdd"]
 pageDetail :: String -> Handler MyYesod RepChooser
 pageDetail s = return $ chooseRep $ toHtmlObject ["pageDetail", s]
-pageDelete :: String -> Handler MyYesod RepChooser
-pageDelete s = return $ chooseRep $ toHtmlObject ["pageDelete", s]
+pageDelete :: String -> Handler MyYesod HtmlObject
+pageDelete s = return $ toHtmlObject ["pageDelete", s]
 pageUpdate :: String -> Handler MyYesod RepChooser
 pageUpdate s = return $ chooseRep $ toHtmlObject ["pageUpdate", s]
-userInfo :: Int -> Handler MyYesod RepChooser
-userInfo i = return $ chooseRep $ toHtmlObject ["userInfo", show i]
+userInfo :: Int -> Handler MyYesod HtmlObject
+userInfo i = return $ toHtmlObject ["userInfo", show i]
 
 instance Show (Verb -> Handler MyYesod RepChooser) where
     show _ = "verb -> handler"

yesod.cabal

@@ -16,6 +16,10 @@ flag buildtests
   description: Build the executable to run unit tests
   default: False
 
+flag buildsamples
+  description: Build the executable to run unit tests
+  default: False
+
 flag nolib
   description: Skip building of the library.
   default: False
@@ -87,3 +91,28 @@ executable             runtests
         Buildable: False
     ghc-options:     -Wall
     main-is:         runtests.hs
+
+executable             quasi-test
+  if flag(buildsamples)
+    Buildable: True
+  else
+    Buildable: False
+  ghc-options:         -Wall
+  main-is:             test/quasi-resource.hs
+
+executable             helloworld
+  if flag(buildsamples)
+    Buildable: True
+  else
+    Buildable: False
+  ghc-options:         -Wall
+  build-depends:       hack-handler-simpleserver >= 0.2.0 && < 0.3
+  main-is:             examples/helloworld.lhs
+
+executable             hellotemplate
+  if flag(buildsamples)
+    Buildable: True
+  else
+    Buildable: False
+  ghc-options:         -Wall
+  main-is:             examples/hellotemplate.lhs