Removed Yesod.Rep

This commit is contained in:
Michael Snoyman 2010-01-25 21:52:27 +02:00
parent 90e197ae46
commit e7a2e1cfca
9 changed files with 53 additions and 190 deletions

View File

@ -22,7 +22,6 @@ module Yesod
, module Yesod.Resource , module Yesod.Resource
, module Data.Object.Html , module Data.Object.Html
, module Yesod.Parameter , module Yesod.Parameter
, module Yesod.Rep
, module Yesod.Template , module Yesod.Template
, module Web.Mime , module Web.Mime
, Application , Application
@ -32,13 +31,11 @@ module Yesod
import Yesod.Resource hiding (testSuite) import Yesod.Resource hiding (testSuite)
import Yesod.Response hiding (testSuite) import Yesod.Response hiding (testSuite)
import Data.Object.Html hiding (testSuite) import Data.Object.Html hiding (testSuite)
import Yesod.Rep hiding (testSuite)
import Yesod.Request hiding (testSuite) import Yesod.Request hiding (testSuite)
#else #else
import Yesod.Resource import Yesod.Resource
import Yesod.Response import Yesod.Response
import Data.Object.Html import Data.Object.Html
import Yesod.Rep
import Yesod.Request import Yesod.Request
#endif #endif

View File

@ -78,9 +78,9 @@ sitemap urls = do
yesod <- getYesod yesod <- getYesod
return $ SitemapResponse urls $ approot yesod return $ SitemapResponse urls $ approot yesod
robots :: YesodApproot yesod => Handler yesod Plain robots :: YesodApproot yesod => Handler yesod [(ContentType, Content)]
robots = do robots = do
yesod <- getYesod yesod <- getYesod
return $ plain $ "Sitemap: " ++ showLocation return $ staticRep TypePlain $ "Sitemap: " ++ showLocation
(approot yesod) (approot yesod)
(RelLoc "sitemap.xml") (RelLoc "sitemap.xml")

View File

