Alarms.elm

module Alarm 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 a set of lockable doors and an entire alarm system.
First, we have a lock, a door and an alarm as separate entities.

At this 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 easily 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.

Modelling an alarm system adds an extra wrinkle, in that the alarm system is
triggered on a state change of the door, which means it's dependent on it,
but also that it's dependent on the state change of the door. Here we use
the same pattern to address this, which is to build the functionality of
what to update into the update function of the composition of the elements,
so the elements remain unchanged.

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, or to even think about some entirely different
locks like ones with keys, deadbolts or electronic passkey locks.

A great thing is it's clear where modules could be separated out because those
are the pieces that don't rely on external things: Alarm, 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 different 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.

At present, a Lockable Door can't be expressed that has different types of locks
on it, but that wouldn't be too hard to adjust.

Sometime I'd like to write this into a block post, along with a step by step
work through of how each piece was written, and the reasoning behind it.

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



-- MODEL
-- =====


type Door
    = OpenDoor
    | ClosedDoor


type Lock
    = EngagedLock
    | DisengagedLock


type LockableDoor
    = LockableDoor Door (List Lock)


type Alarm
    = DisarmedAlarm
    | ArmedAlarm
    | TriggeredAlarm


type AlarmSystem
    = AlarmSystem LockableDoor Alarm


initLockableDoor : LockableDoor
initLockableDoor =
    initLockableDoorWithLockCountOf 1


initLockableDoorWithLockCountOf : Int -> LockableDoor
initLockableDoorWithLockCountOf lockCount =
    LockableDoor OpenDoor <| List.repeat lockCount DisengagedLock


initAlarmSystemWithLockCountOf : Int -> AlarmSystem
initAlarmSystemWithLockCountOf lockCount =
    AlarmSystem (initLockableDoorWithLockCountOf lockCount) DisarmedAlarm


initAlarmSystem : AlarmSystem
initAlarmSystem =
    initAlarmSystemWithLockCountOf 1


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


init : Model
init =
    { firstDoor = initLockableDoor
    , secondDoor = initLockableDoor
    , thirdDoor = initLockableDoor
    , fourthDoor = initLockableDoorWithLockCountOf 3
    , firstAlarmSystem = initAlarmSystemWithLockCountOf 2
    }


doorFromLockableDoor : LockableDoor -> Door
doorFromLockableDoor (LockableDoor door _) =
    door


doorFromAlarmSystem : AlarmSystem -> Door
doorFromAlarmSystem (AlarmSystem lockableDoor _) =
    doorFromLockableDoor lockableDoor


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


mapLockableDoorInAlarmSystem : (LockableDoor -> LockableDoor) -> AlarmSystem -> AlarmSystem
mapLockableDoorInAlarmSystem f (AlarmSystem lockableDoor alarm) =
    AlarmSystem (f lockableDoor) alarm


mapAlarmInAlarmSystem : (Alarm -> Alarm) -> AlarmSystem -> AlarmSystem
mapAlarmInAlarmSystem f (AlarmSystem lockableDoor alarm) =
    AlarmSystem lockableDoor (f alarm)



-- UPDATE
-- ======


type DoorMsg
    = OpenDoorAttempt
    | CloseDoorAttempt


type LockMsg
    = DisengageEngageLockAttempt
    | EngageLockAttempt


type LockableDoorMsg
    = LockableDoorLockMsg Int LockMsg
    | LockableDoorDoorMsg DoorMsg


type AlarmMsg
    = ArmAlarmAttempt
    | DisarmAlarmAttempt
    | TriggerAlarmCondition


type AlarmSystemMsg
    = AlarmSystemLockableDoorMsg LockableDoorMsg
    | AlarmSystemAlarmMsg AlarmMsg


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


{-| 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)


{-| The AlarmUpdater is a type that captures an elm-style update function on alarms
that is also parameterized by some particular `dependency`:
-}
type AlarmUpdater dependency
    = AlarmUpdater (dependency -> AlarmMsg -> Alarm -> Alarm)


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


{-| Similarly, here we define a door-wired alarm updater as an alarm updater
which also depends on a door
-}
type alias DoorWiredAlarmUpdater =
    AlarmUpdater Door


{-| 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


updateAutoTriggeringDoorWiredAlarm : DoorWiredAlarmUpdater
updateAutoTriggeringDoorWiredAlarm =
    AlarmUpdater <|
        \door msg alarm ->
            let
                triggerCondition =
                    door == OpenDoor
            in
            case ( alarm, msg ) of
                ( DisarmedAlarm, ArmAlarmAttempt ) ->
                    if triggerCondition then
                        TriggeredAlarm

                    else
                        ArmedAlarm

                ( ArmedAlarm, DisarmAlarmAttempt ) ->
                    DisarmedAlarm

                ( ArmedAlarm, TriggerAlarmCondition ) ->
                    if triggerCondition then
                        TriggeredAlarm

                    else
                        alarm

                ( TriggeredAlarm, DisarmAlarmAttempt ) ->
                    DisarmedAlarm

                _ ->
                    alarm


transitionAlarmWith : AlarmUpdater a -> a -> AlarmMsg -> Alarm -> Alarm
transitionAlarmWith (AlarmUpdater f) =
    f


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


mkUpdateAlarm : AlarmUpdater a -> a -> AlarmMsg -> Alarm -> Alarm
mkUpdateAlarm alarmUpdater =
    transitionAlarmWith alarmUpdater


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


type alias LockableDoorUpdate =
    LockableDoorMsg -> LockableDoor -> LockableDoor


{-| This function updates the alarm system according to the message, but then also
runs the alarm trigger across the updated state to make sure the alarm triggers
when it needs to.
-}
mkUpdateWiredDoorAlarmSystem : LockableDoorUpdate -> DoorWiredAlarmUpdater -> AlarmSystemMsg -> AlarmSystem -> AlarmSystem
mkUpdateWiredDoorAlarmSystem lockableDoorUpdate alarmUpdater msg ((AlarmSystem lockableDoor alarm) as alarmSystem) =
    let
        doorBeforeUpdate =
            doorFromAlarmSystem alarmSystem

        updatedAlarmSystem =
            case msg of
                AlarmSystemLockableDoorMsg lockableDoorMsg ->
                    mapLockableDoorInAlarmSystem
                        (lockableDoorUpdate lockableDoorMsg)
                        alarmSystem

                AlarmSystemAlarmMsg alarmMsg ->
                    mapAlarmInAlarmSystem
                        (mkUpdateAlarm alarmUpdater doorBeforeUpdate alarmMsg)
                        alarmSystem

        doorAfterUpdate =
            doorFromAlarmSystem updatedAlarmSystem
    in
    mapAlarmInAlarmSystem
        (mkUpdateAlarm alarmUpdater doorAfterUpdate TriggerAlarmCondition)
        updatedAlarmSystem


updateMultilockWiredDoorAlarmSystem : AlarmSystemMsg -> AlarmSystem -> AlarmSystem
updateMultilockWiredDoorAlarmSystem =
    mkUpdateWiredDoorAlarmSystem updateLatchLockDoor updateAutoTriggeringDoorWiredAlarm


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 }

        FirstAlarmSystemMsg alarmSystemMsg ->
            { model | firstAlarmSystem = updateMultilockWiredDoorAlarmSystem alarmSystemMsg model.firstAlarmSystem }



-- 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 ]


alarmView : Alarm -> Html AlarmMsg
alarmView alarm =
    let
        ( msg, buttonTxt, doorStateTxt ) =
            case alarm of
                ArmedAlarm ->
                    ( DisarmAlarmAttempt, "Disarm", "Armed" )

                DisarmedAlarm ->
                    ( ArmAlarmAttempt, "Arm", "Disarmed" )

                TriggeredAlarm ->
                    ( DisarmAlarmAttempt, "Disarm", "Triggered!" )
    in
    div []
        [ div [] [ text doorStateTxt ]
        , button [ onClick msg ] [ text buttonTxt ]
        ]


alarmSystemView : AlarmSystem -> Html AlarmSystemMsg
alarmSystemView (AlarmSystem lockableDoor alarm) =
    let
        renderedLockableDoor =
            Html.map AlarmSystemLockableDoorMsg (lockableDoorView lockableDoor)

        renderedAlarm =
            Html.map AlarmSystemAlarmMsg (alarmView alarm)
    in
    div []
        [ text "Alarm: ", renderedAlarm, text "Lockable Door: ", renderedLockableDoor ]


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)

        firstAlarmSystemRender =
            Html.map
                FirstAlarmSystemMsg
                (alarmSystemView model.firstAlarmSystem)
    in
    div []
        [ h2 [] [ text "Deadlock..." ]
        , firstLockViewRender
        , h2 [] [ text "Broken lock..." ]
        , secondLockViewRender
        , h2 [] [ text "Latching lock..." ]
        , thirdLockViewRender
        , h2 [] [ text "Multiple Latching locks..." ]
        , fourthLockViewRender
        , h2 [] [ text "Alarm System" ]
        , firstAlarmSystemRender
        ]