Child.elm

module Child exposing (..)

import Html exposing (..)
import Html.Events exposing (..)

-- Internal messages (which will usually be 90% of the messages) are dealt with like normal unlike the Translator pattern
type Msg
  = A
  | B
  | Dispatch OutMsg


type alias Model =
  { a : Int
  , b : Int
  }


-- The child component gets to define its "external" api
type OutMsg
  = Beep
  | Boop


init : Model
init =
  { a = 0
  , b = 0
  }


update : Msg -> Model -> (Model, Cmd Msg) 
update msg model =
  case msg of
    A ->
      { model | a = model.a + 1 } ! []
    
    B ->
      { model | b = model.b + 1 } ! []
    
    -- This line is really the only bit of unecessary boilerplate
    Dispatch outMsg ->
      model ! []


view : Model -> Html Msg
view { a, b } =
  div
    []
    [ text "I am the child"
    , br [] []
    , button
      [ onClick A ] -- Internal messages (which will usually be 90% of the messages) are sent like normal
      [ text "A" ]
    , text <| " count " ++ toString a
    , br [] []
    , button
      [ onClick B ] -- Internal messages (which will usually be 90% of the messages) are sent like normal
      [ text "B" ]
    , text <| " count " ++ toString b
    , br [] []
    , button
      [ onClick <| Dispatch Beep ] -- Dispatch the OutMsg to the parent
      [ text "Make the parent beep" ]
    ]

Dispatch.elm

module Dispatch exposing (..)

dispatch : (msg -> model -> ( model, Cmd msg )) -> model -> Maybe msg -> ( model, Cmd msg )
dispatch update model maybeMsg =
  case maybeMsg of
    Just msg ->
      update msg model
    
    Nothing ->
      model ! []

Main.elm

module Main exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Child exposing (..)
import Dispatch exposing (dispatch)

main =
  Html.program
    { init = init
    , subscriptions = always (Sub.none)
    , update = update
    , view = view
    }


type Msg
  = ChildMsg Child.Msg
  | Beep


type alias Model =
  { beep : Int
  , childModel : Child.Model
  }


init : ( Model, Cmd Msg )
init =
  { beep = 0
  , childModel = Child.init
  } ! []


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
  case msg of
    -- This catches dispatched messages and re-routes them to real messages in the Main update.  Because we use the case
    -- we get exhaustive type-checking.
    ChildMsg (Dispatch outMsg) ->
      dispatch update model <| case outMsg of
        Child.Beep -> Just Beep
        Child.Boop -> Nothing

    -- This is the normal Elm code to route message to a child component
    ChildMsg childMsg ->
      let
        (newChildModel, cmd) =
          Child.update childMsg model.childModel
      in
        { model | childModel = newChildModel } ! [ Cmd.map ChildMsg cmd ]

    Beep ->
      { model | beep = model.beep + 1 } ! []


view : Model -> Html Msg
view { beep, childModel } =
  div
    []
    [ text "I am the parent"
    , if beep > 0 then div [ style [ ("color", "red"), ("font-weight", "bold") ] ] [ text (" BEEPED!!! " ++ toString beep) ] else div [] []
    , br [] []
    , Html.map ChildMsg (Child.view childModel)
    ]