Moved the meat of Yesod.Rep to Yesod.Response
This commit is contained in:
parent
3137ee9bee
commit
ec5b9863d5
64
Yesod/Rep.hs
64
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user