Removed Yesod.Rep
This commit is contained in:
parent
90e197ae46
commit
e7a2e1cfca
3
Yesod.hs
3
Yesod.hs
@ -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
|
||||||
|
|
||||||
|
|||||||
@ -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")
|
||||||
|
|||||||
175
Yesod/Rep.hs
175
Yesod/Rep.hs
@ -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:<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 "<fooval>")
|
|
||||||
, ("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
|
|
||||||
@ -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.
|
||||||
|
|||||||
@ -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)
|
||||||
|
]
|
||||||
|
|||||||
@ -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.
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user