Create a gist now

Instantly share code, notes, and snippets.

@roman /Site.hs
Created Feb 14, 2011

What would you like to do?
<title>Sending Form Example</title>
<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"/>
{-# 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"
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"
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/"
(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