/src/Main.elm at b341cdcc8918671e29aa6f196a63d578321808b3

-- 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 Main exposing (main)

import Browser
import Browser.Navigation exposing (Key)
import Html exposing (a, hr, node, p, span, text)
import Html.Attributes exposing (attribute, href)
import Html.LivingStandard exposing (..)
import Json.Decode
import Parameters
import Parameters.App
import Parameters.Parser
import Platform.Cmd as Cmd
import Preferences exposing (FieldHighlight(..))
import Preferences.App
import QueryHealer
import Template exposing (template)
import Url exposing (Url)
import Url.SearchParams


main : Program Flags Model Msg
main =
    Browser.application
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        , onUrlRequest = UrlRequested
        , onUrlChange = UrlChanged
        }



-- FLAGS


type alias Flags =
    { preferences : Json.Decode.Value
    }



-- MODEL


type alias Model =
    { url : Url
    , key : Key
    , parameters : Result QueryHealer.Model Parameters.App.Model
    , preferences : Preferences.App.Model
    }


parseParameters : Url -> Key -> Preferences.Preferences -> ( Result QueryHealer.Model Parameters.App.Model, Cmd Msg )
parseParameters url key preferences =
    case Maybe.map Url.SearchParams.parse url.query of
        Just dict ->
            case Parameters.Parser.parse dict of
                Ok params ->
                    let
                        ( model, cmd ) =
                            Parameters.App.init url key preferences params
                    in
                    ( Ok model, Cmd.map ParametersMsg cmd )

                Err errors ->
                    ( Err (QueryHealer.init url preferences errors), Cmd.none )

        Nothing ->
            let
                ( model, cmd ) =
                    Parameters.App.init url key preferences Parameters.default
            in
            ( Ok model, Cmd.map ParametersMsg cmd )


init : Flags -> Url -> Key -> ( Model, Cmd Msg )
init flags url key =
    let
        preferences =
            Preferences.App.init flags.preferences

        ( parameters, parametersCmd ) =
            parseParameters url key preferences.preferences
    in
    ( { url = url
      , key = key
      , parameters = parameters
      , preferences = preferences
      }
    , parametersCmd
    )



-- UPDATE


type Msg
    = NoOp
    | ParametersMsg Parameters.App.Msg
    | PreferencesMsg Preferences.App.Msg
    | QueryHealerMsg QueryHealer.Msg
    | UrlRequested Browser.UrlRequest
    | UrlChanged Url


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        NoOp ->
            ( model, Cmd.none )

        ParametersMsg subMsg ->
            case model.parameters of
                Ok subModel ->
                    Parameters.App.update subMsg subModel
                        |> Tuple.mapFirst (\p -> { model | parameters = Ok p })
                        |> Tuple.mapSecond (Cmd.map ParametersMsg)

                Err _ ->
                    ( model, Cmd.none )

        QueryHealerMsg subMsg ->
            case model.parameters of
                Err subModel ->
                    QueryHealer.update subMsg subModel
                        |> Tuple.mapFirst (\p -> { model | parameters = Err p })
                        |> Tuple.mapSecond (Cmd.map QueryHealerMsg)

                Ok _ ->
                    ( model, Cmd.none )

        PreferencesMsg subMsg ->
            Preferences.App.update subMsg model.preferences
                |> Tuple.mapFirst
                    (\p ->
                        { model
                            | preferences = p
                            , parameters =
                                case model.parameters of
                                    Ok parameters ->
                                        Ok { parameters | preferences = p.preferences }

                                    Err queryHealer ->
                                        Err { queryHealer | preferences = p.preferences }
                        }
                    )
                |> Tuple.mapSecond (Cmd.map PreferencesMsg)

        UrlRequested (Browser.Internal url) ->
            if String.endsWith ".txt" url.path then
                ( model, Browser.Navigation.load (Url.toString url) )

            else
                ( model, Browser.Navigation.replaceUrl model.key (Url.toString url) )

        UrlRequested (Browser.External href) ->
            ( model, Browser.Navigation.load href )

        UrlChanged url ->
            case model.parameters of
                Ok _ ->
                    ( { model | url = url }, Cmd.none )

                Err _ ->
                    let
                        ( parameters, parametersCmd ) =
                            parseParameters url model.key model.preferences.preferences
                    in
                    ( { model | url = url, parameters = parameters }, parametersCmd )



-- VIEW


