From f86032ff459f57c8cda368b48888a39c848d263b Mon Sep 17 00:00:00 2001 From: Nathanael Sensfelder Date: Sat, 1 Jan 2022 16:32:45 +0100 Subject: Adds JSON decoding. --- elm.json | 1 + src/Comm/LoadStory.elm | 34 ++++++++++++++++++++++++++++++++++ src/ElmModule/Init.elm | 4 +++- src/ElmModule/Update.elm | 22 +++++++++++++++++++++- src/Struct/Event.elm | 5 +++++ src/Tonkadur/Types.elm | 31 +++++++++++++++++++------------ src/Update/Story.elm | 3 +++ 7 files changed, 86 insertions(+), 14 deletions(-) create mode 100644 src/Comm/LoadStory.elm diff --git a/elm.json b/elm.json index 7bb17ea..462aa2c 100644 --- a/elm.json +++ b/elm.json @@ -6,6 +6,7 @@ "elm-version": "0.19.1", "dependencies": { "direct": { + "NoRedInk/elm-json-decode-pipeline": "1.0.1", "elm/browser": "1.0.1", "elm/core": "1.0.2", "elm/html": "1.0.0", diff --git a/src/Comm/LoadStory.elm b/src/Comm/LoadStory.elm new file mode 100644 index 0000000..869d21b --- /dev/null +++ b/src/Comm/LoadStory.elm @@ -0,0 +1,34 @@ +module Comm.LoadStory exposing (request) + +-- Elm ------------------------------------------------------------------------- +import Http + +-- Tonkadur -------------------------------------------------------------------- +import Tonkadur.Json + +-- Local Module ---------------------------------------------------------------- +import Struct.Event + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +request : String -> (Cmd Struct.Event.Type) +request story_url = + (Http.get + { + url = story_url, + expect = + (Http.expectJson + Struct.Event.LoadStory + (Tonkadur.Json.decoder) + ) + } + ) diff --git a/src/ElmModule/Init.elm b/src/ElmModule/Init.elm index 885153a..08c2540 100644 --- a/src/ElmModule/Init.elm +++ b/src/ElmModule/Init.elm @@ -5,6 +5,8 @@ import Struct.Flags import Struct.Event import Struct.Model +import Comm.LoadStory + -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- -------------------------------------------------------------------------------- @@ -15,4 +17,4 @@ import Struct.Model init : Struct.Flags.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type)) init flags = -- TODO: read flags and request story. - ((Struct.Model.new), Cmd.none) + ((Struct.Model.new), (Comm.LoadStory.request "/story/0.json")) diff --git a/src/ElmModule/Update.elm b/src/ElmModule/Update.elm index 3dbad82..d7617bd 100644 --- a/src/ElmModule/Update.elm +++ b/src/ElmModule/Update.elm @@ -1,10 +1,12 @@ module ElmModule.Update exposing (update) -- Elm ------------------------------------------------------------------------- +import Html -- Local Module ---------------------------------------------------------------- import Struct.Event import Struct.Model +import Struct.UI import Update.Story @@ -22,6 +24,24 @@ update : ( ) update event model = case event of - Struct.Event.None -> (model, Cmd.none) (Struct.Event.ChoiceSelected ix) -> ((Update.Story.select_choice ix model), Cmd.none) + + Struct.Event.None -> (model, Cmd.none) + (Struct.Event.LoadStory http_result) -> + case http_result of + (Ok story) -> + ((Update.Story.start {model | tonkadur = story}), Cmd.none) + + (Err error) -> + ( + {model | + ui = + -- TODO: display the actual error. + (Struct.UI.display_error + (Html.text "Failed to load story") + model.ui + ) + }, + Cmd.none + ) diff --git a/src/Struct/Event.elm b/src/Struct/Event.elm index 4493b1a..77fb564 100644 --- a/src/Struct/Event.elm +++ b/src/Struct/Event.elm @@ -1,6 +1,10 @@ module Struct.Event exposing (..) -- Elm ------------------------------------------------------------------------- +import Http + +-- Tonkadur -------------------------------------------------------------------- +import Tonkadur.Types -- Local Module ---------------------------------------------------------------- @@ -10,6 +14,7 @@ module Struct.Event exposing (..) type Type = None | ChoiceSelected Int + | LoadStory (Result Http.Error Tonkadur.Types.State) -------------------------------------------------------------------------------- -- LOCAL ----------------------------------------------------------------------- diff --git a/src/Tonkadur/Types.elm b/src/Tonkadur/Types.elm index 929d848..bf8ae56 100644 --- a/src/Tonkadur/Types.elm +++ b/src/Tonkadur/Types.elm @@ -17,7 +17,6 @@ type alias TextData = effect_parameters : (List Value) } - type RichText = StringText String | AugmentedText TextData @@ -252,18 +251,26 @@ append_option option state = get_default : State -> String -> Value get_default state type_name = - case type_name of - "bool" -> (BoolValue False) - "float" -> (FloatValue 0.0) - "int" -> (IntValue 0) - "text" -> (TextValue (StringText "")) - "string" -> (StringValue "") - "list" -> (ListValue (Dict.empty)) - "ptr" -> (PointerValue []) - other -> - case (Dict.get other state.user_types) of + case (maybe_get_default_primitive type_name) of + (Just value) -> value + Nothing -> + case (Dict.get type_name state.user_types) of (Just default) -> default - Nothing -> (StringValue ("Unknown type '" ++ other ++ "'")) + Nothing -> (StringValue ("Unknown type '" ++ type_name ++ "'")) + +-- Used during the decoding process, prior to 'state' being available, hence +-- its separation from 'get_default'. +maybe_get_default_primitive : String -> (Maybe Value) +maybe_get_default_primitive type_name = + case type_name of + "bool" -> (Just (BoolValue False)) + "float" -> (Just (FloatValue 0.0)) + "int" -> (Just (IntValue 0)) + "text" -> (Just (TextValue (StringText ""))) + "string" -> (Just (StringValue "")) + "list" -> (Just (ListValue (Dict.empty))) + "ptr" -> (Just (PointerValue [])) + _ -> Nothing apply_at_address : ( (List String) -> diff --git a/src/Update/Story.elm b/src/Update/Story.elm index 4d1bfaa..68ed403 100644 --- a/src/Update/Story.elm +++ b/src/Update/Story.elm @@ -1,5 +1,6 @@ module Update.Story exposing ( + start, select_choice, input_string, input_integer, @@ -135,6 +136,8 @@ step model = -------------------------------------------------------------------------------- -- EXPORTED -------------------------------------------------------------------- -------------------------------------------------------------------------------- +start : Struct.Model.Type -> Struct.Model.Type +start model = (step model) select_choice : Int -> Struct.Model.Type -> Struct.Model.Type select_choice ix model = model -- cgit v1.2.3-70-g09d2