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

18
Yesod/Rep.hs
View File

@ -37,12 +37,15 @@ module Yesod.Rep
, plain
, Template (..)
, TemplateFile (..)
, Static (..)
, StaticFile (..)
#if TEST
, testSuite
#endif
) where
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.Text.Lazy (Text)
import Data.Maybe (mapMaybe)
import Data.Function (on)
@ -134,6 +137,9 @@ instance HasReps RepChooser where
reps = error "reps of RepChooser"
chooseRep = id
instance HasReps () where
reps = [(TypePlain, const $ return $ cs "")]
instance HasReps [(ContentType, Content)] where
reps = error "reps of [(ContentType, Content)]"
chooseRep a cts = return $
@ -170,6 +176,18 @@ instance HasReps TemplateFile where
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
instance HasReps HtmlObject where
reps =

6
Yesod/Resource.hs
View File

@ -51,11 +51,7 @@ import Control.Monad ((<=<), unless)
import Data.Object.Yaml
import Yesod.Handler
import Data.Maybe (fromJust)
#if TEST
import Yesod.Rep hiding (testSuite)
#else
import Yesod.Rep
#endif
import Yesod.Rep (chooseRep)
import Control.Arrow
#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
ghc-options: -Wall
main-is: examples/hellotemplate.lhs
executable fact
if flag(buildsamples)
Buildable: True
else
Buildable: False
ghc-options: -Wall
main-is: examples/fact.lhs