rewrite outmsg/ to use the OutMessage packagesee the commit for changes

outmsg/GifGame.elm

@@ -1,4 +1,6 @@
-module GifGame exposing (Model, InternalMsg, init, Translator, translator, view, update)
+module GifGame exposing (update, view, init, Model, OutMsg(..), Msg)
+
+-- (Model, InternalMsg, init, Translator, translator, view, update)
 
 import Html exposing (Html, div, text, p, button, input, br, img)
 import Html.App exposing (program)
@@ -19,7 +21,7 @@ type alias Model =
     }
 
 
-type InternalMsg
+type Msg
     = TextChanged String
     | MakeGuess
     | GifError Http.Error
@@ -32,36 +34,33 @@ type OutMsg
     | PlayerLoss
 
 
-type Msg
-    = ForSelf InternalMsg
-    | ForParent OutMsg
-
 
-type alias TranslationDictionary parentMsg =
-    { onInternalMessage : InternalMsg -> parentMsg
-    , onPlayerWin : Int -> parentMsg
-    , onPlayerLose : parentMsg
-    }
+{-
+      type alias TranslationDictionary parentMsg =
+          { onInternalMessage : InternalMsg -> parentMsg
+          , onPlayerWin : Int -> parentMsg
+          , onPlayerLose : parentMsg
+          }
 
 
-type alias Translator parentMsg =
-    Msg -> parentMsg
+   type alias Translator parentMsg =
+       Msg -> parentMsg
 
 
-translator : TranslationDictionary parentMsg -> Translator parentMsg
-translator { onInternalMessage, onPlayerWin, onPlayerLose } msg =
-    case msg of
-        ForSelf internal ->
-            onInternalMessage internal
+   translator : TranslationDictionary parentMsg -> Translator parentMsg
+   translator { onInternalMessage, onPlayerWin, onPlayerLose } msg =
+       case msg of
+           ForSelf internal ->
+               onInternalMessage internal
 
-        ForParent (PlayerWin score) ->
-            onPlayerWin score
-
-        ForParent PlayerLoss ->
-            onPlayerLose
+           ForParent (PlayerWin score) ->
+               onPlayerWin score
 
+           ForParent PlayerLoss ->
+               onPlayerLose
 
 
+-}
 -- INIT
 
 
@@ -85,8 +84,8 @@ view model =
     div [ style [ ( "display", "block" ), ( "padding", "20px" ) ] ]
         [ img [ src model.gifUrl ] []
         , br [] []
-        , input [ onInput (ForSelf << TextChanged) ] []
-        , button [ onClick (ForSelf MakeGuess) ] [ text "Guess!" ]
+        , input [ onInput (TextChanged) ] []
+        , button [ onClick (MakeGuess) ] [ text "Guess!" ]
         , p [] [ text ("Guesses left: " ++ toString model.guessesLeft) ]
         ]
 
@@ -95,42 +94,46 @@ view model =
 -- UPDATE
 
 
-update : InternalMsg -> Model -> ( Model, Cmd Msg )
+update : Msg -> Model -> ( Model, Cmd Msg, Maybe OutMsg )
 update msg model =
     case msg of
         TextChanged newText ->
-            { model | currentGuess = newText } ! []
+            ( { model | currentGuess = newText }, Cmd.none, Nothing )
 
         GifError _ ->
-            ( model, getRandomGif model.currentTopic )
+            ( model, getRandomGif model.currentTopic, Nothing )
 
         NewTopic topic ->
-            { model | currentTopic = topic } ! [ getRandomGif topic ]
+            ( { model | currentTopic = topic }, getRandomGif topic, Nothing )
 
         NewGif gifUrl ->
-            { model | gifUrl = gifUrl } ! []
+            ( { model | gifUrl = gifUrl }, Cmd.none, Nothing )
 
         MakeGuess ->
             let
                 newGame =
                     { initialModel | currentGuess = model.currentGuess }
             in
                 if model.currentGuess == model.currentTopic then
-                    newGame ! [ getRandomTopic, generateParentMsg (PlayerWin model.guessesLeft) ]
+                    ( newGame, getRandomTopic, Just <| PlayerWin model.guessesLeft )
                 else if model.guessesLeft == 1 then
-                    newGame ! [ getRandomTopic, generateParentMsg PlayerLoss ]
+                    ( newGame, getRandomTopic, Just PlayerLoss )
                 else
-                    { model | guessesLeft = model.guessesLeft - 1 } ! []
+                    ( { model | guessesLeft = model.guessesLeft - 1 }, Cmd.none, Nothing )
 
 
 never : Never -> a
 never n =
     never n
 
 
-generateParentMsg : OutMsg -> Cmd Msg
-generateParentMsg outMsg =
-    Task.perform never ForParent (Task.succeed outMsg)
+
+{-
+   generateParentMsg : OutMsg -> Cmd Msg
+   generateParentMsg outMsg =
+       Task.perform never ForParent (Task.succeed outMsg)
+
+-}
 
 
 getRandomTopic : Cmd Msg
@@ -146,7 +149,7 @@ getRandomTopic =
         randomTopicGenerator =
             choices topicGenerators
     in
-        Random.generate (ForSelf << NewTopic) randomTopicGenerator
+        Random.generate (NewTopic) randomTopicGenerator
 
 
 getRandomGif : String -> Cmd Msg
