#{pageTitle pc} <meta charset=utf-8> ^{pageHead pc} <body> <div .container> <div .row> ^{pageBody pc} |] instance YesodJquery Demo instance YesodJqueryPnotify Demo instance RenderMessage Demo FormMessage where renderMessage _ _ = defaultFormMessage data Account = Account { ident :: Text, passwd :: Text } deriving Show accountForm :: AForm Handler Account accountForm = Account <$> areq textField (bfs ("Id" :: Text)) Nothing <*> areq passwordField (bfs ("Pass" :: Text)) Nothing <* bootstrapSubmit ("Sign in" :: BootstrapSubmit Text) hGrid = BootstrapHorizontalForm (ColSm 0) (ColSm 4) (ColSm 0) (ColSm 6) getLoginR :: Handler Html getLoginR = do (w, e) <- generateFormPost $ renderBootstrap3 hGrid accountForm defaultLayout $ do setTitle "Login" [whamlet| <form .form-horizontal role=form method=post action=@{LoginR} enctype=#{e}> <div .form-group> <div .col-sm-4> <h1 .col-sm-6>Sign in ^{w} |] postLoginR :: Handler Html postLoginR = do ((r, w), e) <- runFormPost $ renderBootstrap3 hGrid accountForm case r of FormSuccess acc -> if ident acc == passwd acc then do setPNotify $ defaultPNotify { _type = Just Success , _styling = Just Bootstrap3 , _title = Just $ Right "Hello" , _text = Just $ Right $ "Welcome, " `T.append` ident acc } redirect (HomeR $ ident acc) else do setPNotify $ defaultPNotify { _type = Just Error , _styling = Just Bootstrap3 , _title = Just $ Right "Try again" , _text = Just $ Right "Please match the Id and the Pass." } redirect LoginR _ -> do setPNotify $ defaultPNotify { _type = Just Error , _styling = Just Bootstrap3 , _title = Just $ Right "Fail" , _text = Just $ Right "What happen?" } redirect LoginR getHomeR :: Text -> Handler Html getHomeR name = defaultLayout $ do setTitle "Home" [whamlet| <p>`#{name}' Logged in. <a href=@{LoginR} .btn .btn-primary>Sign out |] main

import Control.Applicative ((<$>),(<*>)) import Control.Monad (forM_) import Data.Text (Text) import qualified Data.Text as T import Yesod import Yesod.Form.Jquery hiding (urlJqueryJs) import Yesod.Form.Bootstrap3 import Yesod.Goodies.PNotify data Demo = Demo mkYesod "Demo" [parseRoutes| / LoginR GET POST /home/#Text HomeR GET |] instance Yesod Demo where defaultLayout widget = do y <- getYesod pc <- widgetToPageContent $ do addScriptEither $ urlJqueryJs y addScriptEither $ urlBootstrap3Js y addStylesheetEither $ urlBootstrap3Css y widget pnotify y withUrlRenderer [hamlet| $doctype 5 #{pageTitle pc} <meta charset=utf-8> ^{pageHead pc} <body> <div .container> <div .row> ^{pageBody pc} |] instance YesodJquery Demo instance YesodJqueryPnotify Demo instance RenderMessage Demo FormMessage where renderMessage _ _ = defaultFormMessage data Account = Account { ident :: Text, passwd :: Text } deriving Show accountForm :: AForm Handler Account accountForm = Account <$> areq textField (bfs ("Id" :: Text)) Nothing <*> areq passwordField (bfs ("Pass" :: Text)) Nothing <* bootstrapSubmit ("Sign in" :: BootstrapSubmit Text) hGrid = BootstrapHorizontalForm (ColSm 0) (ColSm 4) (ColSm 0) (ColSm 6) getLoginR :: Handler Html getLoginR = do (w, e) <- generateFormPost $ renderBootstrap3 hGrid accountForm defaultLayout $ do setTitle "Login" [whamlet| <form .form-horizontal role=form method=post action=@{LoginR} enctype=#{e}> <div .form-group> <div .col-sm-4> <h1 .col-sm-6>Sign in ^{w} |] postLoginR :: Handler Html postLoginR = do ((r, w), e) <- runFormPost $ renderBootstrap3 hGrid accountForm case r of FormSuccess acc -> if ident acc == passwd acc then do setPNotify $ defaultPNotify { _type = Just Success , _styling = Just Bootstrap3 , _title = Just $ Right "Hello" , _text = Just $ Right $ "Welcome, " `T.append` ident acc } redirect (HomeR $ ident acc) else do setPNotify $ defaultPNotify { _type = Just Error , _styling = Just Bootstrap3 , _title = Just $ Right "Try again" , _text = Just $ Right "Please match the Id and the Pass." } redirect LoginR _ -> do setPNotify $ defaultPNotify { _type = Just Error , _styling = Just Bootstrap3 , _title = Just $ Right "Fail" , _text = Just $ Right "What happen?" } redirect LoginR getHomeR :: Text -> Handler Html getHomeR name = defaultLayout $ do setTitle "Home" [whamlet| <p>`#{name}' Logged in. <a href=@{LoginR} .btn .btn-primary>Sign out |] main :: IO () main = warp 3000 Demo