Split hamlet code into separate module
This commit is contained in:
parent
aa2cc2f0eb
commit
572718bbd6
47
Yesod/Hamlet.hs
Normal file
47
Yesod/Hamlet.hs
Normal 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
|
||||||
@ -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
|
||||||
|])
|
|])
|
||||||
|
|||||||
@ -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]
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user