handlers -> resources, resources -> mkResources, fix examples
This commit is contained in:
parent
d1618eb3d0
commit
43c847ff93
@ -12,7 +12,7 @@ import Test.HUnit hiding (Test)
|
|||||||
|
|
||||||
data Errors = Errors
|
data Errors = Errors
|
||||||
instance Yesod Errors where
|
instance Yesod Errors where
|
||||||
handlers = [$resources|
|
resources = [$mkResources|
|
||||||
/denied:
|
/denied:
|
||||||
Get: denied
|
Get: denied
|
||||||
/needs-ident:
|
/needs-ident:
|
||||||
|
|||||||
@ -43,7 +43,7 @@ instance Show (Verb -> Handler MyYesod ChooseRep) where
|
|||||||
instance Show (Resource -> Verb -> Handler MyYesod ChooseRep) where
|
instance Show (Resource -> Verb -> Handler MyYesod ChooseRep) where
|
||||||
show _ = "resource -> verb -> handler"
|
show _ = "resource -> verb -> handler"
|
||||||
handler :: Resource -> Verb -> Handler MyYesod ChooseRep
|
handler :: Resource -> Verb -> Handler MyYesod ChooseRep
|
||||||
handler = [$resources|
|
handler = [$mkResources|
|
||||||
/static/*filepath/: getStatic
|
/static/*filepath/: getStatic
|
||||||
/page/:
|
/page/:
|
||||||
Get: pageIndex
|
Get: pageIndex
|
||||||
|
|||||||
@ -23,8 +23,8 @@
|
|||||||
--
|
--
|
||||||
---------------------------------------------------------
|
---------------------------------------------------------
|
||||||
module Yesod.Resource
|
module Yesod.Resource
|
||||||
( resources
|
( mkResources
|
||||||
, resourcesNoCheck
|
, mkResourcesNoCheck
|
||||||
#if TEST
|
#if TEST
|
||||||
-- * Testing
|
-- * Testing
|
||||||
, testSuite
|
, testSuite
|
||||||
@ -64,11 +64,11 @@ import Test.QuickCheck
|
|||||||
import Control.Monad (when)
|
import Control.Monad (when)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
resources :: QuasiQuoter
|
mkResources :: QuasiQuoter
|
||||||
resources = QuasiQuoter (strToExp True) undefined
|
mkResources = QuasiQuoter (strToExp True) undefined
|
||||||
|
|
||||||
resourcesNoCheck :: QuasiQuoter
|
mkResourcesNoCheck :: QuasiQuoter
|
||||||
resourcesNoCheck = QuasiQuoter (strToExp False) undefined
|
mkResourcesNoCheck = QuasiQuoter (strToExp False) undefined
|
||||||
|
|
||||||
-- | Resource Pattern Piece
|
-- | Resource Pattern Piece
|
||||||
data RPP =
|
data RPP =
|
||||||
|
|||||||
@ -6,6 +6,9 @@ module Yesod.Template
|
|||||||
, NoSuchTemplate
|
, NoSuchTemplate
|
||||||
, Template
|
, Template
|
||||||
, TemplateGroup
|
, TemplateGroup
|
||||||
|
, TemplateFile (..)
|
||||||
|
, setAttribute
|
||||||
|
, loadTemplateGroup
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Object.Html
|
import Data.Object.Html
|
||||||
@ -57,3 +60,14 @@ tempToContent t ho f = ioTextToContent $ fmap render $ f ho t
|
|||||||
ioTextToContent :: IO Text -> Content
|
ioTextToContent :: IO Text -> Content
|
||||||
ioTextToContent iotext =
|
ioTextToContent iotext =
|
||||||
Content $ \f a -> iotext >>= foldM f a . toChunks . cs
|
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
|
||||||
|
|||||||
@ -29,7 +29,7 @@ import Hack.Middleware.MethodOverride
|
|||||||
class Yesod a where
|
class Yesod a where
|
||||||
-- | Please use the Quasi-Quoter, you\'ll be happier. For more information,
|
-- | Please use the Quasi-Quoter, you\'ll be happier. For more information,
|
||||||
-- see the examples/fact.lhs sample.
|
-- 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.
|
-- | The encryption key to be used for encrypting client sessions.
|
||||||
encryptKey :: a -> IO Word256
|
encryptKey :: a -> IO Word256
|
||||||
@ -117,7 +117,7 @@ toHackApp' y env = do
|
|||||||
let (Right resource) = splitPath $ Hack.pathInfo env
|
let (Right resource) = splitPath $ Hack.pathInfo env
|
||||||
types = httpAccept env
|
types = httpAccept env
|
||||||
verb = cs $ Hack.requestMethod env
|
verb = cs $ Hack.requestMethod env
|
||||||
handler = handlers resource verb
|
handler = resources resource verb
|
||||||
rr = cs env
|
rr = cs env
|
||||||
res <- runHandler handler errorHandler rr y types
|
res <- runHandler handler errorHandler rr y types
|
||||||
responseToHackResponse res
|
responseToHackResponse res
|
||||||
|
|||||||
6
compile-examples.sh
Executable file
6
compile-examples.sh
Executable file
@ -0,0 +1,6 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
|
||||||
|
for f in examples/*.*hs
|
||||||
|
do
|
||||||
|
ghc --make -Wall -Werror $f || exit
|
||||||
|
done
|
||||||
@ -54,7 +54,7 @@ specify a single function which handles all verbs. (Note: a verb is just a
|
|||||||
request method.)
|
request method.)
|
||||||
|
|
||||||
\begin{code}
|
\begin{code}
|
||||||
handlers = [$resources|
|
resources = [$mkResources|
|
||||||
/:
|
/:
|
||||||
Get: index
|
Get: index
|
||||||
/#num:
|
/#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
|
For simplicity here, we don't include a template, though it would be trivial to
|
||||||
do so (see the hellotemplate example).
|
do so (see the hellotemplate example).
|
||||||
|
|
||||||
> fact i = return $ toHtmlObject
|
> fact i = applyLayoutJson "Factorial result" $ cs
|
||||||
> [ ("input", show i)
|
> [ ("input", show i)
|
||||||
> , ("result", show $ product [1..fromIntegral i :: Integer])
|
> , ("result", show $ product [1..fromIntegral i :: Integer])
|
||||||
> ]
|
> ]
|
||||||
@ -89,8 +89,11 @@ one piece of data.
|
|||||||
|
|
||||||
> factRedirect :: Handler y ()
|
> factRedirect :: Handler y ()
|
||||||
> factRedirect = do
|
> factRedirect = do
|
||||||
> i <- runRequest $ getParam "num"
|
> rr <- getRawRequest
|
||||||
> redirect RedirectPermanent $ "../" ++ i ++ "/"
|
> 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
|
The following line would be unnecesary if we had a type signature on
|
||||||
factRedirect.
|
factRedirect.
|
||||||
|
|||||||
@ -4,15 +4,16 @@
|
|||||||
import Yesod
|
import Yesod
|
||||||
import Hack.Handler.SimpleServer
|
import Hack.Handler.SimpleServer
|
||||||
|
|
||||||
data HelloWorld = HelloWorld
|
data HelloWorld = HelloWorld TemplateGroup
|
||||||
|
instance YesodTemplate HelloWorld where
|
||||||
|
getTemplateGroup (HelloWorld tg) = tg
|
||||||
instance Yesod HelloWorld where
|
instance Yesod HelloWorld where
|
||||||
handlers = [$resources|
|
resources = [$mkResources|
|
||||||
/:
|
/:
|
||||||
Get: helloWorld
|
Get: helloWorld
|
||||||
/groups:
|
/groups:
|
||||||
Get: helloGroup
|
Get: helloGroup
|
||||||
|]
|
|]
|
||||||
templateDir _ = "examples"
|
|
||||||
|
|
||||||
helloWorld :: Handler HelloWorld TemplateFile
|
helloWorld :: Handler HelloWorld TemplateFile
|
||||||
helloWorld = return $ TemplateFile "examples/template.html" $ cs
|
helloWorld = return $ TemplateFile "examples/template.html" $ cs
|
||||||
@ -20,11 +21,12 @@ helloWorld = return $ TemplateFile "examples/template.html" $ cs
|
|||||||
, ("content", "Hey look!! I'm <auto escaped>!")
|
, ("content", "Hey look!! I'm <auto escaped>!")
|
||||||
]
|
]
|
||||||
|
|
||||||
helloGroup :: Handler y Template
|
helloGroup :: YesodTemplate y => Handler y ChooseRep
|
||||||
helloGroup = template "real-template" "foo" (cs "bar") $ return []
|
helloGroup = template "real-template" (cs "bar") $ \ho ->
|
||||||
|
return . setAttribute "foo" ho
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
putStrLn "Running..."
|
putStrLn "Running..."
|
||||||
toHackApp HelloWorld >>= run 3000
|
loadTemplateGroup "examples" >>= toHackApp . HelloWorld >>= run 3000
|
||||||
\end{code}
|
\end{code}
|
||||||
|
|||||||
@ -6,13 +6,13 @@ import Hack.Handler.SimpleServer
|
|||||||
|
|
||||||
data HelloWorld = HelloWorld
|
data HelloWorld = HelloWorld
|
||||||
instance Yesod HelloWorld where
|
instance Yesod HelloWorld where
|
||||||
handlers = [$resources|
|
resources = [$mkResources|
|
||||||
/:
|
/:
|
||||||
Get: helloWorld
|
Get: helloWorld
|
||||||
|]
|
|]
|
||||||
|
|
||||||
helloWorld :: Handler HelloWorld HtmlObject
|
helloWorld :: Handler HelloWorld ChooseRep
|
||||||
helloWorld = return $ cs "Hello world!"
|
helloWorld = applyLayout' "Hello World" $ cs "Hello world!"
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = putStrLn "Running..." >> toHackApp HelloWorld >>= run 3000
|
main = putStrLn "Running..." >> toHackApp HelloWorld >>= run 3000
|
||||||
|
|||||||
@ -5,7 +5,7 @@ import Hack.Handler.SimpleServer
|
|||||||
data I18N = I18N
|
data I18N = I18N
|
||||||
|
|
||||||
instance Yesod I18N where
|
instance Yesod I18N where
|
||||||
handlers = [$resources|
|
resources = [$mkResources|
|
||||||
/:
|
/:
|
||||||
Get: homepage
|
Get: homepage
|
||||||
/set/$lang:
|
/set/$lang:
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user