|
port module Main exposing (main) |
|
|
|
import Html exposing (Html) |
|
import Html.Events exposing (onClick) |
|
import Http |
|
import Json.Decode as Decode exposing (Decoder, Value) |
|
import Json.Encode as Encode |
|
|
|
|
|
port toElm : (Value -> msg) -> Sub msg |
|
|
|
|
|
type alias Model = |
|
{} |
|
|
|
|
|
type Intent |
|
= AskWhoIsTheKingInTheNorth |
|
| Incoming Value |
|
| StateFact Fact |
|
|
|
|
|
type Fact |
|
= GotAnswer (Result Http.Error Character) |
|
|
|
|
|
type Effect |
|
= GoFetchJonSnow |
|
|
|
|
|
|
|
-- Ambition, Challenge, Consequence, Effect, Endeavor, Motivation, Procedure, Quest, Saga, SideEffect, Venture |
|
|
|
|
|
type alias Character = |
|
{ name : String |
|
, titles : List String |
|
} |
|
|
|
|
|
decodeCharacter : Decoder Character |
|
decodeCharacter = |
|
Decode.map2 Character |
|
(Decode.field "name" Decode.string) |
|
(Decode.field "titles" (Decode.list Decode.string)) |
|
|
|
|
|
main : Program Value Model Intent |
|
main = |
|
Html.programWithFlags <| |
|
wrap |
|
{ apply = apply |
|
, init = init |
|
, interpret = interpret |
|
, join = StateFact |
|
, produce = produce |
|
, subscriptions = subscriptions |
|
, view = view |
|
} |
|
|
|
|
|
subscriptions : Model -> Sub Intent |
|
subscriptions model = |
|
Sub.batch |
|
[ toElm Incoming |
|
] |
|
|
|
|
|
init : Value -> ( Model, List Fact, List Effect ) |
|
init flags = |
|
( {}, [], [] ) |
|
|
|
|
|
apply : Fact -> Model -> Model |
|
apply fact model = |
|
case fact of |
|
GotAnswer (Ok { name, titles }) -> |
|
Debug.log (name ++ "/" ++ String.join "," titles) |
|
model |
|
|
|
GotAnswer (Err reason) -> |
|
Debug.log ("Couldn't find the answer: " ++ toString reason) |
|
model |
|
|
|
|
|
interpret : Intent -> Model -> ( List Fact, List Effect ) |
|
interpret intent model = |
|
case intent of |
|
AskWhoIsTheKingInTheNorth -> |
|
( [], [ GoFetchJonSnow ] ) |
|
|
|
Incoming json -> |
|
( [], [] ) |
|
|
|
StateFact fact -> |
|
( [ fact ], [] ) |
|
|
|
|
|
produce : Effect -> Model -> Cmd Fact |
|
produce fx model = |
|
case fx of |
|
GoFetchJonSnow -> |
|
let |
|
request = |
|
Http.get |
|
"https://anapioficeandfire.com/api/characters/583" |
|
decodeCharacter |
|
in |
|
Http.send GotAnswer request |
|
|
|
|
|
view : Model -> Html Intent |
|
view model = |
|
Html.button |
|
[ onClick AskWhoIsTheKingInTheNorth |
|
] |
|
[ Html.text "The King in the North!" |
|
] |
|
|
|
|
|
|
|
-- Helpers |
|
|
|
|
|
wrap setup = |
|
let |
|
merge = |
|
do setup.apply setup.produce |
|
|
|
coalesce ( model, cmd ) = |
|
( model, Cmd.map setup.join cmd ) |
|
|
|
doInit ( model, facts, fxs ) = |
|
merge model ( facts, fxs ) |> coalesce |
|
|
|
init flags = |
|
setup.init flags |> doInit |
|
|
|
update intent model = |
|
setup.interpret intent model |> merge model |> coalesce |
|
in |
|
{ init = init |
|
, subscriptions = setup.subscriptions |
|
, update = update |
|
, view = setup.view |
|
} |
|
|
|
|
|
type alias ProduceEffect fx fact model = |
|
fx -> model -> Cmd fact |
|
|
|
|
|
type alias ApplyFact fact model = |
|
fact -> model -> model |
|
|
|
|
|
do : ApplyFact fact model -> ProduceEffect fx fact model -> model -> ( List fact, List fx ) -> ( model, Cmd fact ) |
|
do apply produce model ( facts, fxs ) = |
|
mergeFxs produce (List.foldl apply model facts) Cmd.none fxs |
|
|
|
|
|
mergeFxs : ProduceEffect fx fact model -> model -> Cmd fact -> List fx -> ( model, Cmd fact ) |
|
mergeFxs produce model cmd fxs = |
|
case fxs of |
|
fx :: rest -> |
|
mergeFxs produce model (Cmd.batch [ cmd, produce fx model ]) rest |
|
|
|
[] -> |
|
( model, cmd ) |