From 43c847ff933125a37d4ff0152bea5b0e6159c00c Mon Sep 17 00:00:00 2001 From: Michael Snoyman Date: Wed, 27 Jan 2010 10:05:29 +0200 Subject: [PATCH] handlers -> resources, resources -> mkResources, fix examples --- Test/Errors.hs | 2 +- Test/QuasiResource.hs | 2 +- Yesod/Resource.hs | 12 ++++++------ Yesod/Template.hs | 14 ++++++++++++++ Yesod/Yesod.hs | 4 ++-- compile-examples.sh | 6 ++++++ examples/fact.lhs | 11 +++++++---- examples/hellotemplate.lhs | 14 ++++++++------ examples/helloworld.lhs | 6 +++--- examples/i18n.hs | 2 +- 10 files changed, 49 insertions(+), 24 deletions(-) create mode 100755 compile-examples.sh diff --git a/Test/Errors.hs b/Test/Errors.hs index ba258cb2..7f153d17 100644 --- a/Test/Errors.hs +++ b/Test/Errors.hs @@ -12,7 +12,7 @@ import Test.HUnit hiding (Test) data Errors = Errors instance Yesod Errors where - handlers = [$resources| + resources = [$mkResources| /denied: Get: denied /needs-ident: diff --git a/Test/QuasiResource.hs b/Test/QuasiResource.hs index 8e7908b1..97dbc3fd 100644 --- a/Test/QuasiResource.hs +++ b/Test/QuasiResource.hs @@ -43,7 +43,7 @@ instance Show (Verb -> Handler MyYesod ChooseRep) where instance Show (Resource -> Verb -> Handler MyYesod ChooseRep) where show _ = "resource -> verb -> handler" handler :: Resource -> Verb -> Handler MyYesod ChooseRep -handler = [$resources| +handler = [$mkResources| /static/*filepath/: getStatic /page/: Get: pageIndex diff --git a/Yesod/Resource.hs b/Yesod/Resource.hs index 9af5834d..7d79e192 100644 --- a/Yesod/Resource.hs +++ b/Yesod/Resource.hs @@ -23,8 +23,8 @@ -- --------------------------------------------------------- module Yesod.Resource - ( resources - , resourcesNoCheck + ( mkResources + , mkResourcesNoCheck #if TEST -- * Testing , testSuite @@ -64,11 +64,11 @@ import Test.QuickCheck import Control.Monad (when) #endif -resources :: QuasiQuoter -resources = QuasiQuoter (strToExp True) undefined +mkResources :: QuasiQuoter +mkResources = QuasiQuoter (strToExp True) undefined -resourcesNoCheck :: QuasiQuoter -resourcesNoCheck = QuasiQuoter (strToExp False) undefined +mkResourcesNoCheck :: QuasiQuoter +mkResourcesNoCheck = QuasiQuoter (strToExp False) undefined -- | Resource Pattern Piece data RPP = diff --git a/Yesod/Template.hs b/Yesod/Template.hs index d4352fc3..41b0aaa0 100644 --- a/Yesod/Template.hs +++ b/Yesod/Template.hs @@ -6,6 +6,9 @@ module Yesod.Template , NoSuchTemplate , Template , TemplateGroup + , TemplateFile (..) + , setAttribute + , loadTemplateGroup ) where import Data.Object.Html @@ -57,3 +60,14 @@ tempToContent t ho f = ioTextToContent $ fmap render $ f ho t ioTextToContent :: IO Text -> Content ioTextToContent iotext = Content $ \f a -> iotext >>= foldM f a . toChunks . cs + +data TemplateFile = TemplateFile FilePath HtmlObject +instance HasReps TemplateFile where + chooseRep (TemplateFile fp (Mapping m)) _ = do + t <- fmap newSTMP $ readFile fp + let t' = setManyAttrib m t :: Template + return (TypeHtml, cs $ render t') + chooseRep _ _ = error "Please fix type of TemplateFile" + +loadTemplateGroup :: FilePath -> IO TemplateGroup +loadTemplateGroup = directoryGroupRecursiveLazy diff --git a/Yesod/Yesod.hs b/Yesod/Yesod.hs index 657751fe..33cd2aa0 100644 --- a/Yesod/Yesod.hs +++ b/Yesod/Yesod.hs @@ -29,7 +29,7 @@ import Hack.Middleware.MethodOverride class Yesod a where -- | Please use the Quasi-Quoter, you\'ll be happier. For more information, -- see the examples/fact.lhs sample. - handlers :: Resource -> Verb -> Handler a ChooseRep + resources :: Resource -> Verb -> Handler a ChooseRep -- | The encryption key to be used for encrypting client sessions. encryptKey :: a -> IO Word256 @@ -117,7 +117,7 @@ toHackApp' y env = do let (Right resource) = splitPath $ Hack.pathInfo env types = httpAccept env verb = cs $ Hack.requestMethod env - handler = handlers resource verb + handler = resources resource verb rr = cs env res <- runHandler handler errorHandler rr y types responseToHackResponse res diff --git a/compile-examples.sh b/compile-examples.sh new file mode 100755 index 00000000..f037f0c4 --- /dev/null +++ b/compile-examples.sh @@ -0,0 +1,6 @@ +#!/bin/sh + +for f in examples/*.*hs +do + ghc --make -Wall -Werror $f || exit +done diff --git a/examples/fact.lhs b/examples/fact.lhs index 87460d3a..7debce47 100644 --- a/examples/fact.lhs +++ b/examples/fact.lhs @@ -54,7 +54,7 @@ specify a single function which handles all verbs. (Note: a verb is just a request method.) \begin{code} - handlers = [$resources| + resources = [$mkResources| /: Get: index /#num: @@ -78,7 +78,7 @@ data, all with HTML entities escaped properly. These representations include: For simplicity here, we don't include a template, though it would be trivial to do so (see the hellotemplate example). -> fact i = return $ toHtmlObject +> fact i = applyLayoutJson "Factorial result" $ cs > [ ("input", show i) > , ("result", show $ product [1..fromIntegral i :: Integer]) > ] @@ -89,8 +89,11 @@ one piece of data. > factRedirect :: Handler y () > factRedirect = do -> i <- runRequest $ getParam "num" -> redirect RedirectPermanent $ "../" ++ i ++ "/" +> rr <- getRawRequest +> let i = case getParams rr "num" of -- FIXME +> [] -> "1" +> (x:_) -> x +> _ <- redirect RedirectPermanent $ "../" ++ i ++ "/" The following line would be unnecesary if we had a type signature on factRedirect. diff --git a/examples/hellotemplate.lhs b/examples/hellotemplate.lhs index b5ee0924..f03bcf4a 100644 --- a/examples/hellotemplate.lhs +++ b/examples/hellotemplate.lhs @@ -4,15 +4,16 @@ import Yesod import Hack.Handler.SimpleServer -data HelloWorld = HelloWorld +data HelloWorld = HelloWorld TemplateGroup +instance YesodTemplate HelloWorld where + getTemplateGroup (HelloWorld tg) = tg instance Yesod HelloWorld where - handlers = [$resources| + resources = [$mkResources| /: Get: helloWorld /groups: Get: helloGroup |] - templateDir _ = "examples" helloWorld :: Handler HelloWorld TemplateFile helloWorld = return $ TemplateFile "examples/template.html" $ cs @@ -20,11 +21,12 @@ helloWorld = return $ TemplateFile "examples/template.html" $ cs , ("content", "Hey look!! I'm !") ] -helloGroup :: Handler y Template -helloGroup = template "real-template" "foo" (cs "bar") $ return [] +helloGroup :: YesodTemplate y => Handler y ChooseRep +helloGroup = template "real-template" (cs "bar") $ \ho -> + return . setAttribute "foo" ho main :: IO () main = do putStrLn "Running..." - toHackApp HelloWorld >>= run 3000 + loadTemplateGroup "examples" >>= toHackApp . HelloWorld >>= run 3000 \end{code} diff --git a/examples/helloworld.lhs b/examples/helloworld.lhs index 371e8a04..1fbd6f73 100644 --- a/examples/helloworld.lhs +++ b/examples/helloworld.lhs @@ -6,13 +6,13 @@ import Hack.Handler.SimpleServer data HelloWorld = HelloWorld instance Yesod HelloWorld where - handlers = [$resources| + resources = [$mkResources| /: Get: helloWorld |] -helloWorld :: Handler HelloWorld HtmlObject -helloWorld = return $ cs "Hello world!" +helloWorld :: Handler HelloWorld ChooseRep +helloWorld = applyLayout' "Hello World" $ cs "Hello world!" main :: IO () main = putStrLn "Running..." >> toHackApp HelloWorld >>= run 3000 diff --git a/examples/i18n.hs b/examples/i18n.hs index e393ba2a..b98cd724 100644 --- a/examples/i18n.hs +++ b/examples/i18n.hs @@ -5,7 +5,7 @@ import Hack.Handler.SimpleServer data I18N = I18N instance Yesod I18N where - handlers = [$resources| + resources = [$mkResources| /: Get: homepage /set/$lang: