MgaMPKAy/Session.hs

## Session.hs
{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}

import Yesod
import Control.Applicative ((<$>), (<*>))

data SessionExample = SessionExample

mkYesod "SessionExample" [parseRoutes|
/ Root GET POST
|]

getRoot :: Handler RepHtml
getRoot = do
    sess <- getSession
    hamletToRepHtml [hamlet|
<form method=post>
  <input type=text name=key>
  <input type=text name=val>
  <input type=submit>
<h1>#{show sess}
|]

postRoot :: Handler RepHtml
postRoot = do
    (key, mval) <- runInputPost $ (,) <$> ireq textField "key" <*> iopt textField "val"
    case mval of
      Nothing -> deleteSession key
      Just val -> setSession key val
    liftIO $ print (key, mval)
    redirect Root

instance Yesod SessionExample where
    clientSessionDuration _ = 1

instance RenderMessage SessionExample FormMessage where
    renderMessage _ _ = defaultFormMessage

main :: IO ()
main = warpDebug 3000 SessionExample

## SessionMessages.hs
{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}

import Yesod

data Messages = Messages

mkYesod "Messages" [parseRoutes|
/ RootR GET
/set-message SetMessageR POST
|]

instance Yesod Messages where
    defaultLayout widget = do
        pc <- widgetToPageContent widget
        mmsg <- getMessage
        hamletToRepHtml [hamlet|
$doctype 5
<html>
  <head>
    <title>#{pageTitle pc}
    ^{pageHead pc}
  <body>
    $maybe msg <- mmsg
      <p>Your message was: #{msg}
    ^{pageBody pc}
|]

instance RenderMessage Messages FormMessage where
    renderMessage _ _ = defaultFormMessage

getRootR :: Handler RepHtml
getRootR = defaultLayout [whamlet|
<form method=post action=@{SetMessageR}>
  My message is:#
  <input type=text name=message>
  <input type=submit>
|]

postSetMessageR :: Handler ()
postSetMessageR = do
    msg <- runInputPost $ ireq textField "message"
    setMessage $ toHtml msg
    redirect RootR


main :: IO ()
main = warpDebug 3000 Messages
	{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell #-}
	{-# LANGUAGE MultiParamTypeClasses, OverloadedStrings #-}

	import Yesod
	import Control.Applicative ((<$>), (<*>))

	data SessionExample = SessionExample

	mkYesod "SessionExample" [parseRoutes\|
	/ Root GET POST
	\|]

	getRoot :: Handler RepHtml
	getRoot = do
	sess <- getSession
	hamletToRepHtml [hamlet\|
	<form method=post>
	<input type=text name=key>
	<input type=text name=val>
	<input type=submit>
	<h1>#{show sess}
	\|]

	postRoot :: Handler RepHtml
	postRoot = do
	(key, mval) <- runInputPost $ (,) <$> ireq textField "key" <*> iopt textField "val"
	case mval of
	Nothing -> deleteSession key
	Just val -> setSession key val
	liftIO $ print (key, mval)
	redirect Root

	instance Yesod SessionExample where
	clientSessionDuration _ = 1

	instance RenderMessage SessionExample FormMessage where
	renderMessage _ _ = defaultFormMessage

	main :: IO ()
	main = warpDebug 3000 SessionExample