@@ -159,4 +162,4 @@ getRandomGif topic =
         url =
             "http://api.giphy.com/v1/gifs/random?api_key=dc6zaTOxFJmzC&tag=" ++ topic
     in
-        Cmd.map ForSelf <| Task.perform GifError NewGif (Http.get decodeGifUrl url)
+        Task.perform GifError NewGif (Http.get decodeGifUrl url)

outmsg/Main.elm

@@ -1,10 +1,11 @@
 module Main exposing (..)
 
-import GifGame as G
+import GifGame as G exposing (OutMsg(..))
 import Html exposing (Html, div, button, text)
 import Html.App exposing (program)
 import Html.Attributes exposing (style)
 import Html.Events exposing (onClick)
+import OutMessage
 
 
 -- We have two players playing the game, and keep track
@@ -29,34 +30,35 @@ type Player
   The IncreaseScore and Penalize messages will be generated from within the GifGame component, whereas the Reset message will be generated from Main. The beauty of the Translator pattern is that this doesn't matter: we just list all the messages we will have to handle.
 -}
 type Msg
-    = GameMsg Player G.InternalMsg
-    | IncreaseScore Player Int
-    | Penalize Player
-    | Reset
+    = Reset
+    | GameMsg Player G.Msg
 
 
 {-| Here we present a slight variation on the pattern described in the article. Since we have two players, and therefore two active instances of the GifGame component, we will provide two different translators, one that translates GifGame messages into messages about player 1, and one that translates them into messages about player 2.
 
   The `translator` function is where this happens -- it takes in a player, and creates a custom translator for that player. Note that the child component doesn't know anything about the Player type, or that it has more than one instance.
 -}
-translator : Player -> G.Translator Msg
-translator pl =
+interpretOutMsg : Player -> G.OutMsg -> Model -> ( Model, Cmd Msg )
+interpretOutMsg player outmsg model =
     let
-        translationDictionary =
-            { onInternalMessage = GameMsg pl
-            , onPlayerWin = IncreaseScore pl
-            , onPlayerLose = Penalize pl
-            }
-    in
-        G.translator translationDictionary
-
-
-p1Translator =
-    translator P1
+        modifyP f model =
+            case player of
+                P1 ->
+                    { model | p1Score = f model.p1Score }
 
+                P2 ->
+                    { model | p2Score = f model.p2Score }
+    in
+        case outmsg of
+            PlayerWin score ->
+                ( modifyP (\currentScore -> score + currentScore) model
+                , Cmd.none
+                )
 
-p2Translator =
-    translator P2
+            PlayerLoss ->
+                ( modifyP (\currentScore -> currentScore - 5) model
+                , Cmd.none
+                )
 
 
 {-| As in any Elm app, we need to get initial state and commands from our component. Note that instead of simply Cmd.mapping a "tag" onto the commands we get back, though, we map the translator.
@@ -75,8 +77,8 @@ init =
         , p1Score = 0
         , p2Score = 0
         }
-            ! [ Cmd.map p1Translator p1Commands
-              , Cmd.map p2Translator p2Commands
+            ! [ Cmd.map (GameMsg P1) p1Commands
+              , Cmd.map (GameMsg P2) p2Commands
               ]
 
 
@@ -97,43 +99,29 @@ view model =
             style [ ( "background-color", backgroundColor ) ]
     in
         div [ bgColorStyle ]
-            [ Html.App.map p1Translator (G.view model.p1Game)
-            , Html.App.map p2Translator (G.view model.p2Game)
+            [ Html.App.map (GameMsg P1) (G.view model.p1Game)
+            , Html.App.map (GameMsg P2) (G.view model.p2Game)
             , button [ onClick Reset ] [ text "Reset everything" ]
             ]
 
 
 update : Msg -> Model -> ( Model, Cmd Msg )
 update msg model =
     case msg of
-        IncreaseScore P1 amt ->
-            { model | p1Score = model.p1Score + amt } ! []
-
-        IncreaseScore P2 amt ->
-            { model | p2Score = model.p2Score + amt } ! []
-
-        Penalize P1 ->
-            { model | p1Score = model.p1Score - 5 } ! []
-
-        Penalize P2 ->
-            { model | p2Score = model.p2Score - 5 } ! []
-
         Reset ->
             init
 
         GameMsg P1 internal ->
-            let
-                ( p1Game', cmd ) =
-                    G.update internal model.p1Game
-            in
-                { model | p1Game = p1Game' } ! [ Cmd.map p1Translator cmd ]
+            G.update internal model.p1Game
+                |> OutMessage.mapCmd (GameMsg P1)
+                |> OutMessage.mapComponent (\newP1 -> { model | p1Game = newP1 })
+                |> OutMessage.evaluateMaybe (interpretOutMsg P1) Cmd.none
 
         GameMsg P2 internal ->
-            let
-                ( p2Game', cmd ) =
-                    G.update internal model.p2Game
-            in
-                { model | p2Game = p2Game' } ! [ Cmd.map p2Translator cmd ]
+            G.update internal model.p2Game
+                |> OutMessage.mapCmd (GameMsg P2)
+                |> OutMessage.mapComponent (\newP2 -> { model | p2Game = newP2 })
+                |> OutMessage.evaluateMaybe (interpretOutMsg P2) Cmd.none
 
 
 main =