diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs index 6e4ff037..10c44861 100644 --- a/Yesod/Rep.hs +++ b/Yesod/Rep.hs @@ -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 diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs index 0b1917a4..8fa4b9e2 100644 --- a/Yesod/Resource.hs +++ b/Yesod/Resource.hs @@ -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 diff --git a/Yesod/Response.hs b/Yesod/Response.hs index 67de0456..cc37d40b 100644 --- a/Yesod/Response.hs +++ b/Yesod/Response.hs @@ -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.