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)

Yesod：帮助添加selectField和textAreaField [HASKELL]

1 个答案: