-- Quasi quotes in curly brackets
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TemplateHaskell, QuasiQuotes #-}
-- import libraries
import Yesod
import Data.Text
import Control.Applicative
import Yesod.Form
- set the web server port Warp to 3000
main :: IO ()
main = warp 3000 FormApp
data FormApp = FormApp
instance Yesod FormApp
instance RenderMessage FormApp FormMessage where
    renderMessage _ _ = defaultFormMessage
- the "FormApp" web application only provides one route
mkYesod "FormApp" [parseRoutes|
/contact  ContactR GET |]
- an auxiliary function integrates the form widget into a web page
page enctype widget res = defaultLayout $ do
-- set the title of the website
        setTitle "Contact"
        [whamlet|
                <p>Result: #{show res}
                <form enctype=#{enctype}>
                        ^{widget}
                        <button>Send
    |]
- HTML input field data types
data ContactForm = ContactForm {
     contactName ::  Text
    ,contactEmail :: Text
    ,contactText :: Textarea
} deriving Show
- function generates a form of MForm type
createForm ::  Html -> MForm Handler (FormResult ContactForm, Widget)
createForm extra = do
-- mreq = required -> required field
        (nameRes,nameView) <- mreq textField "Name" Nothing
        (emailRes,mailView) <- mreq emailField  "Email" Nothing
        (textRes,textView) <- mreq textareaField "Text" Nothing
        let contactRes = ContactForm <$> nameRes <*> emailRes <*> textRes
            widget = do
            toWidget
-- integrate Lucius stylesheet
                [lucius|
                    @bColor: mediumseagreen;
                    ##{fvId nameView}, ##{fvId mailView}, ##{fvId textView}{
                        border: 3px solid #{bColor};
                    }
                |]
            [whamlet|
                #{extra}
          <h1>Contact Form!
                <p>Name: ^{fvInput nameView}
                <p>Email: ^{fvInput mailView}
                <p>Text: ^{fvInput textView}
            |]
        return (contactRes,widget)
getContactR :: Handler Html
getContactR = do
   ((res,widget), enctype) <- runFormGet $ createForm
page enctype widget res