public
Last active

  • Download Gist
Site.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80
{-# 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"
form.html
HTML
1 2 3 4 5 6 7 8 9 10 11 12
<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>

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.