Permalink
Browse files

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

  • Loading branch information...
folkertdev committed Jul 20, 2016
1 parent ea9587b commit fe036f4894034bebba08d4a5212a55992fcfdac9
Showing with 75 additions and 84 deletions.
  1. +41 −38 outmsg/GifGame.elm
  2. +34 −46 outmsg/Main.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)
@@ -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 =

0 comments on commit fe036f4

Please sign in to comment.