Which form to run? - haskell

I'm trying to build a page with multiple similar forms on one page. Each form is very simple, it provides an integer input and a submit button. Each form corresponds to a counter, and the counter is supposed to be increased when the form is submitted.
incrementCounterForm :: Entity Counter -> Form (CounterId, Int)
incrementCounterForm (Entity i _) = renderBoostrap3 BootstrapInlineForm
$ (,)
<$> pure i
<*> areq intField "value" Nothing
In my GET handler I do
counters <- runDB $ selectList [] [] -- Get all the current counters
forms <- mapM (generateFormPost . incrementCounterForm) counters -- Generate the forms
Then in my hamlet file I iterate over the forms and render them all individually (they all go to the same handler).
My question relates to the POST handler. How do I do the runFormPost?
((result,_),_) <- runFormPost $ incrementCounterForm undefined
What should undefined be here? I want to get the counter from the form, not have to provide one.
EDIT: I lied about providing an arbitrary counter working
If I do provide an arbitrary Entity Counter it seems to work (the provided counter is not used in the result). Yet, I can't leave it as undefined because runFormPost seems to evaluate it.

So, I'd probably advise moving your counter ID into the URL, so you're doing something like POSTing to /counters/1/increment or something. Feels slightly off to have the ID in a hidden field.
However, if you did want to keep it in a hidden field, you can have the form take a Maybe (Entity Counter) as an argument. What you'll do is when the user GETs the page and you're generating the form, you'll pass in a (Just entity) as the argument which you'll use to populate the hidden field. When the user POSTs to you and you run the form, you'll provide no default value (because you want the value that was stored in the hidden field).
Here's an example of what that would look like:
data MyForm = MyForm
{ increment :: Integer
, counterId :: CounterId
}
deriving Show
myForm :: Maybe (Entity Counter) -> AForm Handler MyForm
myForm maybeEntity = MyForm
<$> areq intField "How much to increment?" Nothing
<*> areq hiddenField "" (entityKey <$> maybeEntity)
When generating the form, provide a value for the hidden field:
(widget, enctype) <- generateFormPost $ renderBootstrap (myForm (Just someEntity))
When running the form, don't provide a default value; the hidden field should have the data already:
((res, widget), enctype) <- runFormPost $ renderBootstrap (myForm Nothing)

Related

With Reflex.GI.Gtk, how to use and force evaluation of a dynamic from within an event

