roman/Site.hs

## form.html
<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>

## Site.hs
{-# 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"
	<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>
	{-# 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"