diff --git a/.gitignore b/.gitignore index c17db52f..00255d26 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,5 @@ dist *.swp client_session_key.aes +*.hi +*.o diff --git a/Yesod/Helpers/Auth.hs b/Yesod/Helpers/Auth.hs index 105ab62f..2e4b643e 100644 --- a/Yesod/Helpers/Auth.hs +++ b/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 diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index e186d019..3daf4687 100644 --- a/Yesod/Yesod.hs +++ b/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 diff --git a/examples/hamlet.hs b/examples/hamlet.hs new file mode 100644 index 00000000..8c8a6c0e --- /dev/null +++ b/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