@ -1,175 +0,0 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
-- | Representations of data. A representation is basically how you display
-- information in a certain mime-type. For example, tree-style data can easily
-- be displayed as both JSON and Yaml.
--
-- To save programmers\' fingers, the name of this module and all data types
-- and classes replaces the full word Representation with Rep.
--
-- This concept is core to a RESTful framework. For example, if a user goes to
-- /movies/star-wars/, they'll want a HTML page describing the Star Wars movie.
-- However, if you've written an Ajax front-end, they might want than
-- information in XML or JSON format. There could also be another web service
-- that requests this information in a binary format to save on bandwidth.
--
-- Since the vast majority of information that is dealt with in web
-- applications can be easily displayed using an 'Object', that is probably
-- your best bet on internal data format to use. If you need HTML escaping,
-- then specifically an 'HtmlObject' will be even better.
--
-- By the way, I said above that the vast majority of information can be
-- contained in an 'Object' easily. The key word here is \"easily\"; in fact,
-- all data can be contained in an 'Object'; however, some of it requires more
-- effort.
module Yesod.Rep
( -- * Specific types of representations
Plain (..)
, plain
, Template (..)
, TemplateFile (..)
, Static (..)
#if TEST
, testSuite
#endif
) where
import Data.ByteString.Lazy (ByteString)
import Data.Text.Lazy (Text)
import Web.Mime
#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
import Text.StringTemplate
#if TEST
import Test.Framework (testGroup, Test)
import Test.Framework.Providers.HUnit
import Test.HUnit hiding (Test)
#endif
newtype Plain = Plain { unPlain :: Text }
deriving (Eq, Show)
instance HasReps Plain where
chooseRep = defChooseRep [(TypePlain, return . cs . unPlain)]
plain :: ConvertSuccess x Text => x -> Plain
plain = Plain . cs
data Template = Template (StringTemplate Text)
String
HtmlObject
(IO [(String, HtmlObject)])
instance HasReps Template where
chooseRep = defChooseRep [ (TypeHtml,
\(Template t name ho attrsIO) -> do
attrs <- attrsIO
return
$ cs
$ render
$ setAttribute name ho
$ setManyAttrib attrs t)
, (TypeJson, \(Template _ _ ho _) ->
return $ cs $ unJsonDoc $ cs ho)
]
-- FIXME
data TemplateFile = TemplateFile FilePath HtmlObject
instance HasReps TemplateFile where
chooseRep = defChooseRep [ (TypeHtml,
\(TemplateFile fp h) -> do
contents <- readFile fp
let t = newSTMP contents
return $ cs $ toString $ setAttribute "o" h t
)
, (TypeJson, \(TemplateFile _ ho) ->
return $ cs $ unJsonDoc $ cs ho)
]
data Static = Static ContentType ByteString
instance HasReps Static where
chooseRep (Static ct bs) _ = return (ct, Content $ const $ return bs)
#if TEST
caseChooseRepHO :: Assertion
caseChooseRepHO = do
{- FIXME
let content = "IGNOREME"
a = toHtmlObject content
htmlbs = cs . unHtmlDoc . cs $ toHtmlObject content
jsonbs = cs $ "\"" ++ content ++ "\""
chooseRep a [TypeHtml] >>= (@?= (TypeHtml, htmlbs))
chooseRep a [TypeJson] >>= (@?= (TypeJson, jsonbs))
chooseRep a [TypeHtml, TypeJson] >>= (@?= (TypeHtml, htmlbs))
chooseRep a [TypeOther "foo", TypeJson] >>= (@?= (TypeJson, jsonbs))
-}
return ()
caseChooseRepRaw :: Assertion
caseChooseRepRaw = do
{- FIXME
let content = Content $ cs "FOO"
foo = TypeOther "foo"
bar = TypeOther "bar"
hasreps = [(TypeHtml, content), (foo, content)]
chooseRep hasreps [TypeHtml] >>= (@?= (TypeHtml, content))
chooseRep hasreps [foo, bar] >>= (@?= (foo, content))
chooseRep hasreps [bar, foo] >>= (@?= (foo, content))
chooseRep hasreps [bar] >>= (@?= (TypeHtml, content))
-}
return ()
caseChooseRepTemplate :: Assertion
caseChooseRepTemplate = do
{- FIXME
let temp = newSTMP "foo:$o.foo$, bar:$o.bar$"
ho = toHtmlObject [ ("foo", toHtmlObject "<fooval>")
, ("bar", Sequence $ map cs ["bar1", "bar2"])
]
hasreps = Template temp "o" ho $ return []
res1 = cs "foo:&lt;fooval&gt;, bar:bar1bar2"
res2 = cs $ "{\"bar\":[\"bar1\",\"bar2\"]," ++
"\"foo\":\"&lt;fooval&gt;\"}"
chooseRep hasreps [TypeHtml] >>= (@?= (TypeHtml, res1))
chooseRep hasreps [TypeJson] >>= (@?= (TypeJson, res2))
chooseRep hasreps [TypeHtml, TypeJson] >>= (@?= (TypeHtml, res1))
chooseRep hasreps [TypeJson, TypeHtml] >>= (@?= (TypeJson, res2))
-}
return ()
caseChooseRepTemplateFile :: Assertion
caseChooseRepTemplateFile = do
{- FIXME
let temp = "Test/rep.st"
ho = toHtmlObject [ ("foo", toHtmlObject "<fooval>")
, ("bar", Sequence $ map cs ["bar1", "bar2"])
]
hasreps = TemplateFile temp ho
res1 = cs "foo:&lt;fooval&gt;, bar:bar1bar2"
res2 = cs $ "{\"bar\":[\"bar1\",\"bar2\"]," ++
"\"foo\":\"&lt;fooval&gt;\"}"
chooseRep hasreps [TypeHtml] >>= (@?= (TypeHtml, res1))
chooseRep hasreps [TypeJson] >>= (@?= (TypeJson, res2))
chooseRep hasreps [TypeHtml, TypeJson] >>= (@?= (TypeHtml, res1))
chooseRep hasreps [TypeJson, TypeHtml] >>= (@?= (TypeJson, res2))
-}
return ()
testSuite :: Test
testSuite = testGroup "Yesod.Rep"
[ testCase "caseChooseRep HtmlObject" caseChooseRepHO
, testCase "caseChooseRep raw" caseChooseRepRaw
, testCase "caseChooseRep Template" caseChooseRepTemplate
, testCase "caseChooseRep TemplateFile" caseChooseRepTemplateFile
]
#endif

View File

@ -23,6 +23,9 @@ module Yesod.Response
, ChooseRep , ChooseRep
, HasReps (..) , HasReps (..)
, defChooseRep , defChooseRep
-- ** Convenience wrappers
, staticRep
-- * Response type
, Response (..) , Response (..)
-- * Special responses -- * Special responses
, RedirectType (..) , RedirectType (..)
@ -120,6 +123,13 @@ instance HasReps HtmlObject where
, (TypeJson, return . cs . unJsonDoc . cs) , (TypeJson, return . cs . unJsonDoc . cs)
] ]
-- | Data with a single representation.
staticRep :: ConvertSuccess x ByteString
=> ContentType
-> x
-> [(ContentType, Content)]
staticRep ct x = [(ct, cs (cs x :: ByteString))]
data Response = Response Int [Header] ContentType Content data Response = Response Int [Header] ContentType Content
-- | Different types of redirects. -- | Different types of redirects.

View File

