From cfca18262c1ff48dcb683ddab7d03cf8e55573ff Mon Sep 17 00:00:00 2001
From: Joris
Date: Fri, 24 Mar 2017 09:21:04 +0000
Subject: Features/categories

---
 src/client/elm/Utils/Cmd.elm    |  4 +--
 src/client/elm/Utils/Http.elm   | 80 +++++++++++++----------------------------
 src/client/elm/Utils/Json.elm   | 12 +++++++
 src/client/elm/Utils/Maybe.elm  | 19 ++++++----
 src/client/elm/Utils/Search.elm | 10 ++++++
 src/client/elm/Utils/String.elm | 38 ++++++++++++++++++++
 src/client/elm/Utils/Tuple.elm  | 14 --------
 7 files changed, 100 insertions(+), 77 deletions(-)
 create mode 100644 src/client/elm/Utils/Json.elm
 create mode 100644 src/client/elm/Utils/Search.elm
 create mode 100644 src/client/elm/Utils/String.elm
 delete mode 100644 src/client/elm/Utils/Tuple.elm

(limited to 'src/client/elm/Utils')

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)
-- 
cgit v1.2.3