/src/Parameters/App.elm at 9c021e6e81fc8b90fa3a63fb31e3ce77b3a092cb

-- 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.App exposing (Model, Msg, init, update, view)

import Dict exposing (Dict)
import Html exposing (hr, input, label, node, p, span, text)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput)
import Html.LivingStandard exposing (..)
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)



-- MODEL


type alias Fields =
    Dict String String


type alias Errors =
    Dict String Error


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


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.rendering.margin) )
                , ( Key.toString LineWidth, String.fromFloat (toMM params.rendering.lineWidth) )
                ]
    in
    { fields = fields
    , errors =
        case parse fields of
            Ok _ ->
                Dict.empty

            Err errors ->
                errors
    , parameters = params
    }



-- UPDATE


type Msg
    = FieldChanged Key String


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.Rendering
parseCanvas fields =
    case
        ( parseField CanvasMargin (parseLength constraints.rendering.margin) fields
        , parseField LineWidth (parseLength constraints.rendering.lineWidth) fields
        )
    of
        ( Ok margin, Ok lineWidth ) ->
            let
                base =
                    Parameters.default.rendering
            in
            Ok { base | margin = margin, lineWidth = lineWidth }

        ( margin, lineWidth ) ->
            Err
                (mkErrors
                    [ ( CanvasMargin, getError margin )
                    , ( LineWidth, getError lineWidth )
                    ]
                )


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

        ( lugWidth, longPiece, rendering ) ->
            [ mkErrors [ ( LugWidth, getError lugWidth ) ]
            , getError longPiece |> Maybe.withDefault Dict.empty
            , getError rendering |> 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
        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
                        , parameters = newParams
                      }
                    , Cmd.none
                    )

                Err errors ->
                    ( { model | fields = fields, errors = errors }, 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"


type alias FieldProps msg =
    { key : Key
    , title : List (Html.Html msg)
    , description : List (Html.Html msg)
    , unit : Maybe String
    , attrs : List (Html.Attribute msg)
    }


field : Model -> FieldProps Msg -> Html.Html Msg
field model { key, title, description, attrs, unit } =
    node "x-field"
        []
        [ label [ for (Key.toString key), slot "title" ] title
        , p
            [ id (descriptionId key), slot "description" ]
            description
        , node "x-number-input"
            []
            [ input
                (id (Key.toString key)
                    :: value (model.fields |> Dict.get (Key.toString key) |> Maybe.withDefault "")
                    :: onInput (FieldChanged key)
                    :: ariaInvalid (not (Dict.get (Key.toString key) model.errors == Nothing))
                    :: ariaDescribedBy [ errorId key, descriptionId key ]
                    :: attrs
                )
                []
            , case unit of
                Just u ->
                    span [ slot "unit" ] [ text u ]

                Nothing ->
                    text ""
            ]
        , p
            [ id (errorId key), slot "error" ]
            (Dict.get (Key.toString key) model.errors
                |> Maybe.map errorText
                |> Maybe.withDefault []
            )
        ]


type alias GroupProps msg =
    { title : List (Html.Html msg)
    , description : Maybe (List (Html.Html msg))
    }


group : GroupProps Msg -> List (Html.Html Msg) -> Html.Html Msg
group { title, description } children =
    node "x-field-group"
        []
        (p [ slot "title" ] title
            :: (description |> Maybe.map (p [ slot "description" ]) |> Maybe.withDefault (text ""))
            :: children
        )


view : Model -> List (Html.Html Msg)
view model =
    [ group
        { title = [ text "General" ], description = Nothing }
        [ field model
            { key = LugWidth
            , title = [ text "Lug width" ]
            , 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."
                ]
            , unit = Just "mm"
            , attrs = step "1.0" :: lengthFieldAttrs constraints.lugWidth
            }
        ]
    , hr [] []
    , group
        { title = [ text "Buckle / Clasp" ], description = Nothing }
        [ field model
            { key = BuckleHoleCount
            , title = [ text "Hole Count" ]
            , description = [ text "Set 0 to disable buckle holes generation." ]
            , unit = Nothing
            , attrs = step "1" :: intFieldAttrs constraints.longPiece.buckleHole.count
            }
        , field model
            { key = BuckleHoleDiameter
            , title = [ text "Hole Diameter" ]
            , description =
                [ text "Diameter of buckle holes. You can leave the default value if you're going to use the center mark." ]
            , unit = Just "mm"
            , attrs =
                step "1.0"
                    :: disabled (model.parameters.longPiece.buckleHole.count == 0)
                    :: lengthFieldAttrs constraints.longPiece.buckleHole.diameter
            }
        ]
    , hr [] []
    , group
        { title = [ text "Rendering" ], description = Nothing }
        [ field model
            { key = CanvasMargin
            , title = [ text "Print Margin" ]
            , description =
                [ text "Lower values can cause printing problems depending on your printer." ]
            , unit = Just "mm"
            , attrs = step "1.0" :: lengthFieldAttrs constraints.rendering.margin
            }
        , field model
            { key = LineWidth
            , title = [ text "Line Width" ]
            , description =
                [ text "Stroke width (thickness) of the cutting lines and seam lines." ]
            , unit = Just "mm"
            , attrs = step "0.1" :: lengthFieldAttrs constraints.rendering.lineWidth
            }
        ]
    ]