laserpants / elm-update-pipeline / Update.Pipeline.Extended

This module introduces a simple callback utility that allows information to be passed upwards in the model-update hierarchy. The pattern is similar to event handling in object-oriented languages, in the sense that we can think of a nested model as an event source, and of the parent as a listener. The event listener is then able to respond to state changes by hooking into the event source via one or more callbacks (event handlers).

Usage example:

The following example shows how to implement an update function with support for callbacks. Scroll down for explanations of the indicated points in the code.

module Main exposing (..)

import Browser exposing (Document, document)
import Html exposing (Html, button, span, text)
import Html.Attributes as Attributes
import Html.Events exposing (onClick)
import Update.Pipeline exposing (..)
import Update.Pipeline.Extended exposing (..)

type FeatureMsg
    = OnClick Bool

type alias Feature =
    {}

initFeature : ( Feature, Cmd FeatureMsg )
initFeature =
    save {}

{- #1 -}
updateFeature :
    FeatureMsg
    -> { onClick : Bool -> a }
    -> Extended Feature a
    -> ( Extended Feature a, Cmd FeatureMsg )
updateFeature msg { onClick } model =
    case msg of
        OnClick choice ->
            {- #2 -}
            model
                |> call (onClick choice)

viewFeature : Feature -> Html FeatureMsg
viewFeature _ =
    span []
        [ button
            [ onClick (OnClick True) ]
            [ text "Yay" ]
        , button
            [ onClick (OnClick False) ]
            [ text "Nay" ]
        ]

type Msg
    = FeatureMsg FeatureMsg

type alias Model =
    { feature : Feature
    , clicked : Bool
    , choice : Maybe Bool
    }

insertAsFeatureIn : Model -> Feature -> ( Model, Cmd Msg )
insertAsFeatureIn model feature =
    save { model | feature = feature }

{- #3 -}
inFeature : Run Model Feature Msg FeatureMsg a
inFeature =
    runStack .feature insertAsFeatureIn FeatureMsg

init : () -> ( Model, Cmd Msg )
init () =
    map3 Model
        (mapCmd FeatureMsg initFeature)
        (save False)
        (save Nothing)

{- #4 -}
handleClick :
    Bool
    -> Model
    -> ( Model, Cmd Msg )
handleClick choice model =
    save
        { model
            | clicked = True
            , choice = Just choice
        }

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        FeatureMsg featureMsg ->
            {- #5 -}
            model
                |> inFeature
                    (updateFeature featureMsg
                        { onClick = handleClick }
                    )

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

view : Model -> Document Msg
view { feature, clicked, choice } =
    { title = ""
    , body =
        [ if clicked then
            let
                choiceStr =
                    case choice of
                        Just True ->
                            "yay"

                        _ ->
                            "nay"
            in
            text ("You chose " ++ choiceStr ++ "!")

          else
            Html.map FeatureMsg (viewFeature feature)
        ]
    }

main : Program () Model Msg
main =
    document
        { init = init
        , update = update
        , subscriptions = subscriptions
        , view = view
        }

Explanation:

  1. The update function is atypical in the following ways:

    • Instead of the usual

      msg -> m -> ( m, Cmd msg )
      

      … we change the type so that it ends with

      Extended m a -> ( Extended m a, Cmd msg )
      
    • The second argument is a record containing a callback

      onClick : Bool -> a
      

      In general, we can have any number of these functions. The type of a callback is always of the form

      arg1 -> arg2 -> ... -> a
      
  2. Using call, we add a function to the list of callbacks, which is eventually returned together with the model. Think of this simply as invoking the callback.

  3. Partially applied, runStack gives us a function that takes care of updating the nested Feature model in a way that also accommodates for the extra callback structure. The actual type of the resulting function is slightly complicated, so we’ll typically use the Run alias to make things more readable.

  4. The handler’s type has to match that of the callback. The type parameter a is expanded to m -> ( m, Cmd msg ), where m is the type of the parent model. So, in this example

    Bool -> a
    

    … becomes

    Bool -> Model -> ( Model, Cmd Msg )
    
  5. Finally, in the parent model’s update function, we use the inFeature helper (see #3) to update the nested model and apply the callbacks.

Types


type alias Extended m a =
( m, List a )

An extended model is a model paired with a list of callbacks — functions that are applied to the parent model after an update.


type alias Stack m m1 msg msg1 a =
Extended m1 a -> ( Extended m1 (m -> ( m
, Platform.Cmd.Cmd msg ))
, Platform.Cmd.Cmd msg1 
}

Represents an update where callbacks may be present.


type alias Run m m1 msg msg1 a =
Stack m m1 msg msg1 a -> m -> ( m
, Platform.Cmd.Cmd msg 
}

An alias that helps making type signatures less verbose in client code. See runStack for an example of how to use this.

Callback Interface

call : c -> Extended a c -> ( Extended a c, Platform.Cmd.Cmd msg )

Invoke a callback in an extended update function. That is, one that returns an ( Extended a c, Cmd msg ) value, as opposed to the usual ( a, Cmd msg ) pair.

See also andCall.

sequenceCalls : Extended a (a -> ( a, Platform.Cmd.Cmd msg )) -> ( a, Platform.Cmd.Cmd msg )

Compose and apply the list of functions (callbacks) accumulated by a nested update call. Usually it is not necessary to use this function directly in client code. Instead, see runStack.

See also sequence in Update.Pipeline. This function is identical to uncurry (flip sequence).

runStack : (a -> m1) -> (a -> m1 -> ( m, Platform.Cmd.Cmd msg )) -> (msg1 -> msg) -> Stack m m1 msg msg1 b -> a -> ( m, Platform.Cmd.Cmd msg )

Some amount of glue code is required to update a nested model, and subsequently apply the resulting callbacks to the outer model. runStack takes care of those internals. Typically, it is partially applied with the first three arguments:

getter : outer -> inner
setter : outer -> inner -> ( outer, Cmd msg )
toMsg : msg1 -> msg

Here is an example:

updateInner :
    InnerMsg
    -> { onComplete : Message -> a
       , onError : Error -> a
       }
    -> Extended InnerModel
    -> ( Extended InnerModel, Cmd InnerMsg )
updateInner =
    -- ...

type Msg
    = InnerMsg InnerMsg

type alias Model =
    { inner : InnerModel
    }

inInner : Run Model InnerModel Msg InnerMsg a
inInner =
    runStack
        .inner
        (\m inner -> save { m | inner = inner })
        InnerMsg

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        InnerMsg innerMsg ->
            model
                |> inInner (updateInner innerMsg)

See also Run, runStackExtended.

runStackE : (d -> m1) -> (d -> a -> ( b, Platform.Cmd.Cmd msg )) -> (msg1 -> msg) -> (Extended m1 f -> ( Extended a (Extended b c -> ( Extended b c, Platform.Cmd.Cmd msg )), Platform.Cmd.Cmd msg1 )) -> Extended d c -> ( Extended b c, Platform.Cmd.Cmd msg )

DEPRECATED: Use runStackExtended instead.

runStackExtended : (d -> m1) -> (d -> a -> ( b, Platform.Cmd.Cmd msg )) -> (msg1 -> msg) -> (Extended m1 f -> ( Extended a (Extended b c -> ( Extended b c, Platform.Cmd.Cmd msg )), Platform.Cmd.Cmd msg1 )) -> Extended d c -> ( Extended b c, Platform.Cmd.Cmd msg )

A version of runStack that can be used when both the child’s and the parent’s update functions are of the extended type.

Here is a modified version of the example from the documentation for runStack:

updateInner :
    InnerMsg
    -> { onComplete : Message -> a
       , onError : Error -> a
       }
    -> Extended InnerModel
    -> ( Extended InnerModel, Cmd InnerMsg )
updateInner =
    -- ...

inInner : Run (Extended Model c) InnerModel Msg InnerMsg a
inInner =
    runStackExtended
        .inner
        (\m inner -> save { m | inner = inner })
        InnerMsg

update :
    Msg
    -> Extended Model c
    -> ( Extended Model c, Cmd Msg )
update msg model =
    -- ...

extend : a -> Extended a c

Create an extended model without any callbacks.

mapE : (a -> b) -> Extended a c -> Extended b c

Map a function a -> b over an Extended a * model.

mapE2 : (a -> b -> c) -> Extended a d -> Extended b d -> Extended c d

A version of mapE that takes a function of two arguments as input.

mapE3 : (a -> b -> c -> d) -> Extended a e -> Extended b e -> Extended c e -> Extended d e

A version of mapE that takes a function of three arguments as input.

lift : (a -> ( b, Platform.Cmd.Cmd msg )) -> Extended a c -> ( Extended b c, Platform.Cmd.Cmd msg )

Take an effectful update function (a -> ( b, Cmd msg )) and transform it into one that instead operates on Extended a c values and returns an ( Extended b c, Cmd msg ) pair.

Aside: This function behaves like traverse in the Traversable type class in Haskell, when we think of updates (a -> ( b, Cmd msg )) as monadic functions a -> m b.

See also andLift.

lift2 : (a -> b -> ( c, Platform.Cmd.Cmd msg )) -> Extended a d -> Extended b d -> ( Extended c d, Platform.Cmd.Cmd msg )

A version of lift for functions of two arguments.

lift3 : (a -> b -> c -> ( d, Platform.Cmd.Cmd msg )) -> Extended a e -> Extended b e -> Extended c e -> ( Extended d e, Platform.Cmd.Cmd msg )

A version of lift for functions of three arguments.

Shortcuts

andCall : c -> ( Extended a c, Platform.Cmd.Cmd msg ) -> ( Extended a c, Platform.Cmd.Cmd msg )

Shortcut for andThen <<call.

andLift : (a -> ( b, Platform.Cmd.Cmd msg )) -> ( Extended a c, Platform.Cmd.Cmd msg ) -> ( Extended b c, Platform.Cmd.Cmd msg )

Shortcut for andThen <<lift.

Pointfree Helpers

choosing : (a -> Extended a c -> b) -> Extended a c -> b

A version of using that works with Extended values.