view : Model -> Browser.Document Msg
view model =
    case model.parameters of
        Ok parameters ->
            let
                highlighting =
                    case model.preferences.preferences.fieldHighlight of
                        HighlightOnPreview ->
                            parameters.highlighting

                        DoNotHighlight ->
                            Nothing
            in
            { title = ""
            , body =
                [ node "x-app-layout"
                    []
                    [ node "x-preview"
                        [ slot "preview"
                        , attribute "print-theme"
                            (case parameters.parameters.rendering.colorSchema of
                                Parameters.BlackOnWhite ->
                                    "black-on-white"

                                Parameters.WhiteOnBlack ->
                                    "white-on-black"
                            )
                        , attribute "preview-theme"
                            (case model.preferences.preferences.previewTheme of
                                Preferences.SystemTheme ->
                                    "system"

                                Preferences.PrintTheme ->
                                    "print"
                            )
                        ]
                        [ template
                            model.url
                            parameters.parameters
                            highlighting
                            []
                        ]
                    , node "x-panel"
                        [ slot "parameters" ]
                        [ node "x-parameters"
                            []
                            (node "x-field-group"
                                []
                                [ span [ slot "title" ] [ text "About" ]
                                , node "x-field"
                                    []
                                    [ span [ slot "title" ] [ text "This Software" ]
                                    , p [ slot "description" ]
                                        [ text "This application lets you build a customized template (pattern) for leather crafting."
                                        ]
                                    ]
                                , node "x-field"
                                    []
                                    [ span [ slot "title" ] [ text "The Template" ]
                                    , p [ slot "description" ]
                                        [ text "This template is for two-parts leather wrist warch strap. "
                                        , text "It assumes you use a lining leather and a clasp / buckle. "
                                        ]
                                    , p [ slot "description" ]
                                        [ text "The output is provided as-is. How to use the template is completely up to you."
                                        ]
                                    ]
                                , node "x-field"
                                    []
                                    [ span [ slot "title" ] [ text "Author" ]
                                    , p [ slot "description" ]
                                        [ text "© Shota FUJI, licensed under the "
                                        , a [ href "/licenses/MPL-2.0.txt" ] [ text "Mozilla Public License version 2.0" ]
                                        , text "."
                                        ]
                                    ]
                                ]
                                :: hr [] []
                                :: (Parameters.App.view parameters |> List.map (Html.map ParametersMsg))
                                ++ hr [] []
                                :: (Preferences.App.panelItems model.preferences |> List.map (Html.map PreferencesMsg))
                                ++ [ hr [] []
                                   , node "x-field-group"
                                        []
                                        [ span [ slot "title" ] [ text "Legal" ]
                                        , node "x-field"
                                            []
                                            [ span [ slot "title" ] [ text "Third-party Fonts" ]
                                            , p [ slot "description" ] [ text "This application uses these fonts:" ]
                                            , Html.ul
                                                [ slot "description" ]
                                                [ Html.li []
                                                    [ a [ href "https://github.com/jpt/barlow" ] [ text "Barlow" ]
                                                    , text " (Copyright 2017 The Barlow Project Authors (https://github.com/jpt/barlow), licensed under "
                                                    , a [ href "/licenses/OFL-1.1-no-RFN.txt" ] [ text "SIL Open Font License, Version 1.1" ]
                                                    , text ")"
                                                    ]
                                                , Html.li []
                                                    [ a [ href "https://rsms.me/inter/" ] [ text "Inter UI" ]
                                                    , text " (Copyright (c) 2016 The Inter Project Authors (https://github.com/rsms/inter), licensed under "
                                                    , a [ href "/licenses/OFL-1.1-no-RFN.txt" ] [ text "SIL Open Font License, Version 1.1" ]
                                                    , text ")"
                                                    ]
                                                ]
                                            ]
                                        , node "x-field"
                                            []
                                            [ span [ slot "title" ] [ text "Third-party Softwares" ]
                                            , p [ slot "description" ]
                                                [ text "See "
                                                , a [ href "/licenses/third-party.txt" ] [ text "third-party.txt" ]
                                                , text " for list of third-party softwares and its license text."
                                                ]
                                            ]
                                        ]
                                   ]
                            )
                        ]
                    ]
                ]
            }

        Err queryHealer ->
            { title = "Parameters Error | WWSTB"
            , body = [ QueryHealer.view queryHealer |> Html.map QueryHealerMsg ]
            }



-- SUBSCRIPTIONS


subscriptions : Model -> Sub Msg
subscriptions _ =
    Sub.none