Added hamlet example

.gitignore

@@ -1,3 +1,5 @@
 dist
 *.swp
 client_session_key.aes
+*.hi
+*.o

Yesod/Helpers/Auth.hs

@@ -23,6 +23,8 @@ module Yesod.Helpers.Auth
     , redirectLogin
     ) where
 
+-- FIXME write as subsite
+
 import Web.Encodings
 import qualified Web.Authenticate.Rpxnow as Rpxnow
 import qualified Web.Authenticate.OpenId as OpenId

Yesod/Yesod.hs

@@ -8,6 +8,8 @@ module Yesod.Yesod
     , getApproot
     , toWaiApp
     , basicHandler
+    , hamletToContent -- FIXME put elsewhere
+    , hamletToRepHtml
     ) where
 
 import Data.Object.Html
@@ -183,7 +185,7 @@ toWaiApp' y resource session env = do
         pathSegments = filter (not . null) $ cleanupSegments resource
         eurl = parsePathSegments site pathSegments
         render u = approot y ++ '/'
-                 : encodePathInfo (formatPathSegments site u)
+                 : encodePathInfo (fixSegs $ formatPathSegments site u)
     rr <- parseWaiRequest env session
     onRequest y rr
     print pathSegments
@@ -222,3 +224,15 @@ basicHandler port app = do
 badMethod :: YesodApp y
 badMethod _ _ _ = return $ Response W.Status405 [] TypePlain
                 $ cs "Method not supported"
+
+hamletToRepHtml :: Hamlet (Routes y) IO () -> Handler y RepHtml
+hamletToRepHtml h = do
+    c <- hamletToContent h
+    return $ RepHtml c
+
+fixSegs :: [String] -> [String]
+fixSegs [] = []
+fixSegs [x]
+    | any (== '.') x = [x]
+    | otherwise = [x, ""] -- append trailing slash
+fixSegs (x:xs) = x : fixSegs xs

examples/hamlet.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+import Yesod
+import Network.Wai.Handler.SimpleServer
+import Text.Hamlet
+
+data Ham = Ham
+
+mkYesod "Ham" [$parseRoutes|
+/          Homepage GET
+/#another  Another  GET
+|]
+
+instance Yesod Ham where
+    approot _ = "http://localhost:3000"
+
+data NextLink m = NextLink { nextLink :: m HamRoutes }
+
+nl :: Monad m => HamRoutes -> NextLink m
+nl = NextLink . return
+
+template :: Monad m => NextLink (Hamlet HamRoutes m) -> Hamlet HamRoutes m ()
+template = [$hamlet|
+%a!href=@nextLink@ Next page
+|]
+
+getHomepage :: Handler Ham RepHtml
+getHomepage = hamletToRepHtml $ template $ nl $ Another 1
+
+getAnother :: Integer -> Handler Ham RepHtml
+getAnother i = hamletToRepHtml $ template $ nl next
+  where
+    next = case i of
+                5 -> Homepage
+                _ -> Another $ i + 1
+
+main :: IO ()
+main = do
+    putStrLn "Running..."
+    toWaiApp Ham >>= run 3000