/src/Parameters/App.elm at 474346eb587e05347038d376e9144ea3c1138fe0

-- 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, toMM)
import Parameters exposing (ColorSchema(..), LoopStyle(..), Parameters, ParametersDict, colorSchemaToString, getKey, hasKey, loopStyleToString)
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 = 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 = Taper
            , title = [ text "Taper" ]
            , description =
                [ text "Taper size. "
                , text (String.fromFloat (toMM model.parameters.taper))
                , text "mm taper makes the strap "
                , text (String.fromFloat (toMM model.parameters.lugWidth))
                , text "/"
                , text (String.fromFloat (toMM model.parameters.lugWidth - toMM model.parameters.taper))
                , text "mm."
                ]
            , unit = Just "mm"
            , disabled = False
            , attrs = step "1" :: lengthFieldAttrs constraints.taper
            }
        , 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
            }
        , 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 = 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
            }
        , numberField model
            { key = BuckleHoleOffset
            , title = [ text "Hole Offset" ]
            , description =
                [ text "Distance between strap end (lug-side) and first buckle hole." ]
            , unit = Just "mm"
            , disabled = False
            , attrs =
                step "1.0" :: lengthFieldAttrs constraints.longPiece.buckleHole.offset
            }
        , 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
            }
        , numberField model
            { key = BuckleSpringBarDiameter
            , title = [ text "Spring Bar Diameter" ]
            , description =
                [ text "Diameter of the spring bar to use for buckle / clasp." ]
            , unit = Just "mm"
            , disabled = False
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.buckle.springBarDiameter
            }
        , boolField model
            { key = HasBuckleTongue
            , title = [ text "Buckle Tongue Cutout" ]
            , description = [ text "Whether to draw cutout for buckle tongue." ]
            , attrs = []
            , disabled = False
            , true =
                { label = [ text "Enabled" ]
                , description = [ text "Draw cutout at where buckle tongue sits on." ]
                }
            , false =
                { label = [ text "Disabled" ]
                , description =
                    [ text "Do not draw cutout for buckle tongue. "
                    , text "Select this if you're planning to use a deployant buckle."
                    ]
                }
            }
        , numberField model
            { key = BuckleTongueWidth
            , title = [ text "Buckle Tongue Width" ]
            , description =
                [ text "Width of the buckle tongue / pin." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasBuckleTongue model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.buckle.tongue.width
            }
        , numberField model
            { key = BuckleTongueThickness
            , title = [ text "Buckle Tongue Thickness" ]
            , description =
                [ text "Thickness of the buckle tongue / pin, to add to the cutout depth." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasBuckleTongue model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.buckle.tongue.thickness
            }
        ]
    , 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
                  }
                ]
            }
        , numberField model
            { key = LoopThickness
            , title = [ text "Loop Leather Thickness" ]
            , description = [ text "Thickness of the leather to use for loops. Final thickness will be doubled if you choose \"Folded\" style." ]
            , unit = Just "mm"
            , disabled =
                not (hasKey HasFixedLoop model.fields)
                    && not (hasKey HasFreeLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.thickness
            }
        , 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 = FixedLoopPlay
            , title = [ text "Fixed Loop Play" ]
            , description = [ text "Extra length to add to the fixed loop, for adjusting tightness." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasFixedLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.fixed.play
            }
        , 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 = FreeLoopPlay
            , title = [ text "Free Loop Play" ]
            , description = [ text "Extra length to add to the free loop, for adjusting tightness." ]
            , unit = Just "mm"
            , disabled = not (hasKey HasFreeLoop model.fields)
            , attrs =
                step "0.1" :: lengthFieldAttrs constraints.shortPiece.loops.free.play
            }
        , 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
                  }
                ]
            }
        ]
    ]