{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} module Main (main) where import Data.Text (Text) import Yesod import Yesod.Form.Bulma data App = App mkYesod "App" [parseRoutes| / HomeR GET POST |] instance Yesod App instance YesodBulma App instance RenderMessage App FormMessage where renderMessage _ _ = defaultFormMessage data Basic = Basic { name :: Text , username :: Text , email :: Text , subject :: Text , message :: Textarea , agree :: Bool , question :: Text } basicForm :: Html -> MForm Handler (FormResult Basic, Widget) basicForm = renderBulma BulmaBasicForm $ Basic <$> areq bulmaTextField ("Text input" `withPlaceholder` "Name") Nothing <*> areq bulmaTextField ("bulma" `withPlaceholder` "Username") Nothing <*> areq bulmaEmailField ("Email input" `withPlaceholder` "Email") Nothing <*> areq (bulmaSelectFieldList [("Select dropdown" :: Text, "v1"), ("With options", "v2")] ) "Subject" Nothing <*> areq bulmaTextareaField ("Textarea" `withPlaceholder` "Message") Nothing <*> areq (bulmaCheckBoxField "I agree to the terms and conditions") "" Nothing <*> areq (bulmaRadioFieldList [("yes" :: Text, "y"), ("no", "n")]) "" Nothing <* bulmaSubmit (BulmaSubmit ("Submit" :: Text) "btn-default" [("attribute-name", "attribute-value")]) getHomeR :: Handler Html getHomeR = do ((result, form1), enctype) <- runFormPost basicForm defaultLayout $ case result of FormSuccess res -> [whamlet|
^{form1}
|] _ -> [whamlet|
^{form1} |] postHomeR :: Handler Html postHomeR = getHomeR main :: IO () main = warp 3100 App
Name#{name res}
Username#{username res}
Email#{email res}
Subject#{subject res}
Message#{message res}
Agree#{agree res}
Question#{question res}