@ -5,15 +5,19 @@ module Yesod.Template
, template , template
, NoSuchTemplate , NoSuchTemplate
, TemplateGroup , TemplateGroup
, Template (..)
, TemplateFile (..)
) where ) where
import Data.Object.Html import Data.Object.Html
import Data.Typeable (Typeable) import Data.Typeable (Typeable)
import Control.Exception (Exception) import Control.Exception (Exception)
import Control.Failure import Control.Failure
import Yesod.Rep
import Data.Object.Text (Text) import Data.Object.Text (Text)
import Text.StringTemplate import Text.StringTemplate
import Data.Object.Json
import Web.Mime
import Yesod.Response
type TemplateGroup = STGroup Text type TemplateGroup = STGroup Text
@ -36,3 +40,33 @@ template tn on o attrs = do
newtype NoSuchTemplate = NoSuchTemplate String newtype NoSuchTemplate = NoSuchTemplate String
deriving (Show, Typeable) deriving (Show, Typeable)
instance Exception NoSuchTemplate instance Exception NoSuchTemplate
data Template = Template (StringTemplate Text)
String
HtmlObject
(IO [(String, HtmlObject)])
instance HasReps Template where
chooseRep = defChooseRep [ (TypeHtml,
\(Template t name ho attrsIO) -> do
attrs <- attrsIO
return
$ cs
$ render
$ setAttribute name ho
$ setManyAttrib attrs t)
, (TypeJson, \(Template _ _ ho _) ->
return $ cs $ unJsonDoc $ cs ho)
]
-- FIXME
data TemplateFile = TemplateFile FilePath HtmlObject
instance HasReps TemplateFile where
chooseRep = defChooseRep [ (TypeHtml,
\(TemplateFile fp h) -> do
contents <- readFile fp
let t = newSTMP contents
return $ cs $ toString $ setAttribute "o" h t
)
, (TypeJson, \(TemplateFile _ ho) ->
return $ cs $ unJsonDoc $ cs ho)
]

View File

@ -66,7 +66,7 @@ request method.)
This does what it looks like: serves a static HTML file. This does what it looks like: serves a static HTML file.
> index = return $ StaticFile TypeHtml "examples/fact.html" > index = sendFile TypeHtml "examples/fact.html" >> return ()
HtmlObject is a funny beast. Basically, it allows multiple representations of HtmlObject is a funny beast. Basically, it allows multiple representations of
data, all with HTML entities escaped properly. These representations include: data, all with HTML entities escaped properly. These representations include:
@ -90,7 +90,7 @@ one piece of data.
> factRedirect :: Handler y () > factRedirect :: Handler y ()
> factRedirect = do > factRedirect = do
> i <- runRequest $ getParam "num" > i <- runRequest $ getParam "num"
> redirect $ "../" ++ i ++ "/" > redirect RedirectPermanent $ "../" ++ i ++ "/"
The following line would be unnecesary if we had a type signature on The following line would be unnecesary if we had a type signature on
factRedirect. factRedirect.

View File

@ -1,6 +1,5 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
import Yesod import Yesod
import Yesod.Constants
import Hack.Handler.SimpleServer import Hack.Handler.SimpleServer
data I18N = I18N data I18N = I18N
@ -17,13 +16,14 @@ homepage = return Hello
setLang lang = do setLang lang = do
addCookie 1 langKey lang addCookie 1 langKey lang
redirect "/" redirect RedirectTemporary "/"
return () return ()
data Hello = Hello data Hello = Hello
instance HasReps Hello where instance HasReps Hello where
reps = [(TypeHtml, const $ return $ Content $ return . cs . content)] chooseRep = defChooseRep
[(TypeHtml, const $ return $ Content $ return . cs . content)]
where where
content [] = "Hello" content [] = "Hello"
content ("he":_) = "שלום" content ("he":_) = "שלום"
@ -31,4 +31,4 @@ instance HasReps Hello where
content (_:rest) = content rest content (_:rest) = content rest
main = putStrLn "Running..." >> run 3000 (toHackApp I18N) main = putStrLn "Running..." >> toHackApp I18N >>= run 3000

View File

@ -2,7 +2,6 @@ import Test.Framework (defaultMain)
import qualified Yesod.Response import qualified Yesod.Response
import qualified Yesod.Resource import qualified Yesod.Resource
import qualified Yesod.Rep
import qualified Yesod.Request import qualified Yesod.Request
import qualified Data.Object.Html import qualified Data.Object.Html
import qualified Test.Errors import qualified Test.Errors
@ -12,7 +11,6 @@ main :: IO ()
main = defaultMain main = defaultMain
[ Yesod.Response.testSuite [ Yesod.Response.testSuite
, Yesod.Resource.testSuite , Yesod.Resource.testSuite
, Yesod.Rep.testSuite
, Yesod.Request.testSuite , Yesod.Request.testSuite
, Data.Object.Html.testSuite , Data.Object.Html.testSuite
, Test.Errors.testSuite , Test.Errors.testSuite

View File

@ -55,7 +55,6 @@ library
failure >= 0.0.0 && < 0.1, failure >= 0.0.0 && < 0.1,
safe-failure >= 0.4.0 && < 0.5 safe-failure >= 0.4.0 && < 0.5
exposed-modules: Yesod exposed-modules: Yesod
Yesod.Rep
Yesod.Request Yesod.Request
Yesod.Response Yesod.Response
Yesod.Definitions Yesod.Definitions