バーグ・ザッカーマーク with Elm

Elmで作ってみる。
前回はリストのシャッフルを楽にやってしまったので、今回は自作してみた。

デモ

module Main exposing (main)

import Browser
import Html exposing (Html, button, div, text)
import Html.Events exposing (onClick)
import Random


type alias Model =
    { value : String }


initialModel : flag -> ( Model, Cmd Msg )
initialModel _ =
    ( { value = "マーク・ザッカーバーグ" }, generateMZ )


type Msg
    = Generate
    | Generated String


mzCharacters : List String
mzCharacters =
    [ "マ", "ク", "ザ", "カ", "バ", "グ" ]


fixedCharacters : List String
fixedCharacters =
    [ "ー", "・", "ッ", "ー", "ー" ]


foldMZ : List String -> String
foldMZ generatedChars =
    foldMZ_ generatedChars fixedCharacters


foldMZ_ : List String -> List String -> String
foldMZ_ generated fixed =
    case ( generated, fixed ) of
        ( [], _ ) ->
            ""

        ( x :: xs, [] ) ->
            x

        ( x :: xs, y :: ys ) ->
            x ++ y ++ foldMZ_ xs ys


shuffleList : List a -> Random.Generator (List a)
shuffleList ls =
    shuffleList_ ls
        |> Random.map (List.sortBy Tuple.second >> List.map Tuple.first)


shuffleList_ : List a -> Random.Generator (List ( a, Float ))
shuffleList_ ls =
    case ls of
        [] ->
            Random.constant []

        x :: xs ->
            Random.map2 (::) (Random.pair (Random.constant x) (Random.float 0 1)) (shuffleList_ xs)


mzGenerator : Random.Generator String
mzGenerator =
    shuffleList mzCharacters
        |> Random.map foldMZ


generateMZ : Cmd Msg
generateMZ =
    Random.generate Generated mzGenerator


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        Generate ->
            ( model, generateMZ )

        Generated newValue ->
            ( { model | value = newValue }, Cmd.none )


view : Model -> Html Msg
view model =
    div []
        [ div [] [ text model.value ]
        , button [ onClick Generate ] [ text "Generate" ]
        ]


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


main : Program () Model Msg
main =
    Browser.element
        { init = initialModel
        , view = view
        , subscriptions = subscriptions
        , update = update
        }