我现在开始编程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)
答案 0 :(得分:1)
Yesod book有一个关于表单的部分,其中包含许多示例:
以下是选择列表的示例:
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)