haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Added fact example and fixed a few bugs.

Browse Source 
Added the Static and StaticFile reps.
Special responses set headers properly (redirect works).
This commit is contained in:
Michael Snoyman 2009-12-21 16:05:48 +02:00
parent f27f6cd7e3
commit 7ab3b406db
6 changed files with 70 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
Yesod/Handler.hs
View File

@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-} -- FIXME remove {-# LANGUAGE TypeSynonymInstances #-} -- FIXME remove
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PackageImports #-}
--------------------------------------------------------- ---------------------------------------------------------
-- --
-- Module : Yesod.Handler -- Module : Yesod.Handler
@ -39,7 +40,7 @@ import Yesod.Rep
import Control.Exception hiding (Handler) import Control.Exception hiding (Handler)
import Control.Applicative import Control.Applicative
import Control.Monad.Trans import "transformers" Control.Monad.Trans
import Control.Monad.Attempt import Control.Monad.Attempt
import Control.Monad (liftM, ap) import Control.Monad (liftM, ap)
@ -103,7 +104,8 @@ runHandler (Handler handler) eh rr y cts = do
case contents' of case contents' of
Left e -> do Left e -> do
Response _ hs ct c <- runHandler (eh e) specialEh rr y cts Response _ hs ct c <- runHandler (eh e) specialEh rr y cts
return $ Response (getStatus e) hs ct c let hs' = hs ++ getHeaders e
return $ Response (getStatus e) hs' ct c
Right a -> do Right a -> do
(ct, c) <- a cts (ct, c) <- a cts
return $ Response 200 headers ct c return $ Response 200 headers ct c

18
Yesod/Rep.hs
View File

@ -37,12 +37,15 @@ module Yesod.Rep
, plain , plain
, Template (..) , Template (..)
, TemplateFile (..) , TemplateFile (..)
, Static (..)
, StaticFile (..)
#if TEST #if TEST
, testSuite , testSuite
#endif #endif
) where ) where
import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Text.Lazy (Text) import Data.Text.Lazy (Text)
import Data.Maybe (mapMaybe) import Data.Maybe (mapMaybe)
import Data.Function (on) import Data.Function (on)
@ -134,6 +137,9 @@ instance HasReps RepChooser where
reps = error "reps of RepChooser" reps = error "reps of RepChooser"
chooseRep = id chooseRep = id
instance HasReps () where
reps = [(TypePlain, const $ return $ cs "")]
instance HasReps [(ContentType, Content)] where instance HasReps [(ContentType, Content)] where
reps = error "reps of [(ContentType, Content)]" reps = error "reps of [(ContentType, Content)]"
chooseRep a cts = return $ chooseRep a cts = return $
@ -170,6 +176,18 @@ instance HasReps TemplateFile where
return $ cs $ unJsonDoc $ cs ho) return $ cs $ unJsonDoc $ cs ho)
] ]
data Static = Static ContentType ByteString
instance HasReps Static where
reps = error "reps of Static"
chooseRep (Static ct bs) _ = return (ct, Content bs)
data StaticFile = StaticFile ContentType FilePath
instance HasReps StaticFile where
reps = error "reps of StaticFile"
chooseRep (StaticFile ct fp) _ = do
bs <- BL.readFile fp
return (ct, Content bs)
-- Useful instances of HasReps -- Useful instances of HasReps
instance HasReps HtmlObject where instance HasReps HtmlObject where
reps = reps =

6
Yesod/Resource.hs
View File

@ -51,11 +51,7 @@ import Control.Monad ((<=<), unless)
import Data.Object.Yaml import Data.Object.Yaml
import Yesod.Handler import Yesod.Handler
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
#if TEST import Yesod.Rep (chooseRep)
import Yesod.Rep hiding (testSuite)
#else
import Yesod.Rep
#endif
import Control.Arrow import Control.Arrow
#if TEST #if TEST

12
examples/fact.html Normal file
View File

@ -0,0 +1,12 @@
<!DOCTYPE html>
<html>
<head>
<title>Factorials</title>
</head>
<body>
<form method="get" action="fact/">
<p><label for="num">Number:</label> <input type="text" id="num" name="num"></p>
<p><input type="submit" value="Get the factorial!"></p>
</form>
</body>
</html>

27
examples/fact.lhs Normal file
View File

@ -0,0 +1,27 @@
\begin{code}
{-# LANGUAGE QuasiQuotes #-}
import Yesod
import Hack.Handler.SimpleServer
data Fact = Fact
instance Yesod Fact where
handlers = [$resources|
/:
Get: index
/#num:
Get: fact
/fact:
Get: factRedirect
|]
index = return $ StaticFile TypeHtml "examples/fact.html"
fact i = return $ toHtmlObject $ show $ product [1..fromIntegral i]
factRedirect = do
i <- getParam "num"
redirect $ "../" ++ i ++ "/"
return ()
main :: IO ()
main = putStrLn "Running..." >> run 3000 (toHackApp Fact)
\end{code}

8
yesod.cabal
View File

@ -113,3 +113,11 @@ executable hellotemplate
Buildable: False Buildable: False
ghc-options: -Wall ghc-options: -Wall
main-is: examples/hellotemplate.lhs main-is: examples/hellotemplate.lhs
executable fact
if flag(buildsamples)
Buildable: True
else
Buildable: False
ghc-options: -Wall
main-is: examples/fact.lhs