diff --git a/Yesod.hs b/Yesod.hs index 574bf690..aa2fc607 100644 --- a/Yesod.hs +++ b/Yesod.hs @@ -22,7 +22,6 @@ module Yesod , module Yesod.Resource , module Data.Object.Html , module Yesod.Parameter - , module Yesod.Rep , module Yesod.Template , module Web.Mime , Application @@ -32,13 +31,11 @@ module Yesod import Yesod.Resource hiding (testSuite) import Yesod.Response hiding (testSuite) import Data.Object.Html hiding (testSuite) -import Yesod.Rep hiding (testSuite) import Yesod.Request hiding (testSuite) #else import Yesod.Resource import Yesod.Response import Data.Object.Html -import Yesod.Rep import Yesod.Request #endif diff --git a/Yesod/Helpers/Sitemap.hs b/Yesod/Helpers/Sitemap.hs index ca7687b4..a22f26f4 100644 --- a/Yesod/Helpers/Sitemap.hs +++ b/Yesod/Helpers/Sitemap.hs @@ -78,9 +78,9 @@ sitemap urls = do yesod <- getYesod return $ SitemapResponse urls $ approot yesod -robots :: YesodApproot yesod => Handler yesod Plain +robots :: YesodApproot yesod => Handler yesod [(ContentType, Content)] robots = do yesod <- getYesod - return $ plain $ "Sitemap: " ++ showLocation + return $ staticRep TypePlain $ "Sitemap: " ++ showLocation (approot yesod) (RelLoc "sitemap.xml") diff --git a/Yesod/Rep.hs b/Yesod/Rep.hs deleted file mode 100644 index a8facc6a..00000000 --- a/Yesod/Rep.hs +++ /dev/null @@ -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 "") - , ("bar", Sequence $ map cs ["bar1", "bar2"]) - ] - hasreps = Template temp "o" ho $ return [] - res1 = cs "foo:<fooval>, bar:bar1bar2" - res2 = cs $ "{\"bar\":[\"bar1\",\"bar2\"]," ++ - "\"foo\":\"<fooval>\"}" - 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 "") - , ("bar", Sequence $ map cs ["bar1", "bar2"]) - ] - hasreps = TemplateFile temp ho - res1 = cs "foo:<fooval>, bar:bar1bar2" - res2 = cs $ "{\"bar\":[\"bar1\",\"bar2\"]," ++ - "\"foo\":\"<fooval>\"}" - 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 diff --git a/Yesod/Response.hs b/Yesod/Response.hs index 621ebbfb..3fb0ba17 100644 --- a/Yesod/Response.hs +++ b/Yesod/Response.hs @@ -23,6 +23,9 @@ module Yesod.Response , ChooseRep , HasReps (..) , defChooseRep + -- ** Convenience wrappers + , staticRep + -- * Response type , Response (..) -- * Special responses , RedirectType (..) @@ -120,6 +123,13 @@ instance HasReps HtmlObject where , (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 -- | Different types of redirects. diff --git a/Yesod/Template.hs b/Yesod/Template.hs index 84431566..b145d95d 100644 --- a/Yesod/Template.hs +++ b/Yesod/Template.hs @@ -5,15 +5,19 @@ module Yesod.Template , template , NoSuchTemplate , TemplateGroup + , Template (..) + , TemplateFile (..) ) where import Data.Object.Html import Data.Typeable (Typeable) import Control.Exception (Exception) import Control.Failure -import Yesod.Rep import Data.Object.Text (Text) import Text.StringTemplate +import Data.Object.Json +import Web.Mime +import Yesod.Response type TemplateGroup = STGroup Text @@ -36,3 +40,33 @@ template tn on o attrs = do newtype NoSuchTemplate = NoSuchTemplate String deriving (Show, Typeable) 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) + ] diff --git a/examples/fact.lhs b/examples/fact.lhs index 9b1e7e31..87460d3a 100644 --- a/examples/fact.lhs +++ b/examples/fact.lhs @@ -66,7 +66,7 @@ request method.) 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 data, all with HTML entities escaped properly. These representations include: @@ -90,7 +90,7 @@ one piece of data. > factRedirect :: Handler y () > factRedirect = do > i <- runRequest $ getParam "num" -> redirect $ "../" ++ i ++ "/" +> redirect RedirectPermanent $ "../" ++ i ++ "/" The following line would be unnecesary if we had a type signature on factRedirect. diff --git a/examples/i18n.hs b/examples/i18n.hs index 1e5bc419..6e7cc36f 100644 --- a/examples/i18n.hs +++ b/examples/i18n.hs @@ -1,6 +1,5 @@ {-# LANGUAGE QuasiQuotes #-} import Yesod -import Yesod.Constants import Hack.Handler.SimpleServer data I18N = I18N @@ -17,13 +16,14 @@ homepage = return Hello setLang lang = do addCookie 1 langKey lang - redirect "/" + redirect RedirectTemporary "/" return () data Hello = Hello instance HasReps Hello where - reps = [(TypeHtml, const $ return $ Content $ return . cs . content)] + chooseRep = defChooseRep + [(TypeHtml, const $ return $ Content $ return . cs . content)] where content [] = "Hello" content ("he":_) = "שלום" @@ -31,4 +31,4 @@ instance HasReps Hello where content (_:rest) = content rest -main = putStrLn "Running..." >> run 3000 (toHackApp I18N) +main = putStrLn "Running..." >> toHackApp I18N >>= run 3000 diff --git a/runtests.hs b/runtests.hs index a5e8e423..5abb4cbe 100644 --- a/runtests.hs +++ b/runtests.hs @@ -2,7 +2,6 @@ import Test.Framework (defaultMain) import qualified Yesod.Response import qualified Yesod.Resource -import qualified Yesod.Rep import qualified Yesod.Request import qualified Data.Object.Html import qualified Test.Errors @@ -12,7 +11,6 @@ main :: IO () main = defaultMain [ Yesod.Response.testSuite , Yesod.Resource.testSuite - , Yesod.Rep.testSuite , Yesod.Request.testSuite , Data.Object.Html.testSuite , Test.Errors.testSuite diff --git a/yesod.cabal b/yesod.cabal index ee6c943f..dc2fb2ba 100644 --- a/yesod.cabal +++ b/yesod.cabal @@ -55,7 +55,6 @@ library failure >= 0.0.0 && < 0.1, safe-failure >= 0.4.0 && < 0.5 exposed-modules: Yesod - Yesod.Rep Yesod.Request Yesod.Response Yesod.Definitions