/src/Parameters/Form.elm at 3ed7e6712154b6379e7ecd15db46bdfdeabecce6

-- Copyright 2026 Shota FUJI
--
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at https://mozilla.org/MPL/2.0/.
--
-- SPDX-License-Identifier: MPL-2.0


module Parameters.Form exposing (Model, Msg(..), init, update, view)

import Dict exposing (Dict)
import Html exposing (div, input, label, node, p, span, text)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Length exposing (Length, toMM)
import Parameters exposing (Parameters)
import Parameters.Constraints exposing (NumberConstraints, constraints)
import Parameters.Key as Key exposing (Key(..))
import Parameters.Parser exposing (Error(..), parseInt, parseLength)
import Task



-- MODEL


type alias Fields =
    Dict String String


type alias Errors =
    Dict String Error


type alias Model =
    { fields : Fields
    , errors : Errors
    }


init : Parameters -> Model
init params =
    let
        fields =
            Dict.fromList
                [ ( Key.toString LugWidth, String.fromFloat (toMM params.lugWidth) )
                , ( Key.toString BuckleHoleCount, String.fromInt params.longPiece.buckleHole.count )
                , ( Key.toString BuckleHoleDiameter, String.fromFloat (toMM params.longPiece.buckleHole.diameter) )
                , ( Key.toString CanvasMargin, String.fromFloat (toMM params.canvas.margin) )
                ]
    in
    { fields = fields
    , errors =
        case parse fields of
            Ok _ ->
                Dict.empty

            Err errors ->
                errors
    }



-- UPDATE


type InternalMsg
    = FieldChanged Key String


type Msg
    = Internal InternalMsg
    | ParametersChangeRequested Parameters


parseField : Key -> (String -> Result Error a) -> Fields -> Result Error a
parseField key f fields =
    Dict.get (Key.toString key) fields
        |> Maybe.withDefault ""
        |> f


mkErrors : List ( Key, Maybe Error ) -> Errors
mkErrors list =
    list
        |> List.filterMap (\( key, error ) -> Maybe.map (\e -> ( Key.toString key, e )) error)
        |> Dict.fromList


getError : Result a b -> Maybe a
getError r =
    case r of
        Err e ->
            Just e

        _ ->
            Nothing


parseBuckleHole : Fields -> Result Errors Parameters.BuckleHole
parseBuckleHole fields =
    case
        ( parseField BuckleHoleCount (parseInt constraints.longPiece.buckleHole.count) fields
        , parseField BuckleHoleDiameter (parseLength constraints.longPiece.buckleHole.diameter) fields
        )
    of
        ( Ok count, Ok diameter ) ->
            let
                base =
                    Parameters.default.longPiece.buckleHole
            in
            Ok { base | count = count, diameter = diameter }

        ( count, diameter ) ->
            Err
                (mkErrors
                    [ ( BuckleHoleCount, getError count )
                    , ( BuckleHoleDiameter, getError diameter )
                    ]
                )


parseLongPiece : Fields -> Result Errors Parameters.LongPiece
parseLongPiece fields =
    case parseBuckleHole fields of
        Ok buckleHole ->
            let
                base =
                    Parameters.default.longPiece
            in
            Ok { base | buckleHole = buckleHole }

        Err errors ->
            Err errors


parseCanvas : Fields -> Result Errors Parameters.Canvas
parseCanvas fields =
    case parseField CanvasMargin (parseLength constraints.canvas.margin) fields of
        Ok margin ->
            let
                base =
                    Parameters.default.canvas
            in
            Ok { base | margin = margin }

        Err err ->
            Err (mkErrors [ ( CanvasMargin, Just err ) ])


