Created
February 14, 2011 18:17
-
-
Save roman/826286 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<html> | |
<head> | |
<title>Sending Form Example</title> | |
</head> | |
<body> | |
<form method="POST" action="/upload_file" enctype="multipart/form-data"> | |
<input type="text" name="name"/> | |
<input type="file" name="aFile"/> | |
<input type="submit" value="Try it out"/> | |
</form> | |
</body> | |
</html> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE OverloadedStrings #-} | |
{-| | |
This is where all the routes and handlers are defined for your site. The | |
'site' function combines everything together and is exported by this module. | |
-} | |
module Site | |
( site | |
) where | |
import Control.Applicative | |
import Control.Monad (forM_) | |
import Control.Monad.Trans | |
import Data.Maybe | |
import qualified Data.Text.Encoding as T | |
import Snap.Extension.Heist | |
import Snap.Extension.Timer | |
import Snap.Util.FileServe | |
import Snap.Util.FileUploads | |
import Snap.Types | |
import Text.Templating.Heist | |
import Application | |
------------------------------------------------------------------------------ | |
-- | Renders the front page of the sample site. | |
-- | |
-- The 'ifTop' is required to limit this to the top of a route. | |
-- Otherwise, the way the route table is currently set up, this action | |
-- would be given every request. | |
index :: Application () | |
index = ifTop $ heistLocal (bindSplices indexSplices) $ render "index" | |
where | |
indexSplices = | |
[ ("start-time", startTimeSplice) | |
, ("current-time", currentTimeSplice) | |
] | |
------------------------------------------------------------------------------ | |
-- | Renders the echo page. | |
echo :: Application () | |
echo = do | |
message <- decodedParam "stuff" | |
heistLocal (bindString "message" (T.decodeUtf8 message)) $ render "echo" | |
where | |
decodedParam p = fromMaybe "" <$> getParam p | |
-- snap-root/tmp/ at this point doesn't exists, this throws a "error: short write" | |
recieveFile :: Application () | |
recieveFile = handleFileUploads "tmp/" | |
defaultUploadPolicy | |
(const $ allowWithMaximumSize 30000000) $ \files -> do | |
forM_ files $ \(pInfo, et) -> do | |
liftIO $ putStrLn (show pInfo) | |
case et of | |
Left err -> liftIO $ putStrLn (show err) | |
Right fp -> liftIO $ putStrLn (show fp) | |
rq <- getRequest | |
liftIO $ putStrLn (show rq) | |
liftIO $ putStrLn (show files) | |
writeBS "Esto es lo que hay" | |
------------------------------------------------------------------------------ | |
-- | The main entry point handler. | |
site :: Application () | |
site = route [ ("/", index) | |
, ("/echo/:stuff", echo) | |
, ("/stuff", serveDirectoryWith fancyDirectoryConfig "resources/static") | |
, ("/new", serveDirectory "resources/static/form.html") | |
, ("/upload_file", recieveFile) | |
] | |
<|> serveDirectory "resources/static" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment