/src/Parameters/App.elm at 4cf091f1ad53b40eb0a2ef5df9f2c95d028ae5d5

-- 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 Browser.Navigation
import Dict
import Html exposing (hr, input, label, node, p, span, text)
import Html.Attributes exposing (..)
import Html.Events exposing (onBlur, onFocus, onInput)
import Html.LivingStandard exposing (..)
import Length exposing (Length, mm, toMM)
import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, colorSchemaToString, getKey, hasKey, loopStyleToString, profileKind)
import Parameters.Constraints exposing (NumberConstraints, constraints)
import Parameters.Key as Key exposing (Key(..))
import Parameters.Parser exposing (..)
import Platform.Cmd as Cmd
import Process
import Task
import Time
import Url exposing (Url)
import Url.SearchParams



-- MODEL


type UrlUpdate
    = Idle
    | Throttled Time.Posix
    | Scheduled


type alias Model =
    { fields : ParametersDict
    , errors : Errors
    , parameters : Parameters
    , highlighting : Maybe Key
    , navigation : Browser.Navigation.Key
    , baseUrl : Url
    , currentUrl : Url
    , urlUpdate : UrlUpdate
    }


init : Url -> Browser.Navigation.Key -> Parameters -> ( Model, Cmd Msg )
init baseUrl key params =
    let
        fields =
            Dict.union
                (Parameters.toDict params)
                Parameters.fallbackValues
    in
    ( { fields = fields
      , errors =
            case parse fields of
                Ok _ ->
                    Dict.empty

                Err errors ->
                    errors
      , parameters = params
      , highlighting = Nothing
      , navigation = key
      , baseUrl = baseUrl
      , currentUrl = baseUrl
      , urlUpdate = Idle
      }
    , Task.perform UrlRewriteRequested Time.now
    )



-- UPDATE


type Msg
    = FieldChanged Key String
    | FieldUnset Key
    | Highlight Key
    | Unhighlight Key
    | UrlRewriteTriggered
    | UrlRewriteRequested Time.Posix
    | RunThrottledUrlRewrite


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
                      }
                    , Task.perform UrlRewriteRequested Time.now
                    )

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

        FieldUnset key ->
            let
                fields =
                    Dict.remove (Key.toString key) model.fields
            in
            case parse fields of
                Ok newParams ->
                    ( { model
                        | fields = fields
                        , errors = Dict.empty
                        , parameters = newParams
                      }
                    , Task.perform UrlRewriteRequested Time.now
                    )

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

        Highlight key ->
            ( { model | highlighting = Just key }, Cmd.none )

        Unhighlight key ->
            if model.highlighting == Just key then
                ( { model | highlighting = Nothing }, Cmd.none )

            else
                ( model, Cmd.none )

        UrlRewriteRequested now ->
            let
                { baseUrl } =
                    model

                query =
                    model.parameters
                        |> Parameters.toDict
                        |> Url.SearchParams.build

                url =
                    { baseUrl | query = Just query }

                next =
                    { model | currentUrl = url }

                throttledUntil =
                    now
                        |> Time.posixToMillis
                        |> (+) 200
                        |> Time.millisToPosix
            in
            case model.urlUpdate of
                Idle ->
                    update UrlRewriteTriggered { next | urlUpdate = Throttled throttledUntil }

                Scheduled ->
                    ( next, Cmd.none )

                Throttled until ->
                    let
                        timeout =
                            Time.posixToMillis until - Time.posixToMillis now
                    in
                    if timeout <= 0 then
                        update UrlRewriteTriggered { next | urlUpdate = Throttled throttledUntil }

                    else
                        ( { next | urlUpdate = Scheduled }
                        , Task.perform (\_ -> RunThrottledUrlRewrite) (Process.sleep (toFloat timeout))
                        )

        RunThrottledUrlRewrite ->
            update UrlRewriteTriggered { model | urlUpdate = Idle }

        UrlRewriteTriggered ->
            ( model
            , Browser.Navigation.replaceUrl model.navigation (Url.toString model.currentUrl)
            )



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

        NotABool ->
            [ text "Invalid bool value. Value must be either \"true\" or \"false\"." ]

        NonexistentVariant str ->
            [ text ("\"" ++ str ++ "\" is not a valid choice. Did you modify program's source code?") ]

        UnsupportedParametersVersion str ->
            [ text ("Parameters version \"" ++ str ++ "\" is not supported.") ]


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 |> getKey key |> Maybe.withDefault "")
                    :: onInput (FieldChanged key)
                    :: onFocus (Highlight key)
                    :: onBlur (Unhighlight 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 ChoiceFieldProps msg =
    { key : Key
    , title : List (Html.Html msg)
    , description : List (Html.Html msg)
    , attrs : List (Html.Attribute msg)
    , disabled : Bool
    , choices :
        List
            { value : String
            , label : List (Html.Html msg)
            , description : List (Html.Html msg)
            }
    }


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

          else
            class ""
        ]
        (span [ slot "title" ] title
            :: p [ slot "description" ] description
            :: List.map
                (\choice ->
                    let
                        id =
                            Key.toString key ++ "_" ++ choice.value

                        choiceDescriptionId =
                            id ++ "__description"

                        checked =
                            getKey key model.fields
                                |> Maybe.withDefault ""
                                |> (==) choice.value
                    in
                    node "x-radio-box"
                        [ if checked then
                            attribute "checked" ""

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


type alias BoolFieldProps msg =
    { key : Key
    , title : List (Html.Html msg)
    , description : List (Html.Html msg)
    , attrs : List (Html.Attribute msg)
    , disabled : Bool
    , true : { label : List (Html.Html msg), description : List (Html.Html msg) }
    , false : { label : List (Html.Html msg), description : List (Html.Html msg) }
    }


boolField : Model -> BoolFieldProps Msg -> Html.Html Msg
boolField model { key, title, disabled, description, attrs, true, false } =
    let
        isTrue =
            hasKey key model.fields

        id : Bool -> String
        id v =
            Key.toString key
                ++ "_"
                ++ (if v then
                        "true"

                    else
                        "false"
                   )

        choiceDescriptionId : Bool -> String
        choiceDescriptionId v =
            id v ++ "_description"
    in
    node "x-field"
        [ if disabled then
            attribute "disabled" ""

          else
            class ""
        ]
        [ span [ slot "title" ] title
        , p [ slot "description" ] description
        , node "x-radio-box"
            [ if isTrue then
                attribute "checked" ""

              else
                class ""
            ]
            [ Html.label [ for (id True), slot "label" ] true.label
            , Html.p [ Html.Attributes.id (choiceDescriptionId True), slot "description" ] true.description
            , input
                (type_ "radio"
                    :: Html.Attributes.id (id True)
                    :: Html.Attributes.name (Key.toString key)
                    :: Html.Attributes.value "true"
                    :: Html.Attributes.checked isTrue
                    :: Html.Attributes.disabled disabled
                    :: Html.Events.onCheck (\_ -> FieldChanged key "")
                    :: ariaDescribedBy [ choiceDescriptionId True ]
                    :: attrs
                )
                []
            ]
        , node "x-radio-box"
            [ if not isTrue then
                attribute "checked" ""

              else
                class ""
            ]
            [ Html.label [ for (id False), slot "label" ] false.label
            , Html.p [ Html.Attributes.id (choiceDescriptionId False), slot "description" ] false.description
            , input
                (type_ "radio"
                    :: Html.Attributes.id (id False)
                    :: Html.Attributes.name (Key.toString key)
                    :: Html.Attributes.value "false"
                    :: Html.Attributes.checked (not isTrue)
                    :: Html.Attributes.disabled disabled
                    :: Html.Events.onCheck (\_ -> FieldUnset key)
                    :: ariaDescribedBy [ choiceDescriptionId False ]
                    :: 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"
        []
        (span [ slot "title" ] title
            :: (description |> Maybe.map (span [ slot "description" ]) |> Maybe.withDefault (text ""))
            :: children
        )


view : Model -> List (Html.Html Msg)
view model =
    [ group
        { title = [ text "General" ], description = Nothing }
        [ numberField model
            { key = ShoulderWidth
            , title = [ text "Shoulder Width" ]
            , description =
                [ text "Width of your strap. "
                , text "Should be same as or wider than your watch's lug width."
                ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "1.0" :: lengthFieldAttrs constraints.shoulderWidth
            }
        , choiceField model
            { key = Profile
            , title = [ text "Profile" ]
            , description = [ text "Shape of the straps." ]
            , disabled = False
            , attrs = []
            , choices =
                [ { label = [ text "Straight" ]
                  , description = [ text "Shoulder width, tip width and buckle-edge width shares the same size." ]
                  , value = profileKind Parameters.Straight
                  }
                , { label = [ text "Tapered" ]
                  , description = [ text "Narrows down to the specified width." ]
                  , value = profileKind (Parameters.Tapered (mm 0))
                  }
                ]
            }
        , numberField model
            { key = TaperTo
            , title = [ text "Taper To" ]
            , description = [ text "Width of the tip and buckle-edge." ]
            , unit = Just "mm"
            , disabled = model.parameters.profile == Parameters.Straight
            , attrs = step "1.0" :: lengthFieldAttrs constraints.taperTo
            }
        , numberField model
            { key = LongPieceLength
            , title = [ text "Length (Tail Side)" ]
            , description =
                [ text "Length of the tail-side piece, which is usually the longer one."
                ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "1" :: lengthFieldAttrs constraints.longPiece.length
            }
        , numberField model
            { key = ShortPieceLength
            , title = [ text "Length (Buckle Side)" ]
            , description =
                [ text "Length of the buckle-side piece, which is usually the shorter one."
                ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "1" :: lengthFieldAttrs constraints.shortPiece.length
            }
        ]
    , hr [] []
    , group
        { title = [ text "Buckle / Clasp" ], description = Nothing }
        [ numberField model
            { key = BuckleHoleDistance
            , title = [ text "Center Hole Distance" ]
            , description =
                [ text "Distance between case-side strap end and the center hole." ]
            , unit = Just "mm"
            , disabled = False
            , attrs =
                step "1.0" :: lengthFieldAttrs constraints.longPiece.buckleHole.distance
            }
        , numberField model
            { key = BuckleHoleAdjustments
            , title = [ text "Hole Adjustment Level" ]
            , description = [ text "Number of adjustment holes top and bottom of the center hole." ]
            , unit = Nothing
            , disabled = False
            , attrs = step "1" :: intFieldAttrs constraints.longPiece.buckleHole.adjustments
            }
        , numberField model
            { key = BuckleHoleDiameter
            , title = [ text "Hole Diameter" ]
            , description = [ text "Diameter of the buckle holes." ]
            , unit = Just "mm"
            , disabled = False
            , attrs =
                step "1.0" :: lengthFieldAttrs constraints.longPiece.buckleHole.diameter
            }
        , numberField model
            { key = BuckleHoleInterval
            , title = [ text "Hole Interval" ]
            , description =
                [ text "Center-to-center interval between buckle holes." ]
            , unit = Just "mm"
            , disabled = False
            , attrs =
                step "0.5" :: lengthFieldAttrs constraints.longPiece.buckleHole.interval
            }
        ]
    , hr [] []
    , group
        { title = [ text "Loops" ], description = Nothing }
        [ choiceField model
            { key = LoopStyle
            , title = [ text "Loop Style" ]
            , description = [ text "Style of the fixed loop and the free loop." ]
            , disabled =
                not (hasKey HasFixedLoop model.fields)
                    && not (hasKey HasFreeLoop model.fields)
            , attrs = []
            , choices =
                [ { label = [ text "Simple" ]
                  , description = [ text "Simply use a strip of leather as a loop." ]
                  , value = loopStyleToString Simple
                  }
                , { label = [ text "Folded" ]
                  , description = [ text "Fold a strip of leather to hide edges (fibers.)" ]
                  , value = loopStyleToString Folded
                  }
                ]
            }
        , boolField model
            { key = HasFixedLoop
            , title = [ text "Fixed Loop" ]
            , description = [ text "Whether to draw fixed loop. Certain kind of deployant buckles don't require a fixed loop." ]
            , attrs = []
            , disabled = False
            , true =
                { label = [ text "Enabled" ]
                , description = [ text "Output fixed loop." ]
                }
            , false =
                { label = [ text "Disabled" ]
                , description = [ text "Do not output fixed loop." ]
                }
            }
        , numberField model
            { key = FixedLoopWidth
            , title = [ text "Fixed Loop Width" ]
            , description = [ text "Width of the fixed loop." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasFixedLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.fixed.width
            }
        , numberField model
            { key = FixedLoopLength
            , title = [ text "Fixed Loop Length" ]
            , description = [ text "Length of the fixed loop. This should be at least double the strap width and thickness." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasFixedLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.fixed.length
            }
        , boolField model
            { key = HasFreeLoop
            , title = [ text "Free Loop" ]
            , description = [ text "Whether to draw free loop. Certain kind of deployant buckles don't require a free loop." ]
            , attrs = []
            , disabled = False
            , true =
                { label = [ text "Enabled" ]
                , description = [ text "Output free loop." ]
                }
            , false =
                { label = [ text "Disabled" ]
                , description = [ text "Do not output free loop." ]
                }
            }
        , numberField model
            { key = FreeLoopWidth
            , title = [ text "Free Loop Width" ]
            , description = [ text "Width of the free loop." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasFreeLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.free.width
            }
        , numberField model
            { key = FreeLoopLength
            , title = [ text "Free Loop Length" ]
            , description = [ text "Length of the free loop. This should be at least double the strap width and thickness." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasFreeLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.free.length
            }
        , numberField model
            { key = FreeLoopOverlap
            , title = [ text "Free Loop Overlap" ]
            , description = [ text "Length of overlapping section of the free loop for gluing and/or stitching." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasFreeLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.free.overlap
            }
        ]
    , 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
            }
        , choiceField model
            { key = ColorSchema
            , title = [ text "Color Schema" ]
            , description = [ text "Color schema of the template." ]
            , attrs = []
            , disabled = False
            , choices =
                [ { label = [ text "Black on White" ]
                  , description = [ text "Select this if you print the template with a regular printer." ]
                  , value = colorSchemaToString BlackOnWhite
                  }
                , { label = [ text "White on Black" ]
                  , description = [ text "For digital output. Printing this with an inkjet printer is not a good idea." ]
                  , value = colorSchemaToString WhiteOnBlack
                  }
                ]
            }
        , boolField model
            { key = QRCode
            , title = [ text "QR code" ]
            , description =
                [ text "Add QR code points to this page's URL to the output. "
                , text "As the QR code generation is computationally heavy process, I recommend you to disable "
                , text "this while editing parameters."
                ]
            , attrs = []
            , disabled = False
            , true =
                { label = [ text "Enabled" ]
                , description = [ text "Output QR code." ]
                }
            , false =
                { label = [ text "Disabled" ]
                , description = [ text "Do not output QR code." ]
                }
            }
        ]
    ]