When using reflex-gi-gtk-0.2.0.0
I can access a dynamic from within an event:
submitButtonE4 <- eventOnSignal submitButton #clicked
(
do
let processDyn dynCompany = do
case dynCompany of
Just company -> do
path <- chartAnnualROA company fileOptions800x600 --generateChart company
Gtk.imageClear chartImage
Gtk.set chartImage [#file := T.pack defaultReportPath]
--return x -- path
case T.null $ T.pack path of
True -> return "" --dynCompany
Nothing -> return "" -- dynCompany
return $ ffor maybeCompanyDyn processDyn
>>= )
But in order to be evaluated, I need to bind it to a label:
sink submitClickStatusLabel [#label :== ffor submitButtonE4 (T.pack . show)]
which does not work as it is in Dynamic (SpiderTimeline x) (IO (Maybe Company)).
So instead I must go and get the info that the dynamic was bound to:
(
do
name <- Gtk.get companyCboxBoxEntryWidget #text
case Map.lookup name companyMap of
Just company -> do
path <- chartAnnualROA company fileOptions800x600 --generateChart company
Gtk.imageClear chartImage
Gtk.set chartImage [#file := T.pack defaultReportPath]
return path
Nothing -> return "../investingRIO/src/Data/Reports/initialChart.svg"
>>= )
and now I can sink it and cause evalution.
sink submitClickStatusLabel [#label :== ffor submitButtonE (T.pack . show)]
I am unable to find any way to force the evaluation when using the first method. How do I force the evalution without sinking to another widget?
Thanks
Here is the new version, based on Kritzefitz's answer.
An event for selecting a company from a combobox, which is same as before
companySelectionE <- eventOnAttribute companyCboxBoxEntryWidget #text
Replaced dynamic with a behavior.
companySelectionB <- hold Nothing $ ffor companySelectionE (`Map.lookup` companyMap)
generateChart (renamed from processDyn) returns a () instead of a FilePath, which was an attempt at forcing evaluation, now done by performEvent.
let
generateChart company = do
case company of
Just companyJ -> do
chartAnnualROA companyJ fileOptions800x600
Gtk.imageClear chartImage
Gtk.set chartImage [#file := T.pack defaultReportPath]
return ()
Nothing -> return ()
submitClickedE now uses eventOnSignal0 instead of eventOnSignal
submitClickedE <- eventOnSignal0 submitButton #clicked
Creating a chart from the selected company is now a behavior instead of a dynamic.
let generateChartB = generateChart <$> companySelectionB
Now I use <# to create a new event from the submit event and generate chart behavior.
let generateChartE = generateChartB <# submitClickedE
And the use of performEvent, which eliminated all the labels I was creating and sinking to in an attempt to get my IO to evaluate. It also eliminated the FilePath return from generateChart, aslo an attempt to force evaluation.
processedCompany <- performEvent $ runGtk <$> generateChartE
Thank cleared up a lot of things for me, thanks.
Here it is in a single quote for easier reading:
companySelectionE <- eventOnAttribute companyCbox #text
companySelectionB <- hold Nothing $ ffor companySelectionE (`Map.lookup` companyMap)
let
generateChart company = do
case company of
Just companyJ -> do
chartAnnualROA companyJ fileOptions800x600
Gtk.set chartImage [#file := T.pack defaultReportPath]
return ()
Nothing -> return ()
submitClickedE <- eventOnSignal0 submitButton #clicked
let generateChartB = generateChart <$> companySelectionB
let generateChartE = generateChartB <# submitClickedE
processedCompany <- performEvent $ runGtk <$> generateChartE
I think most of your trouble comes from the fact, that you want to do substantial amounts of work inside eventOnSignal . This place is not intended to do the actual heavy lifting of your business logic and it doesn't provide you with the proper context to effectively work with reactive values, such as Dynamics, as you are currently experiencing.
The actual use case for the eventOnSignal* family of functions is to obtain basic inputs for your reactive network. The input provided by a button doesn't carry any actual information. It just provides the information when the button has been clicked. For cases like this you usually don't want to use eventOnSignal directly, but rather eventOnSignal0, so let's do that:
submitClickedE <- eventOnSignal0 submitButton #clicked
The type returned by this is submitClickedE :: Event t (). As you can see, the Event has a () as its value, which is what we want, because merely clicking the button doesn't produce any value by itself. But you want to call an IO-producing function on the value inside processDyn, so let's first construct the IO action you want to execute:
let processDynD = processDyn <$> dynCompany
The assignment here has the type processDynD :: Dynamic t (IO (Maybe Company)). As you can see, the IO hasn't been executed yet. Luckily reflex provides an operation to execute IO actions inside reactive values, called performEvent :: Event t (Performable m a) -> m (Event t a). There are two things about this type, that don't quite fit what we need at the moment. First, it expects the monad to be performed to be a Performable m whereas we have IO, but we will get to that in a moment. The second and more pressing concern is that performEvent expects an Event, not a Dynamic. This makes sense, because you can't execute an IO action continuously. You have to decide when the IO action is executed.
AIUI you want the IO to be executed, when the submitButton is clicked. So we want an Event that fires whenever submitClickedE fires, but it should fire the current value inside processDynD. Doing something like this is called “sampling a Behavior with an Event” and can be done using the operator (<#). In your case you want to sample a Dynamic, but you can always turn a Dynamic into a Behavior using current. So to get the expected Event you can use this:
let processDynE = current processDynD <# submitClickedE
The assignment has the value processDynE :: Event t (IO (Maybe Company)). But as you can see, the IO still hasn't been executed. We can now do that using performEvent as discussed earlier:
processedCompany <- performEvent $ runGtk <$> processDynE
We use runGtk to lift the IO in processDynE to the required Performable m. The returned value has the type processedCompany :: Event t (Maybe Company). You can now sink this into your output label, as was your original intention:
sink submitClickStatusLabel [#label :== T.pack . show <$> processedCompany]
Note though, that unlike your original attempt, we now ended up with an Event instead of a Dynamic. If you actually need a Dynamic from all of this, you have to construct it from the Event using holdDyn initialValue processedCompany. But then you have to provide an initialValue because otherwise there is no value for the Dynamic before the submitButton has been clicked for the first time.

Yesod: Passing the current user to a form

I've looked for this, but the answer found here ends up on a list containing the value. I'm wondering if there isn't another, more straightforward way to do what I need.
I have a form:
formReview :: UserId -> Form Review
formReview uid = renderDivs $ Review <$>
areq textField "Text" Nothing <*>
areq intField "Rating" Nothing <*>
areq (selectField films) "Film" Nothing <*>
pure uid
as you can see I'm trying to pass an user ID to the form, because these are the fields for Review:
Review
text Text
rating Int
film FilmId
author UserId
it requires the ID of the author.
The way I'm trying to do this is by doing the following on postReviewsR:
postReviewsR :: Handler Html
postReviewsR = do
uid <- lookupSession "_ID"
case uid of
Nothing -> do
defaultLayout [whamlet| <h1> User isn't logged in.|]
Just uid ->
((result, _), _) <- runFormPost $ formReview uid
case result of
FormSuccess review -> do
runDB $ insert review
defaultLayout [whamlet|
<h1> Review posted.
|]
_ -> redirect ReviewsR
it has to be a Maybe because in theory you could try to post something without being logged in, so uid could be empty. If I try to go straight to ((result, _), _) <- runFormPost $ formReview uid it says there's a Maybe Text.
Now my problem is similar the other post, it's this error:
• Couldn't match type ‘Text’ with ‘Key User’
Expected type: UserId
Actual type: Text
• In the first argument of ‘formReview’, namely ‘uid’
In the second argument of ‘($)’, namely ‘formReview uid’
In a stmt of a 'do' block:
((result, _), _) <- runFormPost $ formReview uid
and the suggestion in the linked post is to use keyToValues :: Key record -> [PersistValue] to turn the Key, which apparently is just Text, into what I need, the UserId.
It seems too clunky to me that I would need to do all this, then use head on that list to get the value within, all to get the ID into the form. There has to be another, more correct way, right? What am I missing here? How do I get the ID of the user who's making the Review in there?
EDIT: I should point out that I'm not using Yesod.Auth so I can't use its functions.
Assuming you're using a SQL backend, check out the persistent SQL documentation. You'll find the toSqlKey :: ToBackendKey SqlBackend record => Int64 -> Key record function. Basically, you'll need to parse your Text to Int64 and get a key using toSqlKey. You should probably also check if the key you're getting is actually valid.
(You've apparently misread the error, your uid is just a Text value, but you need a UserID which is a Key User).

How do I process a parameterized Yesod form from a handler where the parameter is unavailable?

I have the following form:
userForm :: UserId -> Form UserDemographics
userForm uid = renderDivs $ UserDemographics <$>
pure uid <*>
areq yearField "Year of birth" Nothing <*>
areq textField "Gender" Nothing <*>
areq countryField "Country of residence" Nothing <*>
areq boolField "Are you a computer programmer?" Nothing
On my homepage, I use generateFormPost $ userForm (entityKey userEnt) to make a form with the UserId filled in. But I want to handle the input with AJAX, so a separate Handler gets the results of the form. The other handler doesn't have access to the UserId. How do I process the form? I tried this, which throws an error:
postDemoFormR :: Handler RepJson
postDemoFormR = do
((formData, _), _) <- runFormPost $ userForm undefined
$(logDebug) $ pack $ show formData
return $ repJson ()
I could change userForm's type to accept Maybe UserId instead of just UserId or make up a bogus UserId for the call to runFormPost but both of those are hacks. Is there an easy, clean way to do this?
You could use a hiddenField, but that's almost certainly not what you really want (any user would be able to spoof the UserId by just submitting a different value). Assuming what you're trying to do is actually say "who is the current user", you'd need some way of securely determining that in your AJAX handler (such as requireAuthId).

How to use yesod per-request caching?

I'm trying to use the cached function to prevent multiple db queries in different widgets and handlers:
newtype CachedBobId key
= CachedBobId { unCachedBobId :: key }
deriving Typeable
getBob' :: Handler BobId
getBob' = do
uncle <- runInputGet $ ireq textField "bobsuncle"
(Entity bob _) <- runDB $ getBy404 $ UniqueBob uncle
return bob
getBob :: Handler BobId
getBob = do
a <- getBob'
let b = return $ CachedBobId a
c <- cached b
return $ unCachedBobId c
And in a widget somewhere:
renderDerp :: Widget
renderDerp = do
--these are used in the shakespeare files
lolBob <- handlerToWidget $ getBob
nutherBob <- handlerToWidget $ getBob
$(widgetFile "test")
This compiles but the query to get the ID still runs multiple times.
What am I doing wrong? Or is there a better way to only get bob once and use him in every handler and widget?
I'm pretty new to Yesod, but I think you just need to tweak getBob
getBob :: Handler BobId
getBob = unCachedBobId <$> cached (CachedBobId <$> getBob')
The problem is that your current getBob function starts its do block with a <- getBob'. Remember that a do block sequences monadic actions, so you actually end up calling getBob' first thing every time getBob is called. In an ironic twist, after you've done this, you create a cached version of a handler which returns what you just got from getBob', but end up querying that cached version exactly once (right afterwards with c <- cached b), then it just falls out of scope and the garbage collector gets it.
In the solution I present above, you wrap whatever getBob' gives you in CachedBobId. Then, you pass that handler CachedBobId <$> getBob' :: Handler (CachedBobId BobId), to cached, which gives you back another handler cached (CachedBobId <$> getBob') of the same type, but with caching. Finally, you extract whatever the cached handler gives you to get back a Handler BobId.

Capturing Persistent Relations in a Form

I have defined a one-to-many relationship in Persistent but could not figure out how to create a form that can take one of the foreign keys as input. Simplifying my use case to something like this:
Person
name String
Car
personId PersonId
name Text
type Text
Now when I try to generate a Form for Car, what should be the field type for personId? I tried something like this but get an error:
entryForm :: Maybe Car -> Form Car
entryForm car = renderDivs $ Car
<$> areq personIdField "Person" Nothing
<*> areq textField "Car Name" ( carName <$> car)
<*> areq textField "Type" ( carType <$> car)
When I run the above I get the error: Not in scope: `personIdField'.
I tried intField and it says:
Couldn't match expected type `KeyBackend
persistent-1.2.1:Database.Persist.Sql.Types.SqlBackend Person'
with actual type `Text'
Expected type: Field
m0
(KeyBackend
persistent-1.2.1:Database.Persist.Sql.Types.SqlBackend Person)
Actual type: Field m0 Text
In the first argument of `areq', namely `intField'
In the second argument of `(<$>)', namely
`areq intField "Person" Nothing
Ideally I would like to populate a drop down of Person Names (if there are not too many) or have a free form text field (e.g., with autocomplete) when there are too many. Any suggestions on how I can get foreign key as an input from the user?
Update:
I tried using selectField as follows but not sure if I am doing this correctly. I still get an error. First I created a where statement to get personId:
where
personId = do
person <- runDB $ selectFirst [] [Asc PersonName]
case person of
Just (Entity pId p) -> return pId
-- Nothing -> ???
and then I changed my first areq to
<$> areq (selectField [("First", personId)]) "Person Name" Nothing
Thanks!
I was able to figure out how to use selectField properly. This is what I ended up doing:
where
people = do
entities <- runDB $ selectList [] [Asc PersonName]
optionsPairs $ map (\p -> (personName $ entityVal p, entityKey p)) entities
The form field became:
<$> areq (selectField people) "Person Name" Nothing
I still have not figured out free form entry just yet but this is a good start.

Resources