Skip to content

Commit

Permalink
Allow empty select field for enums to force user selection (#1821)
Browse files Browse the repository at this point in the history
* Set select field for enums to empty when isNew

* Add type classes to allow use didChange

* Check using paramList

* Add comments

* Fix import

* More comment

* Simplify and adapt radio field

* Use isEmpty

* Create new field

* Apply suggestions from code review

* Fix errors

* Add docs

* Use didTouch approach

* Simplify logic

* Add comment

* Update Guide/form.markdown

* Update IHP/ModelSupport.hs

* Use symbolToText

---------

Co-authored-by: Marc Scholten <marc@digitallyinduced.com>
  • Loading branch information
amitaibu and mpscholten authored Nov 5, 2023
1 parent d671818 commit dac48f2
Showing 3 changed files with 54 additions and 35 deletions.
13 changes: 13 additions & 0 deletions Guide/form.markdown
Original file line number Diff line number Diff line change
@@ -666,6 +666,19 @@ formFor subscription [hsx|
allContentTypes = allEnumValues @ContentType
```

### Set Default Value for Custom Enums

When creating a new record, by default the field value will be empty. If you'd like to set a default enum, you can set it from the controller.

Note that by default the `newRecord` populates the first enum on the record. However, when showing the form, IHP will check if the field was not explicitly set, and if so, will not render the default value.

```haskell
action NewPostAction = do
let post = newRecord
let postWithDefault = newRecord |> set #postType Article
render NewView { .. }
```

### Select Inputs with Integers

It's a common use case to have a select field consisting of ints, e.g. inside a shopping cart to select the quantity of an item.
28 changes: 22 additions & 6 deletions IHP/ModelSupport.hs
Original file line number Diff line number Diff line change
@@ -781,13 +781,8 @@ didChangeRecord record = isEmpty record.meta.touchedFields
--
-- > when (user |> didChange #profilePictureUrl) (setSuccessMessage "Your Profile Picture has been updated. It might take a few minutes until it shows up everywhere")
didChange :: forall fieldName fieldValue record. (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag, Eq fieldValue, Typeable record) => Proxy fieldName -> record -> Bool
didChange field record = didTouchField && didChangeField
didChange field record = didTouchField field record && didChangeField
where
didTouchField :: Bool
didTouchField =
record.meta.touchedFields
|> includes (cs $! symbolVal field)

didChangeField :: Bool
didChangeField = originalFieldValue /= fieldValue

@@ -802,6 +797,27 @@ didChange field record = didTouchField && didChangeField
|> fromMaybe (error "didChange failed to retrieve originalDatabaseRecord")
|> getField @fieldName

-- | Returns 'True' if 'set' was called on that field
--
-- __Example:__ Returns 'False' for freshly fetched records
--
-- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
-- >>> project <- fetch projectId
-- >>> didTouchField #name project
-- False
--
-- __Example:__ Returns 'True' after setting a field
--
-- >>> let projectId = "227fbba3-0578-4eb8-807d-b9b692c3644f" :: Id Project
-- >>> project <- fetch projectId
-- >>> project |> set #name project.name |> didTouchField #name
-- True
--
didTouchField :: forall fieldName fieldValue record. (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag, Eq fieldValue, Typeable record) => Proxy fieldName -> record -> Bool
didTouchField field record =
record.meta.touchedFields
|> includes (symbolToText @fieldName)

-- | Represents fields that have a default value in an SQL schema
--
-- The 'Default' constructor represents the default value from the schema,
48 changes: 19 additions & 29 deletions IHP/View/Form.hs
Original file line number Diff line number Diff line change
@@ -19,7 +19,7 @@ import IHP.ViewSupport
import qualified Text.Blaze.Html5 as Html5
import IHP.HSX.ToHtml
import GHC.Types
import IHP.ModelSupport (getModelName, inputValue, isNew, Id', InputValue)
import IHP.ModelSupport (getModelName, inputValue, isNew, Id', InputValue, didTouchField)
import IHP.HSX.QQ (hsx)
import IHP.View.Types
import IHP.View.Classes ()
@@ -728,6 +728,8 @@ selectField :: forall fieldName model item.
, KnownSymbol (GetModelName model)
, CanSelect item
, InputValue (SelectValue item)
, Typeable model
, Eq (SelectValue item)
) => Proxy fieldName -> [item] -> FormField
selectField field items = FormField
{ fieldType =
@@ -738,7 +740,12 @@ selectField field items = FormField
SelectInput (map itemToTuple items)
, fieldName = cs fieldName
, fieldLabel = removeIdSuffix $ fieldNameToFieldLabel (cs fieldName)
, fieldValue = inputValue ((getField @fieldName model :: SelectValue item))
-- If the field is not touched, we don't want to render the value from the model
-- so we force the user to select. If a value was explicitely set in the model, we
-- render that value.
, fieldValue = if IHP.ModelSupport.didTouchField field model
then inputValue (getField @fieldName model :: SelectValue item)
else ""
, fieldInputId = cs (lcfirst (getModelName @model) <> "_" <> cs fieldName)
, validatorResult = getValidationViolation field model
, fieldClass = ""
@@ -808,35 +815,18 @@ radioField :: forall fieldName model item.
, KnownSymbol (GetModelName model)
, CanSelect item
, InputValue (SelectValue item)
, Typeable model
, Eq (SelectValue item)
) => Proxy fieldName -> [item] -> FormField
radioField field items = FormField
{ fieldType =
let
itemToTuple :: item -> (Text, Text)
itemToTuple item = (selectLabel item, inputValue (selectValue item))
in
RadioInput (map itemToTuple items)
, fieldName = cs fieldName
, fieldLabel = removeIdSuffix $ fieldNameToFieldLabel (cs fieldName)
, fieldValue = inputValue ((getField @fieldName model :: SelectValue item))
, fieldInputId = cs (lcfirst (getModelName @model) <> "_" <> cs fieldName)
, validatorResult = getValidationViolation field model
, fieldClass = ""
, labelClass = ""
, disabled = False
, disableLabel = False
, disableGroup = False
, disableValidationResult = False
, additionalAttributes = []
, cssFramework = ?formContext.cssFramework
, helpText = ""
, placeholder = ""
, required = False
, autofocus = False
radioField field items = (selectField field items)
{ fieldType =
let
itemToTuple :: item -> (Text, Text)
itemToTuple item = (selectLabel item, inputValue (selectValue item))
in
RadioInput (map itemToTuple items)
, placeholder = ""
}
where
fieldName = symbolVal field
FormContext { model } = ?formContext
{-# INLINE radioField #-}

class CanSelect model where

0 comments on commit dac48f2

Please sign in to comment.