Added ioTextToContent, fixed json/html order

This commit is contained in:
Michael Snoyman 2010-01-27 13:19:27 +02:00
parent 43c847ff93
commit f1184a1f66
3 changed files with 11 additions and 10 deletions

View File

@ -24,6 +24,7 @@ module Yesod.Response
, ChooseRep
, HasReps (..)
, defChooseRep
, ioTextToContent
-- ** Convenience wrappers
, staticRep
-- * Response type
@ -90,6 +91,12 @@ instance ConvertSuccess XmlDoc Content where
type ChooseRep = [ContentType] -> IO (ContentType, Content)
-- | It would be nice to simplify 'Content' to the point where this is
-- unnecesary.
ioTextToContent :: IO Text -> Content
ioTextToContent iotext =
Content $ \f a -> iotext >>= foldM f a . toChunks . cs
-- | Any type which can be converted to representations.
class HasReps a where
chooseRep :: a -> ChooseRep

View File

@ -21,8 +21,6 @@ import Web.Mime
import Yesod.Response
import Yesod.Yesod
import Yesod.Handler
import Control.Monad (foldM)
import Data.ByteString.Lazy (toChunks)
type Template = StringTemplate Text
type TemplateGroup = STGroup Text
@ -44,8 +42,8 @@ template tn ho f = do
Nothing -> failure $ NoSuchTemplate tn
Just x -> return x
return $ chooseRep
[ (TypeJson, cs $ unJsonDoc $ cs ho)
, (TypeHtml, tempToContent t ho f)
[ (TypeHtml, tempToContent t ho f)
, (TypeJson, cs $ unJsonDoc $ cs ho)
]
newtype NoSuchTemplate = NoSuchTemplate String
deriving (Show, Typeable)
@ -57,10 +55,6 @@ tempToContent :: Template
-> Content
tempToContent t ho f = ioTextToContent $ fmap render $ f ho t
ioTextToContent :: IO Text -> Content
ioTextToContent iotext =
Content $ \f a -> iotext >>= foldM f a . toChunks . cs
data TemplateFile = TemplateFile FilePath HtmlObject
instance HasReps TemplateFile where
chooseRep (TemplateFile fp (Mapping m)) _ = do

View File

@ -75,8 +75,8 @@ applyLayoutJson :: Yesod y
applyLayoutJson t b = do
y <- getYesod
return $ chooseRep
[ (TypeJson, cs $ unJsonDoc $ cs b)
, (TypeHtml, applyLayout y t $ cs b)
[ (TypeHtml, applyLayout y t $ cs b)
, (TypeJson, cs $ unJsonDoc $ cs b)
]
getApproot :: YesodApproot y => Handler y Approot