Yesod: Помогите добавить selectField и textAreaField [HASKELL]

Question

Я начал программу Haskell сейчас. Мне нужна помощь с моим кодом, я хочу добавить selectField и TextAreaField в мою форму. Как я сказал, я новый, мне нужна помощь, чтобы добавить это поле делать свою форму и получит от них в формате JSON тоже в том же типе Вот мой код:

{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes, 
      TemplateHaskell, GADTs, FlexibleInstances, 
      MultiParamTypeClasses, DeriveDataTypeable, 
      GeneralizedNewtypeDeriving, ViewPatterns, EmptyDataDecls #-} 
import Yesod 
import Database.Persist.Postgresql 
import Data.Text 
import Control.Monad.Logger (runStdoutLoggingT) 

data Pagina = Pagina{connPool :: ConnectionPool} 

instance Yesod Pagina 

share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| 
Animals json --JSON that send and create table at Database 
    nome Text 
    idade Int 
    deriving Show 
|] 

mkYesod "Pagina" [parseRoutes| 
/HomeR GET 
/animal/cadastro AnimalR GET POST 
/animal/checar/#AnimalsId ChecarAnimalR GET 
/erro ErroR GET 
|] 

instance YesodPersist Pagina where 
    type YesodPersistBackend Pagina = SqlBackend 
    runDB f = do 
     master <- getYesod 
     let pool = connPool master 
     runSqlPool f pool 

type Form a = Html -> MForm Handler (FormResult a, Widget) 

instance RenderMessage Pagina FormMessage where 
    renderMessage _ _ = defaultFormMessage 
------------------------ 


formAnimal :: Form Animals 
formAnimal = renderDivs $ Animals <$> 
      areq textField "Nome: " Nothing <*> 
      areq intField "Idade: " Nothing 


getAnimalR :: Handler Html 
getAnimalR = do 
      (widget, enctype) <- generateFormPost formAnimal 
      defaultLayout $ do 
      toWidget [cassius| 
       label 
        color:blue; 
      |] 
      [whamlet| 
       <form method=post enctype=#{enctype} action=@{AnimalR}> 
        ^{widget} 
        <input type="submit" value="Cadastrar Animal"> 
      |] 

postAnimalR :: Handler Html 
postAnimalR = do 
      ((result, _), _) <- runFormPost formAnimal 
      case result of 
       FormSuccess anim -> (runDB $ insert anim) >>= \piid -> redirect (ChecarAnimalR piid) 
       _ -> redirect ErroR 

getHomeR :: Handler Html 
getHomeR = defaultLayout [whamlet|Hello World!|] 

getChecarAnimalR :: AnimalsId -> Handler Html 
getChecarAnimalR pid = do 
    animal <- runDB $ get404 pid 
    defaultLayout [whamlet| 
    <font size="10">Perfil do Pet</font><br> 
     <p><b> Nome do Pet:</b> #{animalsNome animal} 
     <p><b> Idade do Pet:</b> #{show $ animalsIdade animal} Anos 
    |] 

getErroR :: Handler Html 
getErroR = defaultLayout [whamlet| 
    Falha no Cadastro ! 
|] 

connStr = "dbname=... host=... user=... password=... port=5432" 

main::IO() 
main = runStdoutLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do 
     runSqlPersistMPool (runMigration migrateAll) pool 
     warp 8080 (Pagina pool) 

Answer 1

Yesod book имеет раздел о формах с много примеров:

• http://www.yesodweb.com/book/forms

Вот пример списка выбора:

carAForm :: Maybe Car -> AForm Handler Car 
carAForm mcar = Car 
    <$> areq textField "Model" (carModel <$> mcar) 
    <*> areq carYearField "Year" (carYear <$> mcar) 
    <*> aopt (selectFieldList colors) "Color" (carColor <$> mcar) 
    where 
    colors :: [(Text, Color)] 
    colors = [("Red", Red), ("Blue", Blue), ("Gray", Gray), ("Black", Black)] 

и для TextArea просто использовать функцию textareaField и т.д .:

form :: UserId -> Form Blog 
form userId = renderDivs $ Blog 
    <$> areq textField "Title" Nothing 
    <*> areq textareaField "Contents" Nothing 
    <*> pure userId 
    <*> lift (liftIO getCurrentTime)