Instantly share code, notes, and snippets.

@alex-lew /Child.elm Secret
Last active Mar 27, 2018

Embed
What would you like to do?
Preliminary (ugly) demo of Translator pattern
module Child exposing (Translator, update, view, init, translator, Model, Msg, InternalMsg)
import Html exposing (Html, div, p, text)
import Html.Attributes exposing (style)
import Html.Events exposing (onClick)
import Html.App
type OutMsg
= ShowPopup
type InternalMsg
= Increment
| Decrement
type alias Model =
Int
type Msg
= ForSelf InternalMsg
| ForParent OutMsg
type alias TranslationDictionary msg =
{ onInternalMessage : InternalMsg -> msg
, onShowPopup : msg
}
type alias Translator msg =
Msg -> msg
init =
0
translator : TranslationDictionary msg -> Translator msg
translator { onInternalMessage, onShowPopup } msg =
case msg of
ForSelf internal ->
onInternalMessage internal
ForParent ShowPopup ->
onShowPopup
view : Model -> Html Msg
view model =
div [ style [ ( "display", "block" ), ( "width", "100px" ), ( "height", "300px" ), ( "background-color", "red" ) ] ]
[ p [ onClick (ForSelf Increment) ] [ text "increment" ]
, p [] [ text (toString model) ]
, p [ onClick (ForSelf Decrement) ] [ text "decrement" ]
, p [ onClick (ForParent ShowPopup) ] [ text "show me a popup" ]
]
update : InternalMsg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Increment ->
(model + 1) ! []
Decrement ->
(model - 1) ! []
module Main exposing (..)
import Child
import Html exposing (Html, div, text)
import Html.App
import Html.Attributes exposing (style)
import Html.Events exposing (onClick)
type Msg
= ChildMsg Child.InternalMsg
| ShowPopup
| ChangeColor
type alias Model =
{ child : Child.Model
, color : String
, popupShowing : Bool
}
childTranslator : Child.Translator Msg
childTranslator =
Child.translator { onInternalMessage = ChildMsg, onShowPopup = ShowPopup }
main =
Html.App.program { init = init, subscriptions = \_ -> Sub.none, view = view, update = update }
init : ( Model, Cmd Msg )
init =
{ child = Child.init, color = "blue", popupShowing = False } ! []
changeColorLink : Html Msg
changeColorLink =
div [ onClick ChangeColor ] [ text "Click to change bg color" ]
popup : Html Msg
popup =
div [ style [ ( "display", "block" ), ( "background-color", "green" ), ( "height", "300px" ), ( "width", "300px" ) ] ]
[ text "A popup" ]
view : Model -> Html Msg
view model =
div [ style [ ( "height", "500px" ), ( "background-color", model.color ) ] ]
[ Html.App.map childTranslator (Child.view model.child)
, if model.popupShowing then
popup
else
changeColorLink
]
switchColor : String -> String
switchColor color =
if color == "red" then
"blue"
else
"red"
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
ChildMsg internal ->
let
( child', cmd ) =
Child.update internal model.child
in
{ model | child = child' } ! [ Cmd.map childTranslator cmd ]
ChangeColor ->
{ model | color = switchColor model.color } ! []
ShowPopup ->
{ model | popupShowing = True } ! []
@waratuman

This comment has been minimized.

Show comment
Hide comment
@waratuman

waratuman Mar 27, 2018

👍 This is great.

waratuman commented Mar 27, 2018

👍 This is great.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment