Some code that illustrates a nice pattern of dependant update functions to allow flexible reuse and separation of concerns

Doors.elm

module Doors exposing (main)

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


{-| This is an attempt at building up a dependency between pieces of state
that can be separate and then allowing us to compose them naturally.

It's kind of a reaction to reading an article that illustrates what the author
suggests is a good way to model state. While it's definitely _easy_, I'm more
of the opinion that if we think about it a little more, and rely more on creating
simple basic elements that then get composed, we end up with something that is
much more flexible, but _possibly more importantly_, harder to get wrong as we build
bigger programs!
Here is the article: <https://dev.to/nimmo/the-basic-elm-example-that-i-wish-id-had-40m8>

In our case, we're modelling just a lockable door for now.
The first piece is to model the door's state, then the lock's state.

At that point we'd like to express the relationship between the lock and
the door; the fact that the door's state transitions depend on some
computation on the state of the lock(s).

Furthermore, we can envisage multiple lock types:
broken lock, deadlock, latching locks;

...or maybe even multiple locks. In any case, what matters is that there's
some dependency set up between a door and the thing(s) it relies on to determine
in what way it transitions states, if it does at all.

Expressed in this way, composition becomes easy to do because it's a mechanical
process of stitching the pieces together in the relationship we want.

Next it'd be interesting to be able to make the list of locks not just be constrainted
to being the same kinds of locks, and then to add an alarm system.

My favourite part of this program, though, is that it's clear where modules
could be separated out because those are the pieces that don't rely on
external things: Lock and Door and their related functions are totally
independent of the application and are entirely reusable.

If we wanted to build an application that used a diffrent lock with maybe 3 or 4
states instead of two, we could happily do that without changing Door, or our
existing code that relies on the other two-state Lock. Beautiful!

-}
main =
    Browser.sandbox { init = init, update = update, view = view }



-- MODEL
-- =====


type Door
    = OpenDoor
    | ClosedDoor


type Lock
    = EngagedLock
    | DisengagedLock


type LockableDoor
    = LockableDoor Door (List Lock)


initLockableDoor : LockableDoor
initLockableDoor =
    LockableDoor OpenDoor [ DisengagedLock ]


type alias Model =
    { firstDoor : LockableDoor
    , secondDoor : LockableDoor
    , thirdDoor : LockableDoor
    , fourthDoor : LockableDoor
    }


init : Model
init =
    { firstDoor = initLockableDoor
    , secondDoor = initLockableDoor
    , thirdDoor = initLockableDoor
    , fourthDoor = LockableDoor OpenDoor [ DisengagedLock, DisengagedLock, DisengagedLock ]
    }



-- UPDATE
-- ======


type DoorMsg
    = OpenDoorAttempt
    | CloseDoorAttempt


type LockMsg
    = DisengageEngageLockAttempt
    | EngageLockAttempt


type LockableDoorMsg
    = LockableDoorLockMsg Int LockMsg
    | LockableDoorDoorMsg DoorMsg


type Msg
    = FirstDoorMsg LockableDoorMsg
    | SecondDoorMsg LockableDoorMsg
    | ThirdDoorMsg LockableDoorMsg
    | FourthDoorMsg LockableDoorMsg


{-| The DoorUpdater is a type that captures an elm-style update function on doors
that is also parameterized by some particular `dependency`:
-}
type DoorUpdater dependency
    = DoorUpdater (dependency -> DoorMsg -> Door -> Door)


{-| Here we define a lockable door updater as a door udater which also depends on
some set of locks
-}
type alias LockableDoorDoorUpdater =
    DoorUpdater (List Lock)


{-| a door updater that isn't constrained by its dependency at all
that is... a door that can't be locked, even though it might
have 0 or more locks on it.
-}
unconstrainedDoorUpdater : DoorUpdater a
unconstrainedDoorUpdater =
    DoorUpdater <|
        \_ msg door ->
            case ( msg, door ) of
                ( OpenDoorAttempt, ClosedDoor ) ->
                    OpenDoor

                ( CloseDoorAttempt, OpenDoor ) ->
                    ClosedDoor

                _ ->
                    door


{-| we can now define what a deadlock means in terms of its update function:
that is, its set of possible state transitions, based on the fact that it depends
on a list of locks.
essentially, we say that the door can only be opened or closed if
all of the locks are unlocked:
-}
deadlockDoorUpdater : LockableDoorDoorUpdater
deadlockDoorUpdater =
    DoorUpdater <|
        \locks msg door ->
            case ( locks, msg, door ) of
                ( _, OpenDoorAttempt, ClosedDoor ) ->
                    if List.all (\lock -> lock == DisengagedLock) locks then
                        OpenDoor

                    else
                        door

                ( _, CloseDoorAttempt, OpenDoor ) ->
                    if List.all (\lock -> lock == DisengagedLock) locks then
                        ClosedDoor

                    else
                        door

                _ ->
                    door


{-| a latchable door is one that can only be opened if all its locks are open
but can be closed anytime, because its locks are latchable
-}
latchlockDoorUpdater : LockableDoorDoorUpdater
latchlockDoorUpdater =
    DoorUpdater <|
        \locks msg door ->
            case ( locks, msg, door ) of
                ( _, OpenDoorAttempt, ClosedDoor ) ->
                    if List.all (\lock -> lock == DisengagedLock) locks then
                        OpenDoor

                    else
                        door

                ( _, CloseDoorAttempt, OpenDoor ) ->
                    ClosedDoor

                _ ->
                    door


transitionDoorWith : DoorUpdater a -> a -> DoorMsg -> Door -> Door
transitionDoorWith (DoorUpdater f) =
    f


