frontend/src/elm/Form.elm

-- 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
    , Definition
    , Form
    , Identifier
    , Model
    , Msg
    , checkbox
    , decode
    , define
    , encode
    , getStringValue
    , groupedSelect
    , insertStringValue
    , isEmpty
    , number
    , select
    , text
    , update
    , view
    )

{-| This module provides abstractions for forms.

There are three main types:

  - Form: Declarative representation of an HTML form as a list of inputs.
  - Model: Concrete assignment of values to each form input.
  - Definition: Combination of a Form and a (default) Model, for convenience.

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



------------- FORM -------------------------------------------------------------


type alias Form =
    List 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
    }


isEmpty : Form -> Bool
isEmpty =
    List.isEmpty



------------- 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


getBoolValue : Identifier -> Model -> Bool
getBoolValue id model =
    case Dict.get id model of
        Just (BoolValue bool) ->
            bool

        _ ->
            False


getStringValue : Identifier -> Model -> String
getStringValue id model =
    case Dict.get id model of
        Just (StringValue string) ->
            string

        _ ->
            ""


insertStringValue : Identifier -> String -> Model -> Model
insertStringValue id string model =
    Dict.insert id (StringValue string) model


getParsedIntValue : Identifier -> Model -> ParsedInt
getParsedIntValue id model =
    case Dict.get id model of
        Just (ParsedIntValue parsedInt) ->
            parsedInt

        _ ->
            { 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 Definition =
    { form : Form
    , 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 -> Definition
define entries =
    let
        idAndDefault entry =
            ( entry.input.id, entry.default )
    in
    { form = 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 model) form

        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) -> Model -> Input -> Html msg
inputView toMsg model input =
    let
        set variant value =
            toMsg (Update input.id (variant value))

        content =
            case input.control of
                Checkbox ->
                    let
                        checked =
                            getBoolValue 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 input.id model)
                        , Attributes.class "form-text"
                        , Events.onInput (set StringValue)
                        ]
                        []
                    ]

                Number validate ->
                    let
                        parsedInt =
                            getParsedIntValue 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 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 "form-button"
        , Events.custom "click"
            (Decode.succeed
                { message = msg
                , stopPropagation = True
                , preventDefault = True
                }
            )
        ]
        [ Html.text title ]



------------- ENCODE / DECODE --------------------------------------------------


encode : Model -> Encode.Value
encode model =
    Encode.dict identity encodeValue model


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"
        ]