From fc09d979e4c753377131684b1100c250e89765ea Mon Sep 17 00:00:00 2001 From: Nathanael Sensfelder Date: Sun, 10 May 2020 18:08:26 +0200 Subject: ... --- src/shared/elm/Action/Ports.elm | 6 --- src/shared/elm/Comm/GoTo.elm | 27 ------------ src/shared/elm/Shared/Action/Ports.elm | 6 +++ src/shared/elm/Shared/Comm/GoTo.elm | 27 ++++++++++++ src/shared/elm/Shared/Struct/Flags.elm | 73 +++++++++++++++++++++++++++++++ src/shared/elm/Shared/Update/Sequence.elm | 37 ++++++++++++++++ src/shared/elm/Shared/Util/Array.elm | 54 +++++++++++++++++++++++ src/shared/elm/Shared/Util/Html.elm | 6 +++ src/shared/elm/Shared/Util/Http.elm | 22 ++++++++++ src/shared/elm/Shared/Util/List.elm | 50 +++++++++++++++++++++ src/shared/elm/Struct/Flags.elm | 73 ------------------------------- src/shared/elm/Util/Array.elm | 54 ----------------------- src/shared/elm/Util/Html.elm | 6 --- src/shared/elm/Util/Http.elm | 22 ---------- src/shared/elm/Util/List.elm | 53 ---------------------- 15 files changed, 275 insertions(+), 241 deletions(-) delete mode 100644 src/shared/elm/Action/Ports.elm delete mode 100644 src/shared/elm/Comm/GoTo.elm create mode 100644 src/shared/elm/Shared/Action/Ports.elm create mode 100644 src/shared/elm/Shared/Comm/GoTo.elm create mode 100644 src/shared/elm/Shared/Struct/Flags.elm create mode 100644 src/shared/elm/Shared/Update/Sequence.elm create mode 100644 src/shared/elm/Shared/Util/Array.elm create mode 100644 src/shared/elm/Shared/Util/Html.elm create mode 100644 src/shared/elm/Shared/Util/Http.elm create mode 100644 src/shared/elm/Shared/Util/List.elm delete mode 100644 src/shared/elm/Struct/Flags.elm delete mode 100644 src/shared/elm/Util/Array.elm delete mode 100644 src/shared/elm/Util/Html.elm delete mode 100644 src/shared/elm/Util/Http.elm delete mode 100644 src/shared/elm/Util/List.elm (limited to 'src/shared/elm') diff --git a/src/shared/elm/Action/Ports.elm b/src/shared/elm/Action/Ports.elm deleted file mode 100644 index 8da9bac..0000000 --- a/src/shared/elm/Action/Ports.elm +++ /dev/null @@ -1,6 +0,0 @@ -port module Action.Ports exposing (..) - -port store_new_session : (String, String) -> (Cmd msg) -port reset_session : () -> (Cmd msg) -port connected: (() -> msg) -> (Sub msg) -port go_to : (String) -> (Cmd msg) diff --git a/src/shared/elm/Comm/GoTo.elm b/src/shared/elm/Comm/GoTo.elm deleted file mode 100644 index ea8d7af..0000000 --- a/src/shared/elm/Comm/GoTo.elm +++ /dev/null @@ -1,27 +0,0 @@ -module Comm.GoTo exposing (decode) - --- Elm ------------------------------------------------------------------------- -import Json.Decode - --- ??? ------------------------------------------------------------------------- -import Struct.ServerReply - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -internal_decoder : String -> Struct.ServerReply.Type -internal_decoder url = (Struct.ServerReply.GoTo url) - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -decode : (Json.Decode.Decoder Struct.ServerReply.Type) -decode = - (Json.Decode.map - (internal_decoder) - (Json.Decode.field "url" (Json.Decode.string)) - ) diff --git a/src/shared/elm/Shared/Action/Ports.elm b/src/shared/elm/Shared/Action/Ports.elm new file mode 100644 index 0000000..0f87da5 --- /dev/null +++ b/src/shared/elm/Shared/Action/Ports.elm @@ -0,0 +1,6 @@ +port module Shared.Action.Ports exposing (..) + +port store_new_session : (String, String) -> (Cmd msg) +port reset_session : () -> (Cmd msg) +port connected: (() -> msg) -> (Sub msg) +port go_to : (String) -> (Cmd msg) diff --git a/src/shared/elm/Shared/Comm/GoTo.elm b/src/shared/elm/Shared/Comm/GoTo.elm new file mode 100644 index 0000000..19e9619 --- /dev/null +++ b/src/shared/elm/Shared/Comm/GoTo.elm @@ -0,0 +1,27 @@ +module Shared.Comm.GoTo exposing (decode) + +-- Elm ------------------------------------------------------------------------- +import Json.Decode + +-- ??? ------------------------------------------------------------------------- +import Struct.ServerReply + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +internal_decoder : String -> Struct.ServerReply.Type +internal_decoder url = (Struct.ServerReply.GoTo url) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +decode : (Json.Decode.Decoder Struct.ServerReply.Type) +decode = + (Json.Decode.map + (internal_decoder) + (Json.Decode.field "url" (Json.Decode.string)) + ) diff --git a/src/shared/elm/Shared/Struct/Flags.elm b/src/shared/elm/Shared/Struct/Flags.elm new file mode 100644 index 0000000..f57362e --- /dev/null +++ b/src/shared/elm/Shared/Struct/Flags.elm @@ -0,0 +1,73 @@ +module Shared.Struct.Flags exposing + ( + Type, + maybe_get_parameter, + force_get_parameter, + get_parameters_as_url, + get_session_token, + get_user_id + ) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Shared ---------------------------------------------------------------------- +import Util.List + +-------------------------------------------------------------------------------- +-- TYPES ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +type alias Type = + { + user_id : String, + token : String, + url_parameters : (List (List String)) + } + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +parameter_as_url : (List String) -> String +parameter_as_url parameter = + case parameter of + [name, value] -> (name ++ "=" ++ value) + _ -> "" + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +maybe_get_parameter : String -> Type -> (Maybe String) +maybe_get_parameter parameter flags = + case + (Util.List.get_first + (\e -> ((List.head e) == (Just parameter))) + flags.url_parameters + ) + of + Nothing -> Nothing + (Just a) -> + case (List.tail a) of + Nothing -> Nothing + (Just b) -> (List.head b) + +force_get_parameter : String -> Type -> String +force_get_parameter parameter flags = + case (maybe_get_parameter parameter flags) of + Nothing -> "" + (Just str) -> str + +get_parameters_as_url : Type -> String +get_parameters_as_url flags = + (List.foldl + (\parameter -> \current_parameters -> + (current_parameters ++ "&" ++ (parameter_as_url parameter)) + ) + "" + flags.url_parameters + ) + +get_session_token : Type -> String +get_session_token flags = flags.token + +get_user_id : Type -> String +get_user_id flags = flags.user_id diff --git a/src/shared/elm/Shared/Update/Sequence.elm b/src/shared/elm/Shared/Update/Sequence.elm new file mode 100644 index 0000000..ff33ae4 --- /dev/null +++ b/src/shared/elm/Shared/Update/Sequence.elm @@ -0,0 +1,37 @@ +module Shared.Update.Sequence exposing (sequence) + +-- Elm ------------------------------------------------------------------------- +import List + +-- Local Module ---------------------------------------------------------------- +import Struct.Model + +-------------------------------------------------------------------------------- +-- LOCAL ----------------------------------------------------------------------- +-------------------------------------------------------------------------------- +sequence_step : ( + (Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type))) + -> (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + -> (Struct.Model.Type, (List (Cmd Struct.Event.Type))) + ) +sequence_step action (model, cmd_list) = + let (next_model, new_cmd) = (action model) in + case new_cmd of + Cmd.none -> (next_model, cmd_list) + _ -> (next_model, (cmd_list ++ new_cmds)) + +-------------------------------------------------------------------------------- +-- EXPORTED -------------------------------------------------------------------- +-------------------------------------------------------------------------------- +sequence : ( + (List + (Struct.Model.Type -> (Struct.Model.Type, (Cmd Struct.Event.Type))) + ) + -> (Struct.Model.Type, (Cmd Struct.Event.Type)) + ) +sequence actions model = + let (final_model, cmds) = (List.foldr (sequence_step) (model, []) actions) in + case cmds of + [] -> (final_model, Cmd.none) + [cmd] -> (final_model, cmd) + _ -> (final_model, (Cmd.batch cmds)) diff --git a/src/shared/elm/Shared/Util/Array.elm b/src/shared/elm/Shared/Util/Array.elm new file mode 100644 index 0000000..234b4c4 --- /dev/null +++ b/src/shared/elm/Shared/Util/Array.elm @@ -0,0 +1,54 @@ +module Shared.Util.Array exposing + ( + update, + update_unsafe, + filter_first, + indexed_search + ) + +import List +import Array + +update : ( + Int -> + ((Maybe t) -> (Maybe t)) -> + (Array.Array t) -> + (Array.Array t) + ) +update index fun array = + case (fun (Array.get index array)) of + Nothing -> array + (Just e) -> (Array.set index e array) + +update_unsafe : ( + Int -> + (t -> t) -> + (Array.Array t) -> + (Array.Array t) + ) +update_unsafe index fun array = + case (Array.get index array) of + Nothing -> array + (Just e) -> (Array.set index (fun e) array) + +filter_first : (t -> Bool) -> (Array.Array t) -> (Maybe t) +filter_first fun array = + (Array.get 0 (Array.filter fun array)) + +indexed_search : (t -> Bool) -> (Array.Array t) -> (Maybe (Int, t)) +indexed_search fun array = + (List.foldl + (\v res -> + ( + case res of + (Just e) -> res + Nothing -> + let (index, value) = v in + if (fun value) + then (Just v) + else Nothing + ) + ) + Nothing + (Array.toIndexedList array) + ) diff --git a/src/shared/elm/Shared/Util/Html.elm b/src/shared/elm/Shared/Util/Html.elm new file mode 100644 index 0000000..8b803f7 --- /dev/null +++ b/src/shared/elm/Shared/Util/Html.elm @@ -0,0 +1,6 @@ +module Shared.Util.Html exposing (nothing) + +import Html + +nothing : (Html.Html a) +nothing = (Html.text "") diff --git a/src/shared/elm/Shared/Util/Http.elm b/src/shared/elm/Shared/Util/Http.elm new file mode 100644 index 0000000..2e57819 --- /dev/null +++ b/src/shared/elm/Shared/Util/Http.elm @@ -0,0 +1,22 @@ +module Shared.Util.Http exposing (error_to_string) + +import Http + +error_to_string : Http.Error -> String +error_to_string error = + case error of + (Http.BadUrl string) -> ("Invalid URL: \"" ++ string ++ "\"") + Http.Timeout -> "Timed out" + Http.NetworkError -> "Connection lost, network error." + (Http.BadStatus response) -> + ( + "The HTTP request failed: " + ++ (String.fromInt response) + ++ "." + ) + (Http.BadBody string) -> + ( + "Server response not understood:\"" + ++ string + ++ "\"." + ) diff --git a/src/shared/elm/Shared/Util/List.elm b/src/shared/elm/Shared/Util/List.elm new file mode 100644 index 0000000..6a22a5a --- /dev/null +++ b/src/shared/elm/Shared/Util/List.elm @@ -0,0 +1,50 @@ +module Shared.Util.List exposing (..) + +import Set + +import List + +pop : List a -> (Maybe (a, List a)) +pop l = + case l of + (head :: tail) -> (Just (head, tail)) + [] -> Nothing + +get_first : (a -> Bool) -> (List a) -> (Maybe a) +get_first fun list = + (List.head (List.filter fun list)) + +product_map : (a -> b -> c) -> (List a) -> (List b) -> (List c) +product_map product_fun list_a list_b = + (product_map_rec (product_fun) list_a list_b []) + +product_map_rec : (a -> b -> c) -> (List a) -> (List b) -> (List c) -> (List c) +product_map_rec product_fun list_a list_b result = + case (pop list_a) of + Nothing -> result + (Just (head, tail)) -> + (product_map_rec + (product_fun) + tail + list_b + (List.append + (List.map (product_fun head) list_b) + result + ) + ) + +duplicates : (List comparable) -> (Set.Set comparable) +duplicates list = + let + (encountered, final_result) = + (List.foldl + (\elem (met, result) -> + if (Set.member elem met) + then (met, (Set.insert elem result)) + else ((Set.insert elem met), result) + ) + ((Set.empty), (Set.empty)) + list + ) + in + final_result diff --git a/src/shared/elm/Struct/Flags.elm b/src/shared/elm/Struct/Flags.elm deleted file mode 100644 index 475d1f2..0000000 --- a/src/shared/elm/Struct/Flags.elm +++ /dev/null @@ -1,73 +0,0 @@ -module Struct.Flags exposing - ( - Type, - maybe_get_parameter, - force_get_parameter, - get_parameters_as_url, - get_session_token, - get_user_id - ) - --- Elm ------------------------------------------------------------------------- -import List - --- Shared ---------------------------------------------------------------------- -import Util.List - --------------------------------------------------------------------------------- --- TYPES ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -type alias Type = - { - user_id : String, - token : String, - url_parameters : (List (List String)) - } - --------------------------------------------------------------------------------- --- LOCAL ----------------------------------------------------------------------- --------------------------------------------------------------------------------- -parameter_as_url : (List String) -> String -parameter_as_url parameter = - case parameter of - [name, value] -> (name ++ "=" ++ value) - _ -> "" - --------------------------------------------------------------------------------- --- EXPORTED -------------------------------------------------------------------- --------------------------------------------------------------------------------- -maybe_get_parameter : String -> Type -> (Maybe String) -maybe_get_parameter parameter flags = - case - (Util.List.get_first - (\e -> ((List.head e) == (Just parameter))) - flags.url_parameters - ) - of - Nothing -> Nothing - (Just a) -> - case (List.tail a) of - Nothing -> Nothing - (Just b) -> (List.head b) - -force_get_parameter : String -> Type -> String -force_get_parameter parameter flags = - case (maybe_get_parameter parameter flags) of - Nothing -> "" - (Just str) -> str - -get_parameters_as_url : Type -> String -get_parameters_as_url flags = - (List.foldl - (\parameter -> \current_parameters -> - (current_parameters ++ "&" ++ (parameter_as_url parameter)) - ) - "" - flags.url_parameters - ) - -get_session_token : Type -> String -get_session_token flags = flags.token - -get_user_id : Type -> String -get_user_id flags = flags.user_id diff --git a/src/shared/elm/Util/Array.elm b/src/shared/elm/Util/Array.elm deleted file mode 100644 index 26d13f6..0000000 --- a/src/shared/elm/Util/Array.elm +++ /dev/null @@ -1,54 +0,0 @@ -module Util.Array exposing - ( - update, - update_unsafe, - filter_first, - indexed_search - ) - -import List -import Array - -update : ( - Int -> - ((Maybe t) -> (Maybe t)) -> - (Array.Array t) -> - (Array.Array t) - ) -update index fun array = - case (fun (Array.get index array)) of - Nothing -> array - (Just e) -> (Array.set index e array) - -update_unsafe : ( - Int -> - (t -> t) -> - (Array.Array t) -> - (Array.Array t) - ) -update_unsafe index fun array = - case (Array.get index array) of - Nothing -> array - (Just e) -> (Array.set index (fun e) array) - -filter_first : (t -> Bool) -> (Array.Array t) -> (Maybe t) -filter_first fun array = - (Array.get 0 (Array.filter fun array)) - -indexed_search : (t -> Bool) -> (Array.Array t) -> (Maybe (Int, t)) -indexed_search fun array = - (List.foldl - (\v res -> - ( - case res of - (Just e) -> res - Nothing -> - let (index, value) = v in - if (fun value) - then (Just v) - else Nothing - ) - ) - Nothing - (Array.toIndexedList array) - ) diff --git a/src/shared/elm/Util/Html.elm b/src/shared/elm/Util/Html.elm deleted file mode 100644 index 42eadba..0000000 --- a/src/shared/elm/Util/Html.elm +++ /dev/null @@ -1,6 +0,0 @@ -module Util.Html exposing (nothing) - -import Html - -nothing : (Html.Html a) -nothing = (Html.text "") diff --git a/src/shared/elm/Util/Http.elm b/src/shared/elm/Util/Http.elm deleted file mode 100644 index c098dc7..0000000 --- a/src/shared/elm/Util/Http.elm +++ /dev/null @@ -1,22 +0,0 @@ -module Util.Http exposing (error_to_string) - -import Http - -error_to_string : Http.Error -> String -error_to_string error = - case error of - (Http.BadUrl string) -> ("Invalid URL: \"" ++ string ++ "\"") - Http.Timeout -> "Timed out" - Http.NetworkError -> "Connection lost, network error." - (Http.BadStatus response) -> - ( - "The HTTP request failed: " - ++ (String.fromInt response) - ++ "." - ) - (Http.BadBody string) -> - ( - "Server response not understood:\"" - ++ string - ++ "\"." - ) diff --git a/src/shared/elm/Util/List.elm b/src/shared/elm/Util/List.elm deleted file mode 100644 index 829dd3e..0000000 --- a/src/shared/elm/Util/List.elm +++ /dev/null @@ -1,53 +0,0 @@ -module Util.List exposing (..) - -import Set - -import List - -pop : List a -> (Maybe (a, List a)) -pop l = - case - ((List.head l), (List.tail l)) - of - (Nothing, _) -> Nothing - (_ , Nothing) -> Nothing - ((Just head), (Just tail)) -> (Just (head, tail)) - -get_first : (a -> Bool) -> (List a) -> (Maybe a) -get_first fun list = - (List.head (List.filter fun list)) - -product_map : (a -> b -> c) -> (List a) -> (List b) -> (List c) -product_map product_fun list_a list_b = - (product_map_rec (product_fun) list_a list_b []) - -product_map_rec : (a -> b -> c) -> (List a) -> (List b) -> (List c) -> (List c) -product_map_rec product_fun list_a list_b result = - case (pop list_a) of - Nothing -> result - (Just (head, tail)) -> - (product_map_rec - (product_fun) - tail - list_b - (List.append - (List.map (product_fun head) list_b) - result - ) - ) - -duplicates : (List comparable) -> (Set.Set comparable) -duplicates list = - let - (encountered, final_result) = - (List.foldl - (\elem (met, result) -> - if (Set.member elem met) - then (met, (Set.insert elem result)) - else ((Set.insert elem met), result) - ) - ((Set.empty), (Set.empty)) - list - ) - in - final_result -- cgit v1.2.3-70-g09d2