summaryrefslogtreecommitdiff |
diff options
Diffstat (limited to 'src/shared/elm/Shared')
-rw-r--r-- | src/shared/elm/Shared/Action/Ports.elm | 6 | ||||
-rw-r--r-- | src/shared/elm/Shared/Comm/GoTo.elm | 27 | ||||
-rw-r--r-- | src/shared/elm/Shared/Struct/Flags.elm | 73 | ||||
-rw-r--r-- | src/shared/elm/Shared/Update/Sequence.elm | 37 | ||||
-rw-r--r-- | src/shared/elm/Shared/Util/Array.elm | 54 | ||||
-rw-r--r-- | src/shared/elm/Shared/Util/Html.elm | 6 | ||||
-rw-r--r-- | src/shared/elm/Shared/Util/Http.elm | 22 | ||||
-rw-r--r-- | src/shared/elm/Shared/Util/List.elm | 50 |
8 files changed, 275 insertions, 0 deletions
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 |