updateLock : LockMsg -> Lock -> Lock
updateLock msg lock =
    case ( lock, msg ) of
        ( EngagedLock, DisengageEngageLockAttempt ) ->
            DisengagedLock

        ( DisengagedLock, EngageLockAttempt ) ->
            EngagedLock

        _ ->
            -- no effect, because it wasn't different
            -- note: this is probably bad, because adding
            -- additional states to Lock, or LockMsg would
            -- let it still compile when it should fail.
            lock


mkUpdateDoor : DoorUpdater a -> a -> DoorMsg -> Door -> Door
mkUpdateDoor doorUpdater =
    transitionDoorWith doorUpdater


updateDoor : DoorMsg -> Door -> Door
updateDoor =
    mkUpdateDoor unconstrainedDoorUpdater ()


mapLocksInLockableDoor : (Lock -> Lock) -> LockableDoor -> LockableDoor
mapLocksInLockableDoor f (LockableDoor door locks) =
    LockableDoor door (List.map f locks)


mapLockInLockableDoorFromIndex : Int -> (Lock -> Lock) -> LockableDoor -> LockableDoor
mapLockInLockableDoorFromIndex index f (LockableDoor door locks) =
    LockableDoor
        door
        (List.indexedMap
            (\thisIndex lock ->
                if index == thisIndex then
                    f lock

                else
                    lock
            )
            locks
        )


mapDoorInLockableDoor : (Door -> Door) -> LockableDoor -> LockableDoor
mapDoorInLockableDoor f (LockableDoor door locks) =
    LockableDoor (f door) locks


mkUpdateLockableDoor : LockableDoorDoorUpdater -> LockableDoorMsg -> LockableDoor -> LockableDoor
mkUpdateLockableDoor doorUpdater msg ((LockableDoor _ locks) as lockableDoor) =
    case msg of
        LockableDoorDoorMsg doorMsg ->
            mapDoorInLockableDoor
                (mkUpdateDoor doorUpdater locks doorMsg)
                lockableDoor

        LockableDoorLockMsg index lockMsg ->
            mapLockInLockableDoorFromIndex
                index
                (updateLock lockMsg)
                lockableDoor


updateDeadlockableDoor : LockableDoorMsg -> LockableDoor -> LockableDoor
updateDeadlockableDoor =
    mkUpdateLockableDoor deadlockDoorUpdater


updateBrokenLockDoor : LockableDoorMsg -> LockableDoor -> LockableDoor
updateBrokenLockDoor =
    mkUpdateLockableDoor unconstrainedDoorUpdater


updateLatchLockDoor : LockableDoorMsg -> LockableDoor -> LockableDoor
updateLatchLockDoor =
    mkUpdateLockableDoor latchlockDoorUpdater


update : Msg -> Model -> Model
update msg model =
    case msg of
        FirstDoorMsg lockableDoorMsg ->
            { model | firstDoor = updateDeadlockableDoor lockableDoorMsg model.firstDoor }

        SecondDoorMsg lockableDoorMsg ->
            { model | secondDoor = updateBrokenLockDoor lockableDoorMsg model.secondDoor }

        ThirdDoorMsg lockableDoorMsg ->
            { model | thirdDoor = updateLatchLockDoor lockableDoorMsg model.thirdDoor }

        FourthDoorMsg lockableDoorMsg ->
            { model | fourthDoor = updateLatchLockDoor lockableDoorMsg model.fourthDoor }



-- VIEW
-- ====

lockView : Lock -> Html LockMsg
lockView lock =
    let
        ( msg, buttonTxt, lockStateTxt ) =
            case lock of
                EngagedLock ->
                    ( DisengageEngageLockAttempt, "Disengage", "Engaged" )

                DisengagedLock ->
                    ( EngageLockAttempt, "Engage", "Disengaged" )
    in
    div []
        [ div [] [ text lockStateTxt ]
        , button [ onClick msg ] [ text buttonTxt ]
        ]


doorView : Door -> Html DoorMsg
doorView door =
    let
        ( msg, buttonTxt, doorStateTxt ) =
            case door of
                OpenDoor ->
                    ( CloseDoorAttempt, "Close", "Open" )

                ClosedDoor ->
                    ( OpenDoorAttempt, "Open", "Closed" )
    in
    div []
        [ div [] [ text doorStateTxt ]
        , button [ onClick msg ] [ text buttonTxt ]
        ]


lockableDoorView : LockableDoor -> Html LockableDoorMsg
lockableDoorView (LockableDoor door locks) =
    let
        renderedLock =
            Html.div []
                (List.indexedMap
                    (\index -> Html.map (LockableDoorLockMsg index))
                    (List.map lockView locks)
                )

        renderedDoor =
            Html.map LockableDoorDoorMsg (doorView door)
    in
    div []
        [ text "Lock: ", renderedLock, text "Door: ", renderedDoor ]


view : Model -> Html Msg
view model =
    let
        firstLockViewRender =
            Html.map
                FirstDoorMsg
                (lockableDoorView model.firstDoor)

        secondLockViewRender =
            Html.map
                SecondDoorMsg
                (lockableDoorView model.secondDoor)

        thirdLockViewRender =
            Html.map
                ThirdDoorMsg
                (lockableDoorView model.thirdDoor)

        fourthLockViewRender =
            Html.map
                FourthDoorMsg
                (lockableDoorView model.fourthDoor)
    in
    div []
        [ h2 [] [ text "Deadlock..." ]
        , firstLockViewRender
        , h2 [] [ text "Broken lock..." ]
        , secondLockViewRender
        , h2 [] [ text "Latching lock..." ]
        , thirdLockViewRender
        , h2 [] [ text "Multiple Latching locks..." ]
        , fourthLockViewRender
        ]