diff options
Diffstat (limited to 'src/client/elm/Utils')
-rw-r--r-- | src/client/elm/Utils/Cmd.elm | 4 | ||||
-rw-r--r-- | src/client/elm/Utils/Http.elm | 80 | ||||
-rw-r--r-- | src/client/elm/Utils/Json.elm | 12 | ||||
-rw-r--r-- | src/client/elm/Utils/Maybe.elm | 19 | ||||
-rw-r--r-- | src/client/elm/Utils/Search.elm | 10 | ||||
-rw-r--r-- | src/client/elm/Utils/String.elm | 38 | ||||
-rw-r--r-- | src/client/elm/Utils/Tuple.elm | 14 |
7 files changed, 100 insertions, 77 deletions
diff --git a/src/client/elm/Utils/Cmd.elm b/src/client/elm/Utils/Cmd.elm index 8b79446..5f41cbe 100644 --- a/src/client/elm/Utils/Cmd.elm +++ b/src/client/elm/Utils/Cmd.elm @@ -7,8 +7,8 @@ import Platform.Cmd as Cmd pipeUpdate : (model, Cmd msg) -> (model -> (model, Cmd msg)) -> (model, Cmd msg) pipeUpdate (model, cmd) f = - let (model', cmd') = f model - in (model', Cmd.batch [ cmd, cmd' ]) + let (newModel, newCmd) = f model + in (newModel, Cmd.batch [ cmd, newCmd ]) (:>) : (m, Cmd a) -> (m -> (m, Cmd a)) -> (m, Cmd a) (:>) = pipeUpdate diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm index 4edc233..dd3870a 100644 --- a/src/client/elm/Utils/Http.elm +++ b/src/client/elm/Utils/Http.elm @@ -1,69 +1,39 @@ module Utils.Http exposing ( jsonRequest , request - , requestWithBody - , decodeHttpValue , errorKey ) import Http exposing (..) import Task exposing (..) -import Json.Decode as JsonDecode exposing (Decoder) -import Json.Encode as JsonEncode - -jsonRequest : String -> String -> JsonEncode.Value -> Task Error Value -jsonRequest method url json = - json - |> JsonEncode.encode 0 - |> Http.string - |> requestWithBody method url - -request : String -> String -> Task Error Value -request method url = requestWithBody method url empty - -requestWithBody : String -> String -> Body -> Task Error Value -requestWithBody method url body = - { verb = method - , headers = [] - , url = url - , body = body - } - |> Http.send defaultSettings - |> mapError promoteError - |> flip Task.andThen handleResponse - -promoteError : RawError -> Error -promoteError rawError = - case rawError of - RawTimeout -> Timeout - RawNetworkError -> NetworkError - -handleResponse : Response -> Task Error Value -handleResponse response = - if 200 <= response.status && response.status < 300 - then Task.succeed response.value - else fail (BadResponse response.status (responseString response.value)) - -responseString : Value -> String -responseString value = - case value of - Text str -> str - _ -> "" - -decodeHttpValue : Decoder a -> Value -> Task Error a -decodeHttpValue decoder value = - case value of - Text str -> - case JsonDecode.decodeString decoder str of - Ok v -> succeed v - Err msg -> fail (UnexpectedPayload msg) - _ -> - fail (UnexpectedPayload "Response body is a blob, expecting a string.") +import Json.Decode as Decode exposing (Decoder, Value) +import Json.Encode as Encode + +jsonRequest : String -> String -> Expect a -> (Result Error a -> msg) -> Encode.Value -> Cmd msg +jsonRequest method url expect handleResult value = + requestWithBody method url (jsonBody value) expect handleResult + +request : String -> String -> Expect a -> (Result Error a -> msg) -> Cmd msg +request method url = requestWithBody method url emptyBody + +requestWithBody : String -> String -> Body -> Expect a -> (Result Error a -> msg) -> Cmd msg +requestWithBody method url body expect handleResult = + let req = Http.request + { method = method + , headers = [] + , url = url + , body = body + , expect = expect + , timeout = Nothing + , withCredentials = False + } + in send handleResult req errorKey : Error -> String errorKey error = case error of + BadUrl _ -> "BadUrl" Timeout -> "Timeout" NetworkError -> "NetworkError" - UnexpectedPayload _ -> "UnexpectedPayload" - BadResponse _ key -> key + BadPayload _ _ -> "BadPayload" + BadStatus response -> response.body diff --git a/src/client/elm/Utils/Json.elm b/src/client/elm/Utils/Json.elm new file mode 100644 index 0000000..29e815b --- /dev/null +++ b/src/client/elm/Utils/Json.elm @@ -0,0 +1,12 @@ +module Utils.Json exposing + ( dictDecoder + ) + +import Json.Decode as Decode exposing (Decoder) +import Dict exposing (Dict) + +dictDecoder : Decoder comparable -> Decoder a -> Decoder (Dict comparable a) +dictDecoder keyDecoder valueDecoder = + Decode.map2 (,) keyDecoder valueDecoder + |> Decode.list + |> Decode.map Dict.fromList diff --git a/src/client/elm/Utils/Maybe.elm b/src/client/elm/Utils/Maybe.elm index 4a94aa5..46456e1 100644 --- a/src/client/elm/Utils/Maybe.elm +++ b/src/client/elm/Utils/Maybe.elm @@ -1,7 +1,8 @@ module Utils.Maybe exposing ( isJust - , catMaybes - , maybeToList + , cat + , toList + , orElse ) isJust : Maybe a -> Bool @@ -10,8 +11,8 @@ isJust maybe = Just _ -> True Nothing -> False -catMaybes : List (Maybe a) -> List a -catMaybes = +cat : List (Maybe a) -> List a +cat = List.foldr (\mb xs -> case mb of @@ -20,8 +21,14 @@ catMaybes = ) [] -maybeToList : Maybe a -> List a -maybeToList mb = +toList : Maybe a -> List a +toList mb = case mb of Just a -> [a] Nothing -> [] + +orElse : Maybe a -> Maybe a -> Maybe a +orElse mb1 mb2 = + case mb1 of + Just x -> Just x + Nothing -> mb2 diff --git a/src/client/elm/Utils/Search.elm b/src/client/elm/Utils/Search.elm new file mode 100644 index 0000000..1b70387 --- /dev/null +++ b/src/client/elm/Utils/Search.elm @@ -0,0 +1,10 @@ +module Utils.Search exposing + ( format + ) + +import String + +import Utils.String as String + +format : String -> String +format = String.unaccent << String.toLower diff --git a/src/client/elm/Utils/String.elm b/src/client/elm/Utils/String.elm new file mode 100644 index 0000000..90fe68e --- /dev/null +++ b/src/client/elm/Utils/String.elm @@ -0,0 +1,38 @@ +module Utils.String exposing + ( unaccent + ) + +unaccent : String -> String +unaccent = String.map unaccentChar + +unaccentChar : Char -> Char +unaccentChar c = case c of + 'à' -> 'a' + 'á' -> 'a' + 'â' -> 'a' + 'ã' -> 'a' + 'ä' -> 'a' + 'ç' -> 'c' + 'è' -> 'e' + 'é' -> 'e' + 'ê' -> 'e' + 'ë' -> 'e' + 'ì' -> 'i' + 'í' -> 'i' + 'î' -> 'i' + 'ï' -> 'i' + 'ñ' -> 'n' + 'ò' -> 'o' + 'ó' -> 'o' + 'ô' -> 'o' + 'õ' -> 'o' + 'ö' -> 'o' + 'š' -> 's' + 'ù' -> 'u' + 'ú' -> 'u' + 'û' -> 'u' + 'ü' -> 'u' + 'ý' -> 'y' + 'ÿ' -> 'y' + 'ž' -> 'z' + _ -> c diff --git a/src/client/elm/Utils/Tuple.elm b/src/client/elm/Utils/Tuple.elm deleted file mode 100644 index f9391a0..0000000 --- a/src/client/elm/Utils/Tuple.elm +++ /dev/null @@ -1,14 +0,0 @@ -module Utils.Tuple exposing - ( mapFst - , mapSnd - , mapBoth - ) - -mapFst : (a -> x) -> (a, b) -> (x, b) -mapFst f (a, b) = (f a, b) - -mapSnd : (b -> x) -> (a, b) -> (a, x) -mapSnd f (a, b) = (a, f b) - -mapBoth : (a -> x) -> (b -> y) -> (a, b) -> (x, y) -mapBoth f g (a, b) = (f a, g b) |