i want create a post method in a SubSite to create a new entity, i have this AForm
demoForm :: RenderMessage master FormMessage => Maybe Demo -> AForm (HandlerT master IO) Demo
demoForm demo = Demo
<$> areq textField (fieldSettingsLabel ("fieldone"::T.Text)) (demoFieldOne <$> demo)
<*> areq intField (fieldSettingsLabel ("fieldone"::T.Text)) (demoFieldTwo <$> demo)
<*> areq boolField (fieldSettingsLabel ("fieldThree"::T.Text)) (demoFieldThree <$> demo)
<*> areq dayField (fieldSettingsLabel ("fieldFour"::T.Text)) (demoFieldFour <$> demo)
and the Post method:
postDemoNewR :: (Yesod master,RenderMessage master FormMessage) => HandlerT DemoCrud (HandlerT master IO) Html
postDemoNewR = do
tp <- getRouteToParent
((result,widget), encoding) <- lift $ runFormPost $ renderBootstrap3 BootstrapBasicForm $ demoForm Nothing
case result of
FormSuccess demo -> do
_ <- lift $ runDB $ insert demo
redirect DemoNewR
_ -> lift $ defaultLayout $ do
let actionR = DemoNewR
[whamlet|
<form method=post action=#{tp DemoNewR} encType=#{encoding}>
^{widget}
<button .btn .btn-default> default text create
|]
but have the following error
Could not deduce (YesodPersistBackend master
~ persistent-2.1.3:Database.Persist.Sql.Types.SqlBackend)
from the context (Yesod master, RenderMessage master FormMessage)
bound by the type signature for
postDemoNewR :: (Yesod master, RenderMessage master FormMessage) =>
I thing that I need add YesodPersist but i'm not sure how
You need to add the following constraint to the postDemoNewR declaration:
YesodPersist master => YesodPersistBackend master ~ SqlBackend => …
The first constraint tells master must have persistent abilities while the second constraint tells the backend used for persistent should be an SQL backend.
You can find something similar in this other question
Related
I would like to create a form in which I pass a [a] an an argument and get back an MForm Handler (FormResult a, Widget).
I have attempted to implement this using functions such as selectFieldList but have not been able to find a solution. I have not been able to find an answer anywhere on google. I have found many examples where dropdown lists have been used as individual fields in a larger form but none where the dropdown list is the entire form itself.
Edit:
I have managed to make a form that compiles. Unfortunately I am unable to tell if it works the way I would like because I cannot get it to render.
Here are the key functions I am working with (they all compile):
mkCityStringM :: [PG.DbCity] -> [(T.Text, PG.DbCity)]
mkCityStringM xs = zip (map (T.pack . showDbCity) xs) xs
data ContainCity =
ContainCity
{ getCity :: PG.DbCity
}
deriving (Show)
ambiguityForm :: [PG.DbCity] -> AForm Handler ContainCity
ambiguityForm cities = ContainCity
<$> areq (selectFieldList cityMap) "City" Nothing
where
cityMap :: [(T.Text, PG.DbCity)]
cityMap = W.mkCityStringM cities
The problem is when I try to actually use this table I run into issues. Here is code that works just fine for me:
locationForm :: Html -> MForm Handler (FormResult BasicLocation, Widget)
locationForm = renderDivs $ BasicLocation
<$> areq textField "City:" Nothing
<*> areq textField "Country:" (Just "United States")
postAmbiguityR :: [PG.DbCity] -> Handler Html
postAmbiguityR cs = do
(widget, enctype) <- generateFormPost locationForm
defaultLayout $ do
[whamlet|
<p>who cares
|]
On the other hand I have this code:
postAmbiguityR :: [PG.DbCity] -> Handler Html
postAmbiguityR cs = do
(widget, enctype) <- generateFormPost (ambiguityForm cs) --only difference
defaultLayout $ do
[whamlet|
<p> WHATEVER
|]
which throws me this error:
• Couldn't match expected type ‘blaze-markup-0.8.2.5:Text.Blaze.Internal.Markup
-> MForm (HandlerFor Base) (FormResult a0, xml0)’
with actual type ‘AForm Handler ContainCity’
• Possible cause: ‘ambiguityForm’ is applied to too many arguments
In the first argument of ‘generateFormPost’, namely
‘(ambiguityForm cs)’
In a stmt of a 'do' block:
(widget, enctype) <- generateFormPost (ambiguityForm cs)
In the expression:
do (widget, enctype) <- generateFormPost (ambiguityForm cs)
defaultLayout
$ do (do (asWidgetT . toWidget)
((blaze-markup-0.8.2.5:Text.Blaze.Internal.preEscapedText . T.pack)
"<html><header></header>
<form method="post" action="")
....)
|
132 | (widget, enctype) <- generateFormPost (ambiguityForm cs)
| ^^^^^^^^^^^^^^^^
This error message does not make sense to me. It says a possible cause is that ambiguity form is applied to too many arguments but does not seem to be the case as the form takes a list of PG.DbCity's and that is exactly what I supplied it.
The problem is that ambiguityForm is an AForm, but generateFormPost expects an MForm. To convert it to an MForm suitable for rendering, you need to use renderDivs, like you did in your locationForm example. You can either do this in the definition of ambiguityForm, which will change its type/defintion to look something like:
ambiguityForm :: [PG.DbCity] -> Html -> MForm Handler (FormResult ContainCity, Widget)
ambiguityForm cities = renderDivs $ ContainCity ...
or you can leave ambiguityForm unchanged and add renderDivs at the usage site:
postAmbiguityR :: [PG.DbCity] -> Handler Html
postAmbiguityR cs = do
(widget, enctype) <- generateFormPost (renderDivs (ambiguityForm cs))
defaultLayout $ do
[whamlet|
<p> WHATEVER
|]
i started program Haskell now. I need some help with my code, i want add selectField and TextAreaField in my form.
Like i said, i am new, i need some help to add this field do my form and recive them at JSON too at the same type
Here's my code:
{-# 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)
The Yesod book has a section on forms with many examples:
http://www.yesodweb.com/book/forms
Here is an example of a selection list:
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)]
and for a TextArea just use the textareaField function, e.g.:
form :: UserId -> Form Blog
form userId = renderDivs $ Blog
<$> areq textField "Title" Nothing
<*> areq textareaField "Contents" Nothing
<*> pure userId
<*> lift (liftIO getCurrentTime)
I need Help to add BootStrap to My YesodForm Project. Can you help me, guys ?
Thats my code. I just want add BootStrap styles to add to my html components
I already read aloot tutorials but are complexive, i am new at Haskell. I Need a simples thing just to that simple project. Thank.s
{-# LANGUAGE OverloadedStrings, TypeFamilies, QuasiQuotes,
TemplateHaskell, GADTs, FlexibleInstances,
MultiParamTypeClasses, DeriveDataTypeable,
GeneralizedNewtypeDeriving, ViewPatterns, EmptyDataDecls #-}
import Yesod
import Database.Persist.Postgresql
import Data.Text
import Text.Lucius
import Control.Monad.Logger (runStdoutLoggingT)
data Pagina = Pagina{connPool :: ConnectionPool}
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase|
Animals json
nome Text
idade Int
deriving Show
Users json
nome Text
login Text
senha Text
deriving Show
|]
mkYesod "Pagina" [parseRoutes|
/ HomeR GET
/animal/cadastro AnimalR GET POST
/animal/checar/#AnimalsId ChecarAnimalR GET
/erro ErroR GET
/login LoginR GET POST
/usuario UsuarioR GET POST
/perfil/#UsersId PerfilR GET
/admin AdminR GET
/logout LogoutR GET
|]
instance Yesod Pagina where
authRoute _ = Just LoginR
isAuthorized LoginR _ = return Authorized
isAuthorized ErroR _ = return Authorized
isAuthorized HomeR _ = return Authorized
isAuthorized UsuarioR _ = return Authorized
isAuthorized AdminR _ = isAdmin
isAuthorized _ _ = isUser
isUser = do
mu <- lookupSession "_ID"
return $ case mu of
Nothing -> AuthenticationRequired
Just _ -> Authorized
isAdmin = do
mu <- lookupSession "_ID"
return $ case mu of
Nothing -> AuthenticationRequired
Just "admin" -> Authorized
Just _ -> Unauthorized "Acesso Restrito para Administrador"
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
formUser :: Form Users
formUser = renderDivs $ Users <$>
areq textField "Nome: " Nothing <*>
areq textField "Login: " Nothing <*>
areq passwordField "Password: " Nothing
formLogin :: Form (Text,Text)
formLogin = renderDivs $ (,) <$>
areq textField "Login: " Nothing <*>
areq passwordField "Senha: " Nothing
getAnimalR :: Handler Html
getAnimalR = do
(widget, enctype) <- generateFormPost formAnimal
defaultLayout $ do
toWidget [cassius|
label
color:blue;
|]
[whamlet|
<form .form-horizontal method=post enctype=#{enctype} action=#{AnimalR}>
^{widget}
<input type="submit" value="Cadastrar Animal">
|]
getPerfilR :: UsersId -> Handler Html
getPerfilR uid = do
user <- runDB $ get404 uid
defaultLayout $ do
toWidget $ $(luciusFile "templates/perfil.lucius")
$(whamletFile "templates/perfil.hamlet")
getUsuarioR :: Handler Html
getUsuarioR = do
(widget, enctype) <- generateFormPost formUser
defaultLayout [whamlet|
<form method=post enctype=#{enctype} action=#{UsuarioR}>
^{widget}
<input type="submit" value="Enviar">
|]
postAnimalR :: Handler Html
postAnimalR = do
((result, _), _) <- runFormPost formAnimal
case result of
FormSuccess anim -> (runDB $ insert anim) >>= \piid -> redirect (ChecarAnimalR piid)
_ -> redirect ErroR
postUsuarioR :: Handler Html
postUsuarioR = do
((result, _), _) <- runFormPost formUser
case result of
FormSuccess user -> (runDB $ insert user) >>= \piid -> redirect (PerfilR piid)
_ -> redirect ErroR
getHomeR :: Handler Html
getHomeR = defaultLayout [whamlet|Hello World!|]
addStyle :: Widget
addStyle = addStylesheetRemote "http://netdna.bootstrapcdn.com/twitter-bootstrap/2.1.0/css/bootstrap-combined.min.css"
getAdminR :: Handler Html
getAdminR = defaultLayout [whamlet|
<b><h1><font size="11"> Bem vindo ao Painel Administrativo</font></h1></b>
|]
getLoginR :: Handler Html
getLoginR = do
(widget, enctype) <- generateFormPost formLogin
defaultLayout [whamlet|
<form method=post enctype=#{enctype} action=#{LoginR}>
^{widget}
<input type="submit" value="Login">
|]
postLoginR :: Handler Html
postLoginR = do
((result, _), _) <- runFormPost formLogin
case result of
FormSuccess ("admin","eitapleuga") -> setSession "_ID" "admin" >> redirect AdminR
FormSuccess (login,senha) -> do
user <- runDB $ selectFirst [UsersLogin ==. login, UsersSenha ==. senha] []
case user of
Nothing -> redirect LoginR
Just (Entity pid u) -> setSession "_ID" (pack $ show $ fromSqlKey pid) >> redirect (PerfilR pid)
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|
<h1>Falha no Cadastro !</h1>
|]
getLogoutR :: Handler Html
getLogoutR = do
deleteSession "_ID"
defaultLayout [whamlet|
<h1> <b>Logout</b> efetuado com sucesso! </h1>
|]
connStr = "dbname=d4673as0stmsm7 host=ec2-54-221-225-242.compute-1.amazonaws.com user=nzjfptmglfomng password=fyYms4A9T8gkP4_Go8GswcfIiE port=5432"
main::IO()
main = runStdoutLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ do
runSqlPersistMPool (runMigration migrateAll) pool
warp 8080 (Pagina pool)
You can add it in your Handler function like this:
getUsuarioR :: Handler Html
getUsuarioR = do
(widget, enctype) <- generateFormPost formUser
defaultLayout $ do
addStylesheetRemote "http://remote-bootstrap-path.css"
[whamlet|
<form method=post enctype=#{enctype} action=#{UsuarioR}>
^{widget}
<input type="submit" value="Enviar">
|]
Also if you are new to Haskell, I would suggest you to learn some minimal Haskell before diving into Yesod.
Especially for a first project I would advise to use the scaffolded site. You can get it by following the quick start guide on the Yesod home page. Not only do you get sensible default settings, but it also has the bootstrap css already integrated.
The downside is of course that the scaffolding throws a lot of stuff and opinions at you that you might not want or not agree with. But even if you don't like the scaffolding, you can always keep one in a separate folder and just take inspiration from it and incorporate parts of it into your own site - like the integration of bootstrap or jquery.
What you need to do next is to add the appropriate classes to your html elements. There are two ways to do that, depending on the context. In your own widgets you just add them like you would any other class (with a point in front of it). If you use code that is generated, for example for forms or for yesod-table, you often have a choice between different rendering functions. For example you can render forms in two columns by using the renderTable rendering function. But there is almost always another function with a name like renderBootstrap which will render the content as plain divs with bootstrap classes.
So all in all Yesod is extremely well integrated with bootstrap. Even too much in my personal opinion. But in your case it should make your task comparatively easy after the initial setup confusion.
I'm trying to use a selectFieldList inside a subsite form but I get the following error:
Couldn't match type 'IO' with 'HanderT master IO'
I'm running into this problem when using the following snippets, where the subsite is named TestSub (this subsite is separated from the master site):
Types:
type TestHandler a = forall master. Yesod master
=> HandlerT TestSub (HandlerT master IO) a
type Form a = forall master. Yesod master
=> Html -> MForm (HandlerT TestSub (HandlerT master IO)) (FormResult a, WidgetT TestSub IO ())
Form & handler:
testForm :: Form (Text, Int)
testForm = renderBootstrap3 BootstrapBasicForm $ (,)
<$> areq textField (bfs MsgText) Nothing
<*> areq (selectFieldList [(MsgFirst, 1), (MsgSecond, 2)]) (bfs MsgSelect) Nothing
getTestHome :: TestHandler Html
getTestHome = do
(formWidget, _) <- generateFormPost testForm
defaultLayoutSub $ do
setTitleI MsgTest
[whamlet|^{formWidget}|]
when the select field is replaced with for instance an intField the form and handler work as expected. While looking for the selectFieldList on Hoogle I found that options fields (select, radio, checkbox) have a different signature (displayed below) then the "normal" fields. I suspect this difference to be the problem but haven't found a work-around without having to implement the option fields all over.
Options field signature:
selectFieldList :: (Eq a, RenderMessage site FormMessage, RenderMessage site msg)
=> [(msg, a)]
-> Field (HandlerT site IO) a
Normal field signature:
intField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage)
=> Field m i
Is there a way to get the options fields to work in a subsite context, without reimplementing them?
It's usually best to run your forms in the master site, not the subsite, by calling lift. You'll also need to modify your type synonyms a bit to match, but the basic idea is to replace:
(formWidget, _) <- generateFormPost testForm
with
(formWidget, _) <- lift $ generateFormPost testForm
EDIT
I still recommend the above approach. However, to get the alternate that you're asking for, change your type synonym to:
type Form a =
Html -> MForm (HandlerT HelloSub IO) (FormResult a, WidgetT HelloSub IO ())
and then use liftHandlerT:
liftHandlerT $ generateFormPost testForm
Keep in mind that this isn't how subsites are designed to be used, so you'll likely end up with some more friction as you keep going.
Regarding master translations: you can definitely leverage them, you just put in a constraint along the lines of RenderMessage master MessageDataType. That's what's used for FormMessage all over the place.
EDIT2
One more incantation you may find useful:
defaultLayoutSub $ liftWidgetT widget
I get the type error
Estuary0b.hs:112:53:
Couldn't match type `HandlerT Site IO' with `WidgetT Site IO'
Expected type: Text.Blaze.Internal.Markup
-> MForm (WidgetT Site IO) (FormResult Course, WidgetT Site IO ())
Actual type: Text.Blaze.Internal.Markup
-> Control.Monad.Trans.RWS.Lazy.RWST
(Maybe (Env, FileEnv), HandlerSite (HandlerT Site IO), [Lang])
Enctype
Ints
(HandlerT Site IO)
(FormResult Course, WidgetT (HandlerSite (HandlerT Site IO)) IO ())
In the first argument of `generateFormPost', namely
`add_course_form'
In a stmt of a 'do' block:
(form_widget, form_enctype) <- generateFormPost add_course_form
In the second argument of `($)', namely
`do { setTitle "Estuary - Courses";
(form_widget, form_enctype) <- generateFormPost add_course_form;
do { (Yesod.Core.Widget.asWidgetT . toWidget)
((Text.Blaze.Internal.preEscapedText . Data.Text.pack)
"<h1>Courses</h1>\
\<table><tr><th>Name</th>\
\<th>Accreditation</th>\
\<th>Specification</th>\
\<th>Scheme of work</th>\
\<th>Past papers</th>\
\</tr>");
Data.Foldable.mapM_
(\ (Course cname_a5mw aname_a5mx __a5my __a5mz __a5mA) -> ...
)
courses;
.... } }'
When I try to compile the following:
data Course = Course {
_course_name :: !Text,
_accreditor :: !Text,
_spec :: !ByteString,
_sow :: !ByteString,
_past_exams :: ![ByteString]
}
deriving (Eq, Ord, Data, Typeable)
deriveSafeCopy 0 'base ''Course
mkYesod "Site" [parseRoutes|
/ Home GET
/courses Courses GET POST
|]
getHome :: Handler Html
getHome = do
defaultLayout [whamlet|<h1>Estuary|]
getCourses :: Handler Html
getCourses = do
site <- getYesod
courses <- fmap IxSet.toList $ query' (_db site) All_courses
defaultLayout $ do
setTitle "Estuary - Courses"
(form_widget, form_enctype) <- generateFormPost add_course_form
[whamlet|
<h1>Courses
<table>
<tr>
<th>Name
<th>Accreditation
<th>Specification
<th>Scheme of work
<th>Past papers
$forall (Course cname aname _ _ _) <- courses
<tr>
<td>#{cname}
<td>#{aname}
<td>Download
<td>Download
<h2>Add a new course
<form method=post action=#{Courses} enctype=#{form_enctype}>
^{form_widget}
<input type=submit value=Add_course>|]
add_course_form = renderDivs $ Course
<$> areq textField "Course name" Nothing
<*> areq textField "Accredditation" Nothing
<*> pure Bytes.empty
<*> pure Bytes.empty
<*> pure []
postCourses :: Handler Html
postCourses = do
((result, _), _) <- runFormPost add_course_form
case result of
FormSuccess course -> do
site <- getYesod
update' (_db site) (Add_course course)
_ -> return ()
redirect Courses
Can anyone help?
generateFormPost is intended to be run in the Handler monad, not the Widget monad. You can either:
Move the generate call outside of the defaultLayout block.
Add a handlerToWidget call in front of generateFormPost.