|
port module ElmFsaPorts exposing (main) |
|
|
|
import Html exposing (Html, text) |
|
import Json.Decode as Decode exposing (Decoder, Value) |
|
import Json.Encode as Encode |
|
|
|
|
|
port fromElm : Value -> Cmd msg |
|
|
|
|
|
port toElm : (Value -> msg) -> Sub msg |
|
|
|
|
|
type alias SayHelloData = |
|
{ who : String |
|
} |
|
|
|
|
|
type Msg |
|
= Incoming Value |
|
| SayHello SayHelloData |
|
| Unknown String |
|
|
|
|
|
type alias Model = |
|
{ greeting : Maybe String |
|
} |
|
|
|
|
|
main : Program Never Model Msg |
|
main = |
|
Html.program |
|
{ init = ( { greeting = Nothing }, Cmd.none ) |
|
, subscriptions = subscriptions |
|
, update = update |
|
, view = view |
|
} |
|
|
|
|
|
subscriptions : Model -> Sub Msg |
|
subscriptions model = |
|
-- (A.2), (B.2), (C.2) Flowing the subscription data into `update` |
|
Sub.batch |
|
[ toElm Incoming |
|
] |
|
|
|
|
|
update : Msg -> Model -> ( Model, Cmd Msg ) |
|
update msg model = |
|
case msg of |
|
Incoming json -> |
|
-- Note that recursively calling `update` is probably |
|
-- not something you would do normally but I think here |
|
-- its use is justified because we can keep all pattern |
|
-- matches for `Msg` on the same level. Otherwise we would |
|
-- either need to nest the `update` further or resort to |
|
-- the "create a Cmd out of a Msg" anti-pattern. |
|
-- Just keep in mind that doing this might result in infinite |
|
-- recursion, so either *never* return an `Incoming` from your |
|
-- decoder or take a different approach, if you're not |
|
-- confident that this convention will hold in a team setting |
|
|
|
-- (A.3), (B.3), (C.3) Mapping incoming JSON to `Msg` |
|
update (decodeAction json) model |
|
|
|
SayHello { who } -> |
|
-- (A.9) Decoded `SayHello` can be processed! |
|
let |
|
answer = |
|
createAction |
|
"ANSWER" |
|
(Encode.string ("Good to see you too " ++ who ++ "!")) |
|
in |
|
-- (A.10) `fromElm` port will channel the answer to the JS subscription |
|
( { model | greeting = Just who }, fromElm answer ) |
|
|
|
Unknown reason -> |
|
-- (B.8), (C.8) The `Unknown` `Msg` carries a reason that we channel back to JS |
|
let |
|
answer = |
|
createAction |
|
"BLOWUP" |
|
(Encode.string ("Something went wrong: " ++ reason)) |
|
in |
|
-- (B.9), (C.9) `fromElm` port will channel the answer to the JS subscription |
|
( model, fromElm answer ) |
|
|
|
|
|
view : Model -> Html msg |
|
view { greeting } = |
|
text ("Hello, " ++ Maybe.withDefault "Stranger" greeting ++ "!") |
|
|
|
|
|
|
|
-- # JSON Decoding stuff |
|
-- Don't worry if the JSON decoder stuff doesn't click right away |
|
-- it is something that takes some getting used to. |
|
-- Note that we're using the Flux-Standard-Action nomenclature |
|
-- of calling the JSON being handled an `action`, which is kind |
|
-- of a silly name for data if you think about it :-) |
|
|
|
|
|
decodeAction : Value -> Msg |
|
decodeAction json = |
|
-- (A.4), (B.4), (C.4) |
|
case Decode.decodeValue incomingActionDecoder json of |
|
Ok value -> |
|
-- (A.8) Returning the decoded result |
|
Debug.log "Action decoded successfully!" |
|
value |
|
|
|
Err reason -> |
|
-- (B.7), (C.7) Returning the default `Unknown` `Msg` on decoder failures |
|
Debug.log ("Failed to decode incoming " ++ reason) |
|
(Unknown reason) |
|
|
|
|
|
incomingActionDecoder : Decoder Msg |
|
incomingActionDecoder = |
|
let |
|
decideWhichAction type_ = |
|
case type_ of |
|
"HELLO" -> |
|
-- (A.6) `type` matches "HELLO" so try to decode payload |
|
Decode.map SayHello |
|
(Decode.field "payload" helloPayloadDecoder) |
|
|
|
_ -> |
|
-- (C.6) The structure matches but we don't know about that message type |
|
Decode.fail ("Unknown action " ++ type_) |
|
in |
|
-- (A.5), (B.5), (C.5) Decoding `type` and deciding what to do next |
|
Decode.field "type" Decode.string |
|
-- (B.6) The structure doesn't match, so decoding fails here |
|
|> Decode.andThen decideWhichAction |
|
|
|
|
|
helloPayloadDecoder : Decoder SayHelloData |
|
helloPayloadDecoder = |
|
-- (A.7) Decoding the payload of the "HELLO" FSA |
|
Decode.map SayHelloData |
|
(Decode.field "who" Decode.string) |
|
|
|
|
|
createAction : String -> Value -> Value |
|
createAction type_ payload = |
|
Encode.object |
|
[ ( "type", Encode.string type_ ) |
|
, ( "payload", payload ) |
|
] |