parse : Fields -> Result Errors Parameters
parse fields =
    case
        ( parseField LugWidth (parseLength constraints.lugWidth) fields
        , parseLongPiece fields
        , parseCanvas fields
        )
    of
        ( Ok lugWidth, Ok longPiece, Ok canvas ) ->
            let
                base =
                    Parameters.default
            in
            Ok { base | lugWidth = lugWidth, longPiece = longPiece, canvas = canvas }

        ( lugWidth, longPiece, canvas ) ->
            [ mkErrors [ ( LugWidth, getError lugWidth ) ]
            , getError longPiece |> Maybe.withDefault Dict.empty
            , getError canvas |> Maybe.withDefault Dict.empty
            ]
                |> List.map Dict.toList
                |> List.concat
                |> Dict.fromList
                |> Err


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        Internal (FieldChanged key value) ->
            let
                fields =
                    Dict.insert (Key.toString key) value model.fields
            in
            case parse fields of
                Ok newParams ->
                    ( { model | fields = fields, errors = Dict.empty }
                    , Task.perform identity (Task.succeed (ParametersChangeRequested newParams))
                    )

                Err errors ->
                    ( { model | fields = fields, errors = errors }, Cmd.none )

        ParametersChangeRequested _ ->
            ( model, Cmd.none )



-- VIEW


lengthFieldAttrs : NumberConstraints Length -> List (Html.Attribute msg)
lengthFieldAttrs { min, max } =
    [ case min of
        Just x ->
            toMM x
                |> String.fromFloat
                |> Html.Attributes.min

        Nothing ->
            class ""
    , case max of
        Just x ->
            toMM x
                |> String.fromFloat
                |> Html.Attributes.max

        Nothing ->
            class ""
    , attribute "inputmode" "numeric"
    , required True
    ]


intFieldAttrs : NumberConstraints Int -> List (Html.Attribute msg)
intFieldAttrs { min, max } =
    [ case min of
        Just x ->
            Html.Attributes.min (String.fromInt x)

        Nothing ->
            class ""
    , case max of
        Just x ->
            Html.Attributes.max (String.fromInt x)

        Nothing ->
            class ""
    , attribute "inputmode" "numeric"
    , required True
    ]


ariaInvalid : Bool -> Html.Attribute msg
ariaInvalid invalid =
    attribute "aria-invalid"
        (if invalid then
            "true"

         else
            "false"
        )


ariaDescribedBy : List String -> Html.Attribute msg
ariaDescribedBy ids =
    case ids of
        [] ->
            class ""

        _ ->
            ids
                |> String.join " "
                |> attribute "aria-describedby"


errorId : Key -> String
errorId key =
    Key.toString key ++ "_error"


errorText : Error -> List (Html.Html msg)
errorText e =
    case e of
        MissingValue ->
            [ text "This field is required." ]

        BelowMin n ->
            [ text ("Value must be greater than or equals to " ++ String.fromFloat n ++ ".") ]

        AboveMax n ->
            [ text ("Value must be less than or equals to " ++ String.fromFloat n ++ ".") ]

        NotALength ->
            [ text "Invalid length value. Set an integer or a floating point number." ]

        NotAnInt ->
            [ text "Invalid integer value. This field only accepts integer value." ]


descriptionId : Key -> String
descriptionId key =
    Key.toString key ++ "_description"


