aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/Utils
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm/Utils')
-rw-r--r--src/client/elm/Utils/Cmd.elm4
-rw-r--r--src/client/elm/Utils/Http.elm80
-rw-r--r--src/client/elm/Utils/Json.elm12
-rw-r--r--src/client/elm/Utils/Maybe.elm19
-rw-r--r--src/client/elm/Utils/Search.elm10
-rw-r--r--src/client/elm/Utils/String.elm38
-rw-r--r--src/client/elm/Utils/Tuple.elm14
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)