diff --git a/Yesod/Hamlet.hs b/Yesod/Hamlet.hs new file mode 100644 index 00000000..3a66c7cf --- /dev/null +++ b/Yesod/Hamlet.hs @@ -0,0 +1,47 @@ +module Yesod.Hamlet + ( hamletToContent + , hamletToRepHtml + , PageContent (..) + , Hamlet + , hamlet + , simpleContent + , HtmlContent (..) + ) + where + +import Text.Hamlet +import Text.Hamlet.Monad (outputHtml) +import Yesod.Response +import Yesod.Handler +import Data.Text (pack) +import Data.Convertible.Text (cs) + +data PageContent url = PageContent + { pageTitle :: IO HtmlContent + , pageHead :: Hamlet url IO () + , pageBody :: Hamlet url IO () + } + +simpleContent :: String -> HtmlContent -> PageContent url +simpleContent title body = PageContent + { pageTitle = return $ Unencoded $ pack title + , pageHead = return () + , pageBody = outputHtml body + } + +hamletToContent :: Hamlet (Routes y) IO () -> Handler y Content +hamletToContent h = do + render <- getUrlRender + return $ ContentEnum $ go render + where + go render iter seed = do + res <- runHamlet h render seed $ iter' iter + case res of + Left x -> return $ Left x + Right ((), x) -> return $ Right x + iter' iter seed text = iter seed $ cs text + +hamletToRepHtml :: Hamlet (Routes y) IO () -> Handler y RepHtml +hamletToRepHtml h = do + c <- hamletToContent h + return $ RepHtml c diff --git a/Yesod/Helpers/Static.hs b/Yesod/Helpers/Static.hs index 010f0647..9f1b6174 100644 --- a/Yesod/Helpers/Static.hs +++ b/Yesod/Helpers/Static.hs @@ -40,6 +40,7 @@ data Static = Static FileLookup staticArgs :: FileLookup -> Static staticArgs = Static +-- FIXME bug in web-routes-quasi generates warning here $(mkYesod "Static" [$parseRoutes| /* StaticRoute GET |]) diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index f63c89b0..34753fdb 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -8,8 +8,6 @@ module Yesod.Yesod , getApproot , toWaiApp , basicHandler - , hamletToContent -- FIXME put elsewhere - , hamletToRepHtml ) where import Data.Object.Html @@ -17,6 +15,7 @@ import Data.Object.Json (unJsonDoc) import Yesod.Response import Yesod.Request import Yesod.Definitions +import Yesod.Hamlet import Yesod.Handler hiding (badMethod) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 @@ -26,8 +25,6 @@ import Web.Mime import Web.Encodings (parseHttpAccept) import Web.Routes (Site (..), encodePathInfo, decodePathInfo) import Data.List (intercalate) -import Text.Hamlet -import Text.Hamlet.Monad (outputHtml) import qualified Network.Wai as W import Network.Wai.Middleware.CleanPath @@ -43,19 +40,6 @@ import System.Environment (getEnvironment) class YesodSite y where getSite :: Site (Routes y) (String -> YesodApp -> y -> YesodApp) -data PageContent url = PageContent - { pageTitle :: Hamlet url IO HtmlContent - , pageHead :: Hamlet url IO () - , pageBody :: Hamlet url IO () - } - -simpleContent :: String -> HtmlContent -> PageContent url -simpleContent title body = PageContent - { pageTitle = return $ Unencoded $ cs title - , pageHead = return () - , pageBody = outputHtml body - } - class YesodSite a => Yesod a where -- | The encryption key to be used for encrypting client sessions. encryptKey :: a -> IO Word256 @@ -124,18 +108,6 @@ applyLayoutJson t b = do , (TypeJson, cs $ unJsonDoc $ cs b) ] -hamletToContent :: Hamlet (Routes y) IO () -> Handler y Content -hamletToContent h = do - render <- getUrlRender - return $ ContentEnum $ go render - where - go render iter seed = do - res <- runHamlet h render seed $ iter' iter - case res of - Left x -> return $ Left x - Right ((), x) -> return $ Right x - iter' iter seed text = iter seed $ cs text - getApproot :: Yesod y => Handler y Approot getApproot = approot `fmap` getYesod @@ -218,11 +190,6 @@ basicHandler port app = do badMethod :: YesodApp badMethod = YesodApp $ \eh req cts -> unYesodApp (eh BadMethod) eh req cts -hamletToRepHtml :: Hamlet (Routes y) IO () -> Handler y RepHtml -hamletToRepHtml h = do - c <- hamletToContent h - return $ RepHtml c - fixSegs :: [String] -> [String] fixSegs [] = [] fixSegs [x] diff --git a/yesod.cabal b/yesod.cabal index 99d53f04..f9f9abee 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -67,6 +67,7 @@ library Yesod.Response Yesod.Definitions Yesod.Form + Yesod.Hamlet Yesod.Handler Yesod.Resource Yesod.Yesod