| -- Copyright 2020 The Fuchsia Authors. All rights reserved. |
| -- Use of this source code is governed by a BSD-style license that can be |
| -- found in the LICENSE file. |
| |
| |
| module Form exposing |
| ( Button |
| , Form |
| , Identifier |
| , Model |
| , Msg |
| , checkbox |
| , decode |
| , define |
| , empty |
| , encode |
| , encodeEffective |
| , getStringValue |
| , groupedSelect |
| , insertStringValue |
| , number |
| , select |
| , text |
| , update |
| , view |
| ) |
| |
| {-| This module provides abstractions for forms. |
| |
| There are three main types: |
| |
| - Input: Declarative representation of an HTML form input. |
| - Model: Concrete assignment of values to each form input. |
| - Form: List of Inputs together with a default Model. |
| |
| The rendered form looks like this: |
| |
| <form class="form"> |
| <div class="form-control"> |
| <label> |
| The label: |
| <input ... > |
| </label> |
| ... |
| </div> |
| ... |
| </form> |
| |
| There are five kind of inputs: |
| |
| - Checkbox: |
| <input type="checkbox" class="form-checkbox"> |
| - Text: |
| <input type="text" class="form-text"> |
| - Number: |
| <input type="number" class="form-number"> |
| - Select: |
| <select class="form-select"><option class="form-option"> ... </select> |
| |
| Forms can also have buttons at the end: |
| |
| <button class="form-button"> ... </button> |
| |
| -} |
| |
| import Dict exposing (Dict) |
| import Html exposing (Html) |
| import Html.Attributes as Attributes |
| import Html.Events as Events |
| import Json.Decode as Decode |
| import Json.Encode as Encode |
| |
| |
| |
| ------------- INPUT ------------------------------------------------------------ |
| |
| |
| type alias Input = |
| { id : Identifier |
| , label : String |
| , control : Control |
| } |
| |
| |
| type alias Identifier = |
| String |
| |
| |
| type Control |
| = Checkbox |
| | Text |
| | Number (Int -> Bool) |
| | Select OptionList |
| |
| |
| type OptionList |
| = Flat (List Option) |
| | Grouped (List ( String, List Option )) |
| |
| |
| type alias Option = |
| { id : Identifier |
| , label : String |
| } |
| |
| |
| |
| ------------- MODEL ------------------------------------------------------------ |
| |
| |
| type alias Model = |
| Dict Identifier Value |
| |
| |
| type Value |
| = BoolValue Bool |
| | StringValue String |
| | ParsedIntValue ParsedInt |
| |
| |
| type alias ParsedInt = |
| { -- The actual string input, possibly invalid. |
| string : String |
| |
| -- True if the string is a valid integer. |
| , valid : Bool |
| |
| -- The parsed string (if valid), or the most recent valid input otherwise. |
| , int : Int |
| } |
| |
| |
| init : List ( Identifier, Value ) -> Model |
| init entries = |
| Dict.fromList entries |
| |
| |
| {-| Form models should usually start out empty. This means the default values |
| will be used, and nothing will be stored in local storage until the user |
| explicitly makes choices. |
| -} |
| empty : Model |
| empty = |
| Dict.empty |
| |
| |
| insertStringValue : Identifier -> String -> Model -> Model |
| insertStringValue id string model = |
| Dict.insert id (StringValue string) model |
| |
| |
| effective : |
| (Identifier -> Model -> Maybe a) |
| -> a |
| -> Form |
| -> Identifier |
| -> Model |
| -> a |
| effective get fallbackValue form id model = |
| case get id model of |
| Just value -> |
| value |
| |
| Nothing -> |
| case get id form.default of |
| Just value -> |
| value |
| |
| Nothing -> |
| fallbackValue |
| |
| |
| getBoolValue : Form -> Identifier -> Model -> Bool |
| getBoolValue = |
| let |
| get id model = |
| case Dict.get id model of |
| Just (BoolValue bool) -> |
| Just bool |
| |
| _ -> |
| Nothing |
| in |
| effective get False |
| |
| |
| getStringValue : Form -> Identifier -> Model -> String |
| getStringValue = |
| let |
| get id model = |
| case Dict.get id model of |
| Just (StringValue string) -> |
| Just string |
| |
| _ -> |
| Nothing |
| in |
| effective get "" |
| |
| |
| getParsedIntValue : Form -> Identifier -> Model -> ParsedInt |
| getParsedIntValue = |
| let |
| get id model = |
| case Dict.get id model of |
| Just (ParsedIntValue parsedInt) -> |
| Just parsedInt |
| |
| _ -> |
| Nothing |
| in |
| effective get { string = "", valid = False, int = 0 } |
| |
| |
| fromInt : Int -> ParsedInt |
| fromInt int = |
| { string = String.fromInt int, valid = True, int = int } |
| |
| |
| parseNewInt : (Int -> Bool) -> ParsedInt -> String -> ParsedInt |
| parseNewInt validate previous string = |
| let |
| invalid = |
| { string = string, valid = False, int = previous.int } |
| in |
| case String.toInt string of |
| Just int -> |
| if validate int then |
| fromInt int |
| |
| else |
| invalid |
| |
| Nothing -> |
| invalid |
| |
| |
| |
| ------------- DEFINITION ------------------------------------------------------- |
| |
| |
| type alias Form = |
| { inputs : List Input |
| , default : Model |
| } |
| |
| |
| type alias Entry = |
| { input : Input |
| , default : Value |
| } |
| |
| |
| {-| Defines a form with default values. This is the main entry point of this |
| module. Example usage: |
| |
| define |
| [ text "productId" "Product ID" "" |
| , number "quantity" "Quantity" 1 |
| , checkbox "gift" "Gift" False |
| , select |
| "method" |
| "Method" |
| [ ( "slow", "Slow" ), ( "fast", "Fast" ) ] |
| "slow" |
| ] |
| |
| This creates a form with text, number, checkbox, and select inputs. Each helper |
| function takes an identifier and a user-facing label as its first two arguments. |
| The defaults in this case are an empty string, 1, False, and the "slow" option. |
| |
| -} |
| define : List Entry -> Form |
| define entries = |
| let |
| idAndDefault entry = |
| ( entry.input.id, entry.default ) |
| in |
| { inputs = List.map .input entries |
| , default = init (List.map idAndDefault entries) |
| } |
| |
| |
| checkbox : Identifier -> String -> Bool -> Entry |
| checkbox = |
| makeEntry Checkbox BoolValue |
| |
| |
| text : Identifier -> String -> String -> Entry |
| text = |
| makeEntry Text StringValue |
| |
| |
| number : Identifier -> String -> Int -> (Int -> Bool) -> Entry |
| number id label default validate = |
| makeEntry (Number validate) (ParsedIntValue << fromInt) id label default |
| |
| |
| makeEntry : Control -> (a -> Value) -> Identifier -> String -> a -> Entry |
| makeEntry control valueVariant id label default = |
| { input = |
| { id = id |
| , label = label |
| , control = control |
| } |
| , default = valueVariant default |
| } |
| |
| |
| select : |
| Identifier |
| -> String |
| -> List ( Identifier, String ) |
| -> Identifier |
| -> Entry |
| select id label options default = |
| let |
| convert ( optionId, optionLabel ) = |
| { id = optionId, label = optionLabel } |
| in |
| { input = |
| { id = id |
| , label = label |
| , control = Select (Flat (List.map convert options)) |
| } |
| , default = StringValue default |
| } |
| |
| |
| groupedSelect : |
| Identifier |
| -> String |
| -> List ( Identifier, List ( Identifier, String ) ) |
| -> Identifier |
| -> Entry |
| groupedSelect id label groupedOptions default = |
| let |
| convert ( optionId, optionLabel ) = |
| { id = optionId, label = optionLabel } |
| |
| convertGroup ( groupLabel, options ) = |
| ( groupLabel, List.map convert options ) |
| in |
| { input = |
| { id = id |
| , label = label |
| , control = Select (Grouped (List.map convertGroup groupedOptions)) |
| } |
| , default = StringValue default |
| } |
| |
| |
| |
| ------------- UPDATE ----------------------------------------------------------- |
| |
| |
| type Msg |
| = NoOp |
| | Update Identifier Value |
| |
| |
| update : Msg -> Model -> Model |
| update msg model = |
| case msg of |
| NoOp -> |
| model |
| |
| Update id value -> |
| Dict.insert id value model |
| |
| |
| |
| ------------- VIEW ------------------------------------------------------------- |
| |
| |
| type alias Button msg = |
| ( String, msg ) |
| |
| |
| {-| Renders the form. Example usage: |
| |
| type alias MyMsg = FormMsg Form.Msg | DoSomething |
| |
| view form [ ( "Do Something", DoSomething ) ] FormMsg model |
| |
| This renders a form with a button that performs DoSomething. There is no |
| onSubmit handler: instead, handle every field update immediately by intercepting |
| the Form.Update message. |
| |
| -} |
| view : Form -> List (Button msg) -> (Msg -> msg) -> Model -> Html msg |
| view form buttons toMsg model = |
| let |
| inputViews = |
| List.map (inputView toMsg form model) form.inputs |
| |
| buttonViews = |
| List.map buttonView buttons |
| |
| buttonPart = |
| case buttonViews of |
| [] -> |
| [] |
| |
| views -> |
| [ Html.div |
| [ Attributes.class "form-button-group" ] |
| views |
| ] |
| in |
| Html.form |
| [ Attributes.class "form" |
| |
| -- Use an explicit onSubmit just to get the preventDefault behavior, |
| -- stopping the browser from reloading with a query when you submit. |
| , Events.onSubmit (toMsg NoOp) |
| ] |
| (inputViews ++ buttonPart) |
| |
| |
| inputView : (Msg -> msg) -> Form -> Model -> Input -> Html msg |
| inputView toMsg form model input = |
| let |
| set variant value = |
| toMsg (Update input.id (variant value)) |
| |
| content = |
| case input.control of |
| Checkbox -> |
| let |
| checked = |
| getBoolValue form input.id model |
| in |
| [ Html.input |
| [ Attributes.type_ "checkbox" |
| , Attributes.checked checked |
| , Attributes.class "form-checkbox" |
| |
| -- Explicitly toggle the model value instead of using |
| -- the event parameter because of this bug: |
| -- https://github.com/elm/html/issues/188 |
| , Events.onCheck (\_ -> set BoolValue (not checked)) |
| ] |
| [] |
| ] |
| |
| Text -> |
| [ Html.input |
| [ Attributes.type_ "text" |
| , Attributes.value (getStringValue form input.id model) |
| , Attributes.class "form-text" |
| , Events.onInput (set StringValue) |
| ] |
| [] |
| ] |
| |
| Number validate -> |
| let |
| parsedInt = |
| getParsedIntValue form input.id model |
| |
| parse = |
| parseNewInt validate parsedInt |
| in |
| [ Html.input |
| [ Attributes.type_ "number" |
| , Attributes.value parsedInt.string |
| , Attributes.classList |
| [ ( "form-number", True ) |
| , ( "form-number--invalid", not parsedInt.valid ) |
| ] |
| , Events.onInput |
| (set (ParsedIntValue << parse)) |
| ] |
| [] |
| ] |
| |
| Select options -> |
| let |
| chosenId = |
| getStringValue form input.id model |
| |
| optionView option = |
| Html.option |
| [ Attributes.value option.id |
| , Attributes.selected (option.id == chosenId) |
| ] |
| [ Html.text option.label ] |
| |
| groupView ( groupLabel, groupOptions ) = |
| Html.optgroup |
| [ Attributes.attribute "label" groupLabel ] |
| (List.map optionView groupOptions) |
| in |
| [ Html.select |
| [ Attributes.class "form-select" |
| , Events.onInput (set StringValue) |
| ] |
| (case options of |
| Flat list -> |
| List.map optionView list |
| |
| Grouped groups -> |
| List.map groupView groups |
| ) |
| ] |
| in |
| Html.div |
| [ Attributes.class "form-control" ] |
| [ case input.control of |
| Checkbox -> |
| Html.label [] (content ++ [ Html.text input.label ]) |
| |
| _ -> |
| Html.label [] (Html.text input.label :: content) |
| ] |
| |
| |
| buttonView : Button msg -> Html msg |
| buttonView ( title, msg ) = |
| -- It's important to use <button type="button"> because the default button |
| -- type is "submit" and submitting the form runs that button's onclick |
| -- handler, which we don't want. |
| Html.button |
| [ Attributes.type_ "button" |
| , Attributes.class "button form-button" |
| , Events.custom "click" |
| (Decode.succeed |
| { message = msg |
| , stopPropagation = True |
| , preventDefault = True |
| } |
| ) |
| ] |
| [ Html.text title ] |
| |
| |
| |
| ------------- ENCODE / DECODE -------------------------------------------------- |
| |
| |
| {-| Encodes only the form values that have been explicitly set by the user. This |
| should be used for persisting values to the browser. |
| -} |
| encode : Model -> Encode.Value |
| encode model = |
| Encode.dict identity encodeValue model |
| |
| |
| {-| Encodes the effective values for the form. Unlike the encode function, this |
| includes default values for inputs that have not been explicitly set by the |
| user. This is useful for communicating to other parts of the system that need to |
| use the effective values. |
| -} |
| encodeEffective : Form -> Model -> Encode.Value |
| encodeEffective form model = |
| encode (Dict.union model form.default) |
| |
| |
| encodeValue : Value -> Encode.Value |
| encodeValue value = |
| case value of |
| BoolValue bool -> |
| Encode.bool bool |
| |
| StringValue string -> |
| Encode.string string |
| |
| ParsedIntValue parsedInt -> |
| Encode.int parsedInt.int |
| |
| |
| decode : Decode.Decoder Model |
| decode = |
| Decode.dict decodeValue |
| |
| |
| decodeValue : Decode.Decoder Value |
| decodeValue = |
| Decode.oneOf |
| [ Decode.map BoolValue Decode.bool |
| , Decode.map StringValue Decode.string |
| , Decode.map (ParsedIntValue << fromInt) Decode.int |
| , Decode.fail "Invalid value type" |
| ] |
