/src/Parameters/App.elm at be469432db06f7e994e43876d0b2954c5b8d4368

-- 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 (ColorSchema(..), 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 SurfaceThickness, String.fromFloat (toMM params.thickness) )
                , ( Key.toString LiningThickness, String.fromFloat (toMM params.lining) )
                , ( 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
    | ColorSchemaChanged ColorSchema


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
          , parseField LiningThickness (parseLength constraints.lining) fields
          , parseField SurfaceThickness (parseLength constraints.thickness) fields
          )
        , parseLongPiece fields
        , parseCanvas fields
        )
    of
        ( ( Ok lugWidth, Ok lining, Ok thickness ), Ok longPiece, Ok rendering ) ->
            let
                base =
                    Parameters.default
            in
            Ok
                { base
                    | lugWidth = lugWidth
                    , lining = lining
                    , thickness = thickness
                    , longPiece = longPiece
                    , rendering = rendering
                }

        ( ( lugWidth, lining, thickness ), longPiece, rendering ) ->
            [ mkErrors [ ( LugWidth, getError lugWidth ) ]
            , mkErrors [ ( LiningThickness, getError lining ) ]
            , mkErrors [ ( SurfaceThickness, getError thickness ) ]
            , 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 )

        ColorSchemaChanged schema ->
            let
                { parameters } =
                    model

                { rendering } =
                    parameters
            in
            ( { model | parameters = { parameters | rendering = { rendering | colorSchema = schema } } }
            , 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 NumberFieldProps msg =
    { key : Key
    , title : List (Html.Html msg)
    , description : List (Html.Html msg)
    , unit : Maybe String
    , attrs : List (Html.Attribute msg)
    , disabled : Bool
    }


numberField : Model -> NumberFieldProps Msg -> Html.Html Msg
numberField model { key, title, description, attrs, unit, disabled } =
    node "x-field"
        [ if disabled then
            attribute "disabled" ""

          else
            class ""
        ]
        [ 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 ]
                    :: Html.Attributes.disabled disabled
                    :: 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 RadioBoxProps msg =
    { label : List (Html.Html msg)
    , description : List (Html.Html msg)
    , key : Key
    , value : String
    , checked : Bool
    , onCheck : msg
    }


radioBox : RadioBoxProps msg -> List (Html.Attribute msg) -> Html.Html msg
radioBox { label, description, key, value, checked, onCheck } attrs =
    let
        id =
            Key.toString key ++ "_" ++ value

        choiceDescriptionId =
            id ++ "__description"
    in
    node "x-radio-box"
        [ if checked then
            attribute "checked" ""

          else
            class ""
        ]
        [ Html.label [ for id, slot "label" ] label
        , Html.p [ Html.Attributes.id choiceDescriptionId, slot "description" ] description
        , input
            (type_ "radio"
                :: Html.Attributes.id id
                :: Html.Attributes.name (Key.toString key)
                :: Html.Attributes.value value
                :: Html.Attributes.checked checked
                :: Html.Events.onCheck (\_ -> onCheck)
                :: ariaDescribedBy [ choiceDescriptionId ]
                :: attrs
            )
            []
        ]


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 }
        [ numberField 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"
            , disabled = False
            , attrs = step "1.0" :: lengthFieldAttrs constraints.lugWidth
            }
        , numberField model
            { key = SurfaceThickness
            , title = [ text "Surface Leather Thickness" ]
            , description = [ text "Thickness of surface leather." ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "0.1" :: lengthFieldAttrs constraints.thickness
            }
        , numberField model
            { key = LiningThickness
            , title = [ text "Lining Leather Thickness" ]
            , description =
                [ text "Thickness of lining leather. Set to 0 to disable lining generation."
                ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "0.1" :: lengthFieldAttrs constraints.lining
            }
        ]
    , hr [] []
    , group
        { title = [ text "Buckle / Clasp" ], description = Nothing }
        [ numberField model
            { key = BuckleHoleCount
            , title = [ text "Hole Count" ]
            , description = [ text "Set 0 to disable buckle holes generation." ]
            , unit = Nothing
            , disabled = False
            , attrs = step "1" :: intFieldAttrs constraints.longPiece.buckleHole.count
            }
        , numberField 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"
            , disabled = model.parameters.longPiece.buckleHole.count == 0
            , attrs =
                step "1.0" :: lengthFieldAttrs constraints.longPiece.buckleHole.diameter
            }
        ]
    , hr [] []
    , group
        { title = [ text "Rendering" ], description = Nothing }
        [ numberField model
            { key = CanvasMargin
            , title = [ text "Print Margin" ]
            , description =
                [ text "Lower values can cause printing problems depending on your printer." ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "1.0" :: lengthFieldAttrs constraints.rendering.margin
            }
        , numberField model
            { key = LineWidth
            , title = [ text "Line Width" ]
            , description =
                [ text "Stroke width (thickness) of the cutting lines and seam lines." ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "0.1" :: lengthFieldAttrs constraints.rendering.lineWidth
            }
        , node "x-field"
            []
            [ label [ for (Key.toString ColorSchema), slot "title" ] [ text "Color Schema" ]
            , p
                [ id (descriptionId ColorSchema), slot "description" ]
                [ text "Color schema of the template." ]
            , radioBox
                { key = ColorSchema
                , label = [ text "Black on White" ]
                , description = [ text "Select this if you print the template with a regular printer." ]
                , value = "bow"
                , checked = model.parameters.rendering.colorSchema == BlackOnWhite
                , onCheck = ColorSchemaChanged BlackOnWhite
                }
                []
            , radioBox
                { key = ColorSchema
                , label = [ text "White on Black" ]
                , description = [ text "For digital output. Printing this with an inkjet printer is not a good idea." ]
                , value = "wob"
                , checked = model.parameters.rendering.colorSchema == WhiteOnBlack
                , onCheck = ColorSchemaChanged WhiteOnBlack
                }
                []
            ]
        ]
    ]