Experiment with state machines & elm-ui

Demo.elm

module MachineDemo exposing
    ( Model
    , init
    , myDiv
    , setHeight
    , setMinHeight
    , setWidth
    )

import Element exposing (..)
import Machine



-- Example


myDiv : Element msg
myDiv =
    init "text within"
        |> setWidth (px 200)
        |> setHeight (px 100)
        -- |> setMinHeight 200 -- compiler error => contradicts with setHeight
        -- |> setWidth (px 200) -- compiler error => duplicate call
        |> build



-- API


type alias Model =
    { text : String
    , width : Length
    , height : Length
    }


init : String -> Machine.Start Model {}
init text =
    Machine.start
        { text = text
        , width = fill
        , height = fill
        }


setHeight : Length -> Machine.ToHeightTransition a Model
setHeight l =
    Machine.transition (\r -> { r | height = l })


setMinHeight : Int -> Machine.ToMinHeightTransition a Model
setMinHeight l =
    Machine.transition (\r -> { r | height = r.height |> minimum l })


setWidth : Length -> Machine.ToWidthTransition a Model
setWidth l =
    Machine.transition (\r -> { r | width = l })


build : Machine.Step a Model -> Element msg
build transition =
    let
        model : Model
        model =
            Machine.untag transition
    in
    Element.el
        []
        (Element.text model.text)
        

Machine.elm

module Machine exposing
    ( Forbidden
    , Start
    , Step
    , ToHeightTransition
    , ToMinHeightTransition
    , ToWidthTransition
    , start
    , transition
    , untag
    )


type Forbidden
    = Forbidden Never


type Step tag state
    = Step state


untag : Step tag model -> model
untag (Step model) =
    model


tag : model -> Step tag model
tag =
    Step


type alias Start model r =
    Step
        { r
            | canSetHeight : ()
            , canSetMinHeight : ()
            , canSetWidth : ()
        }
        model


start : model -> Start model r
start =
    Step


transition : (a -> a) -> Step to a -> Step from a
transition update step =
    untag step |> update |> tag



type alias ToHeightTransition a model =
       Step { a | canSetHeight : () } model
    -> Step { a | canSetMinHeight : Forbidden } model


type alias ToMinHeightTransition a model =
    Step { a | canSetMinHeight : () } model
    -> Step { a | canSetHeight : Forbidden } model


type alias ToWidthTransition a model =
    Step { a | canSetWidth : () } model
    -> Step { a | canSetMinWidth : Forbidden } model