Moved the meat of Yesod.Rep to Yesod.Response

This commit is contained in:
Michael Snoyman 2010-01-25 02:06:02 +02:00
parent 3137ee9bee
commit ec5b9863d5
3 changed files with 72 additions and 67 deletions

View File

@ -26,12 +26,8 @@
-- all data can be contained in an 'Object'; however, some of it requires more
-- effort.
module Yesod.Rep
( Content (..)
, ChooseRep
, HasReps (..)
, defChooseRep
-- * Specific types of representations
, Plain (..)
( -- * Specific types of representations
Plain (..)
, plain
, Template (..)
, TemplateFile (..)
@ -43,16 +39,16 @@ module Yesod.Rep
) where
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Text.Lazy (Text)
import Data.Maybe (mapMaybe)
import qualified Data.ByteString.Lazy as BL
import Web.Mime
import Yesod.Definitions
#if TEST
import Data.Object.Html hiding (testSuite)
import Yesod.Response hiding (testSuite)
#else
import Data.Object.Html
import Yesod.Response
#endif
import Data.Object.Json
@ -64,56 +60,6 @@ import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
#endif
newtype Content = Content { unContent :: [Language] -> IO ByteString }
instance ConvertSuccess Text Content where
convertSuccess = Content . const . return . cs
instance ConvertSuccess ByteString Content where
convertSuccess = Content . const . return
instance ConvertSuccess String Content where
convertSuccess = Content . const . return . cs
instance ConvertSuccess HtmlDoc Content where
convertSuccess = cs . unHtmlDoc
instance ConvertSuccess XmlDoc Content where
convertSuccess = cs . unXmlDoc
type ChooseRep = [ContentType] -> IO (ContentType, Content)
-- | Any type which can be converted to representations. There must be at least
-- one representation for each type.
class HasReps a where
chooseRep :: a -> ChooseRep
-- | A helper method for generating 'HasReps' instances.
defChooseRep :: [(ContentType, a -> IO Content)] -> a -> ChooseRep
defChooseRep reps a ts = do
let (ct, c) =
case mapMaybe helper ts of
(x:_) -> x
[] -> case reps of
[] -> error "Empty reps"
(x:_) -> x
c' <- c a
return (ct, c')
where
helper ct = do
c <- lookup ct reps
return (ct, c)
instance HasReps ChooseRep where
chooseRep = id
instance HasReps () where
chooseRep = defChooseRep [(TypePlain, const $ return $ cs "")]
instance HasReps [(ContentType, Content)] where
chooseRep a cts = return $
case filter (\(ct, _) -> ct `elem` cts) a of
((ct, c):_) -> (ct, c)
_ -> case a of
(x:_) -> x
_ -> error "chooseRep [(ContentType, Content)] of empty"
newtype Plain = Plain { unPlain :: Text }
deriving (Eq, Show)
instance HasReps Plain where

View File

@ -51,7 +51,7 @@ import Control.Monad ((<=<), unless)
import Data.Object.Yaml
import Yesod.Handler
import Data.Maybe (fromJust)
import Yesod.Rep (chooseRep)
import Yesod.Response (chooseRep)
import Control.Arrow
#if TEST

View File

@ -18,7 +18,12 @@
--
---------------------------------------------------------
module Yesod.Response
( Response (..)
( -- * Representations
Content (..)
, ChooseRep
, HasReps (..)
, defChooseRep
, Response (..)
-- * Special responses
, RedirectType (..)
, getRedirectStatus
@ -37,17 +42,21 @@ module Yesod.Response
#endif
) where
#if TEST
import Yesod.Rep hiding (testSuite)
#else
import Yesod.Rep
#endif
import Data.Time.Clock
import Data.Maybe (mapMaybe)
import Data.ByteString.Lazy (ByteString)
import Data.Text.Lazy (Text)
import Yesod.Definitions
import Web.Encodings (formatW3)
import qualified Hack
#if TEST
import Data.Object.Html hiding (testSuite)
#else
import Data.Object.Html
#endif
#if TEST
import Test.Framework (testGroup, Test)
#endif
@ -55,6 +64,56 @@ import Test.Framework (testGroup, Test)
import Data.Convertible.Text (cs)
import Web.Mime
newtype Content = Content { unContent :: [Language] -> IO ByteString }
instance ConvertSuccess Text Content where
convertSuccess = Content . const . return . cs
instance ConvertSuccess ByteString Content where
convertSuccess = Content . const . return
instance ConvertSuccess String Content where
convertSuccess = Content . const . return . cs
instance ConvertSuccess HtmlDoc Content where
convertSuccess = cs . unHtmlDoc
instance ConvertSuccess XmlDoc Content where
convertSuccess = cs . unXmlDoc
type ChooseRep = [ContentType] -> IO (ContentType, Content)
-- | Any type which can be converted to representations. There must be at least
-- one representation for each type.
class HasReps a where
chooseRep :: a -> ChooseRep
-- | A helper method for generating 'HasReps' instances.
defChooseRep :: [(ContentType, a -> IO Content)] -> a -> ChooseRep
defChooseRep reps a ts = do
let (ct, c) =
case mapMaybe helper ts of
(x:_) -> x
[] -> case reps of
[] -> error "Empty reps"
(x:_) -> x
c' <- c a
return (ct, c')
where
helper ct = do
c <- lookup ct reps
return (ct, c)
instance HasReps ChooseRep where
chooseRep = id
instance HasReps () where
chooseRep = defChooseRep [(TypePlain, const $ return $ cs "")]
instance HasReps [(ContentType, Content)] where
chooseRep a cts = return $
case filter (\(ct, _) -> ct `elem` cts) a of
((ct, c):_) -> (ct, c)
_ -> case a of
(x:_) -> x
_ -> error "chooseRep [(ContentType, Content)] of empty"
data Response = Response Int [Header] ContentType Content
-- | Different types of redirects.