Split hamlet code into separate module

This commit is contained in:
Michael Snoyman 2010-04-14 08:49:15 -07:00
parent aa2cc2f0eb
commit 572718bbd6
4 changed files with 50 additions and 34 deletions

47
Yesod/Hamlet.hs Normal file
View File

@ -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

View File

@ -40,6 +40,7 @@ data Static = Static FileLookup
staticArgs :: FileLookup -> Static staticArgs :: FileLookup -> Static
staticArgs = Static staticArgs = Static
-- FIXME bug in web-routes-quasi generates warning here
$(mkYesod "Static" [$parseRoutes| $(mkYesod "Static" [$parseRoutes|
/* StaticRoute GET /* StaticRoute GET
|]) |])

View File

@ -8,8 +8,6 @@ module Yesod.Yesod
, getApproot , getApproot
, toWaiApp , toWaiApp
, basicHandler , basicHandler
, hamletToContent -- FIXME put elsewhere
, hamletToRepHtml
) where ) where
import Data.Object.Html import Data.Object.Html
@ -17,6 +15,7 @@ import Data.Object.Json (unJsonDoc)
import Yesod.Response import Yesod.Response
import Yesod.Request import Yesod.Request
import Yesod.Definitions import Yesod.Definitions
import Yesod.Hamlet
import Yesod.Handler hiding (badMethod) import Yesod.Handler hiding (badMethod)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Char8 as B8
@ -26,8 +25,6 @@ import Web.Mime
import Web.Encodings (parseHttpAccept) import Web.Encodings (parseHttpAccept)
import Web.Routes (Site (..), encodePathInfo, decodePathInfo) import Web.Routes (Site (..), encodePathInfo, decodePathInfo)
import Data.List (intercalate) import Data.List (intercalate)
import Text.Hamlet
import Text.Hamlet.Monad (outputHtml)
import qualified Network.Wai as W import qualified Network.Wai as W
import Network.Wai.Middleware.CleanPath import Network.Wai.Middleware.CleanPath
@ -43,19 +40,6 @@ import System.Environment (getEnvironment)
class YesodSite y where class YesodSite y where
getSite :: Site (Routes y) (String -> YesodApp -> y -> YesodApp) 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 class YesodSite a => Yesod a where
-- | The encryption key to be used for encrypting client sessions. -- | The encryption key to be used for encrypting client sessions.
encryptKey :: a -> IO Word256 encryptKey :: a -> IO Word256
@ -124,18 +108,6 @@ applyLayoutJson t b = do
, (TypeJson, cs $ unJsonDoc $ cs b) , (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 :: Yesod y => Handler y Approot
getApproot = approot `fmap` getYesod getApproot = approot `fmap` getYesod
@ -218,11 +190,6 @@ basicHandler port app = do
badMethod :: YesodApp badMethod :: YesodApp
badMethod = YesodApp $ \eh req cts -> unYesodApp (eh BadMethod) eh req cts 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 :: [String] -> [String]
fixSegs [] = [] fixSegs [] = []
fixSegs [x] fixSegs [x]

View File

@ -67,6 +67,7 @@ library
Yesod.Response Yesod.Response
Yesod.Definitions Yesod.Definitions
Yesod.Form Yesod.Form
Yesod.Hamlet
Yesod.Handler Yesod.Handler
Yesod.Resource Yesod.Resource
Yesod.Yesod Yesod.Yesod