view : Model -> Parameters -> List (Html.Attribute InternalMsg) -> Html.Html Msg
view model params attrs =
    let
        value : Key -> Html.Attribute InternalMsg
        value key =
            model.fields
                |> Dict.get (Key.toString key)
                |> Maybe.withDefault ""
                |> Html.Attributes.value
    in
    div attrs
        [ node "x-field"
            []
            [ label [ for (Key.toString LugWidth), attribute "slot" "title" ] [ text "Lug width" ]
            , p
                [ id (descriptionId LugWidth), attribute "slot" "description" ]
                [ text "This will be the final width of your strap. "
                , text "You can use a size smaller than your lug width to create a play."
                ]
            , node "x-number-input"
                []
                [ input
                    (id (Key.toString LugWidth)
                        :: step "1.0"
                        :: value LugWidth
                        :: onInput (FieldChanged LugWidth)
                        :: ariaInvalid (not (Dict.get (Key.toString LugWidth) model.errors == Nothing))
                        :: ariaDescribedBy [ errorId LugWidth, descriptionId LugWidth ]
                        :: lengthFieldAttrs constraints.lugWidth
                    )
                    []
                , span [ attribute "slot" "unit" ] [ text "mm" ]
                ]
            , p
                [ id (errorId LugWidth), attribute "slot" "error" ]
                (Dict.get (Key.toString LugWidth) model.errors
                    |> Maybe.map errorText
                    |> Maybe.withDefault []
                )
            ]
        , node "x-field"
            []
            [ label [ for (Key.toString BuckleHoleCount), attribute "slot" "title" ] [ text "Hole Count" ]
            , p
                [ id (descriptionId BuckleHoleCount), attribute "slot" "description" ]
                [ text "Set 0 to disable buckle holes generation." ]
            , node "x-number-input"
                []
                [ input
                    (id (Key.toString BuckleHoleCount)
                        :: step "1"
                        :: value BuckleHoleCount
                        :: onInput (FieldChanged BuckleHoleCount)
                        :: ariaInvalid (not (Dict.get (Key.toString BuckleHoleCount) model.errors == Nothing))
                        :: ariaDescribedBy [ errorId BuckleHoleCount, descriptionId BuckleHoleCount ]
                        :: intFieldAttrs constraints.longPiece.buckleHole.count
                    )
                    []
                ]
            , p
                [ id (errorId BuckleHoleCount), attribute "slot" "error" ]
                (Dict.get (Key.toString BuckleHoleCount) model.errors
                    |> Maybe.map errorText
                    |> Maybe.withDefault []
                )
            ]
        , node "x-field"
            []
            [ label [ for (Key.toString BuckleHoleDiameter), attribute "slot" "title" ] [ text "Hole Diameter" ]
            , p
                [ id (descriptionId BuckleHoleDiameter), attribute "slot" "description" ]
                [ text "Diameter of buckle holes. You can leave the default value if you're going to use the center mark." ]
            , node "x-number-input"
                []
                [ input
                    (id (Key.toString BuckleHoleDiameter)
                        :: step "1.0"
                        :: value BuckleHoleDiameter
                        :: onInput (FieldChanged BuckleHoleDiameter)
                        :: disabled (params.longPiece.buckleHole.count == 0)
                        :: ariaInvalid (not (Dict.get (Key.toString BuckleHoleDiameter) model.errors == Nothing))
                        :: ariaDescribedBy [ errorId BuckleHoleDiameter, descriptionId BuckleHoleDiameter ]
                        :: lengthFieldAttrs constraints.longPiece.buckleHole.diameter
                    )
                    []
                , span [ attribute "slot" "unit" ] [ text "mm" ]
                ]
            , p
                [ id (errorId BuckleHoleDiameter), attribute "slot" "error" ]
                (Dict.get (Key.toString BuckleHoleDiameter) model.errors
                    |> Maybe.map errorText
                    |> Maybe.withDefault []
                )
            ]
        , node "x-field"
            []
            [ label [ for (Key.toString CanvasMargin), attribute "slot" "title" ] [ text "Print Margin" ]
            , p
                [ id (descriptionId CanvasMargin), attribute "slot" "description" ]
                [ text "Lower values can cause printing problems depending on your printer." ]
            , node "x-number-input"
                []
                [ input
                    (id (Key.toString CanvasMargin)
                        :: step "1.0"
                        :: value CanvasMargin
                        :: onInput (FieldChanged CanvasMargin)
                        :: ariaInvalid (not (Dict.get (Key.toString CanvasMargin) model.errors == Nothing))
                        :: ariaDescribedBy [ errorId CanvasMargin, descriptionId CanvasMargin ]
                        :: lengthFieldAttrs constraints.canvas.margin
                    )
                    []
                , span [ attribute "slot" "unit" ] [ text "mm" ]
                ]
            , p
                [ id (errorId CanvasMargin), attribute "slot" "error" ]
                (Dict.get (Key.toString CanvasMargin) model.errors
                    |> Maybe.map errorText
                    |> Maybe.withDefault []
                )
            ]
        ]
        |> Html.map Internal