From 6b090b3bdef7108d51d93207e28b148c121767aa Mon Sep 17 00:00:00 2001
From: Joris
Date: Mon, 4 Jan 2016 00:34:48 +0100
Subject: Simplify server communicaitons in client

---
 src/client/elm/Main.elm                    |  5 ++-
 src/client/elm/Model/Action.elm            |  6 +--
 src/client/elm/Model/Init.elm              | 16 ++++++++
 src/client/elm/Model/View/LoggedInView.elm | 15 ++++----
 src/client/elm/Server.elm                  | 62 +++++++++++-------------------
 src/client/elm/SimpleHTTP.elm              | 47 ----------------------
 src/client/elm/Update.elm                  |  8 ++--
 src/client/elm/Update/LoggedIn.elm         | 12 +++++-
 src/client/elm/Update/LoggedIn/Account.elm |  1 +
 src/client/elm/Utils/Http.elm              | 47 ++++++++++++++++++++++
 10 files changed, 115 insertions(+), 104 deletions(-)
 create mode 100644 src/client/elm/Model/Init.elm
 delete mode 100644 src/client/elm/SimpleHTTP.elm
 create mode 100644 src/client/elm/Utils/Http.elm

(limited to 'src')

diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm
index e8bbd54..7d13376 100644
--- a/src/client/elm/Main.elm
+++ b/src/client/elm/Main.elm
@@ -29,7 +29,10 @@ app : App Model
 app = StartApp.start
   { init =
       ( initialModel initialTime translations config
-      , Effects.task Server.initViewAction
+      , Server.init
+          |> Task.map GoLoggedInView
+          |> flip Task.onError (always <| Task.succeed GoSignInView)
+          |> Effects.task
       )
   , view = view
   , update = update
diff --git a/src/client/elm/Model/Action.elm b/src/client/elm/Model/Action.elm
index 7267259..60c1aca 100644
--- a/src/client/elm/Model/Action.elm
+++ b/src/client/elm/Model/Action.elm
@@ -5,17 +5,15 @@ module Model.Action
 import Time exposing (Time)
 import Signal exposing (Address)
 
-import Model.User exposing (Users, UserId)
-import Model.Payment exposing (Payments)
-import Model.Payer exposing (Payers)
 import Model.Action.SignInAction exposing (SignInAction)
 import Model.Action.LoggedInAction exposing (LoggedInAction)
+import Model.Init exposing (Init)
 
 type Action =
   NoOp
   | SignIn String
   | UpdateTime Time
-  | GoLoggedInView Users UserId Payments Payments Int Payers
+  | GoLoggedInView Init
   | UpdateSignIn SignInAction
   | UpdateLoggedIn LoggedInAction
   | GoSignInView
diff --git a/src/client/elm/Model/Init.elm b/src/client/elm/Model/Init.elm
new file mode 100644
index 0000000..490321b
--- /dev/null
+++ b/src/client/elm/Model/Init.elm
@@ -0,0 +1,16 @@
+module Model.Init
+  ( Init
+  ) where
+
+import Model.Payment exposing (Payments)
+import Model.Payer exposing (Payers)
+import Model.User exposing (Users, UserId)
+
+type alias Init =
+  { users : Users
+  , me : UserId
+  , payments : Payments
+  , monthlyPayments : Payments
+  , paymentsCount : Int
+  , payers : Payers
+  }
diff --git a/src/client/elm/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm
index 75285b1..2df3525 100644
--- a/src/client/elm/Model/View/LoggedInView.elm
+++ b/src/client/elm/Model/View/LoggedInView.elm
@@ -6,6 +6,7 @@ module Model.View.LoggedInView
 import Model.User exposing (Users, UserId)
 import Model.Payment exposing (Payments, PaymentFrequency(..))
 import Model.Payer exposing (Payers)
+import Model.Init exposing (..)
 import Model.View.LoggedIn.AddPayment exposing (..)
 import Model.View.LoggedIn.Edition exposing (..)
 import Model.View.LoggedIn.Monthly exposing (..)
@@ -22,14 +23,14 @@ type alias LoggedInView =
   , currentPage : Int
   }
 
-initLoggedInView : Users -> UserId -> Payments -> Payments -> Int -> Payers -> LoggedInView
-initLoggedInView users me monthlyPayments payments paymentsCount payers =
-  { users = users
+initLoggedInView : Init -> LoggedInView
+initLoggedInView init =
+  { users = init.users
   , add = initAddPayment Punctual
-  , monthly = initMonthly monthlyPayments
-  , account = initAccount me payers
-  , payments = payments
-  , paymentsCount = paymentsCount
+  , monthly = initMonthly init.monthlyPayments
+  , account = initAccount init.me init.payers
+  , payments = init.payments
+  , paymentsCount = init.paymentsCount
   , paymentEdition = Nothing
   , currentPage = 1
   }
diff --git a/src/client/elm/Server.elm b/src/client/elm/Server.elm
index e50de7e..7b03a98 100644
--- a/src/client/elm/Server.elm
+++ b/src/client/elm/Server.elm
@@ -1,10 +1,10 @@
 module Server
-  ( signIn
+  ( init
+  , signIn
   , addPayment
   , deletePayment
   , setIncome
   , signOut
-  , initViewAction
   ) where
 
 import Signal
@@ -13,62 +13,44 @@ import Http
 import Json.Decode as Json exposing ((:=))
 import Date
 import Time exposing (Time)
-import Debug
-import String
 
-import SimpleHTTP exposing (..)
+import Utils.Http exposing (..)
 
-import Model.Action as U exposing (Action)
-import Model.Action.AddPaymentAction as AddPayment
-import Model.Action.LoggedInAction as UL exposing (LoggedInAction)
-import Model.Action.MonthlyAction as UM exposing (MonthlyAction)
-import Model.Action.AccountAction as UA exposing (AccountAction)
 import Model.Payment exposing (..)
 import Model.Payer exposing (Payers, payersDecoder)
 import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder)
-import Model.Translations exposing (Translations, getMessage)
+import Model.Init exposing (Init)
 
-import Update.SignIn exposing (updateSignIn)
+init : Task Http.Error Init
+init =
+  Task.map Init (Http.get usersDecoder "/users")
+    `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI")
+    `Task.andMap` (Http.get paymentsDecoder "/payments")
+    `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments")
+    `Task.andMap` (Http.get ("number" := Json.int) "/payments/count")
+    `Task.andMap` (Http.get payersDecoder "/payers")
 
-signIn : String -> Task Http.Error Action
+signIn : String -> Task Http.Error Init
 signIn assertion =
   post ("/signIn?assertion=" ++ assertion)
-    |> flip Task.andThen (always initViewAction)
+    |> flip Task.andThen (always init)
 
-addPayment : Translations -> String -> String -> PaymentFrequency -> Task Http.Error LoggedInAction
-addPayment translations name cost frequency =
+addPayment : String -> String -> PaymentFrequency -> Task Http.Error PaymentId
+addPayment name cost frequency =
   post ("/payment/add?name=" ++ name ++ "&cost=" ++ cost ++ "&frequency=" ++ (toString frequency))
     |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder)
-    |> Task.map (\paymentId ->
-         case String.toInt cost of
-           Err _ ->
-             UL.UpdateAdd (AddPayment.AddError Nothing (Just (getMessage "CostRequired" translations)))
-           Ok costNumber ->
-             UL.ValidateAddPayment paymentId name costNumber frequency
-       )
 
-deletePayment : Payment -> PaymentFrequency -> Task Http.Error LoggedInAction
+deletePayment : Payment -> PaymentFrequency -> Task Http.Error ()
 deletePayment payment frequency =
   post ("payment/delete?id=" ++ (toString payment.id))
-    |> Task.map (always (UL.ValidateDeletePayment payment frequency))
+    |> Task.map (always ())
 
-setIncome : Time -> Int -> Task Http.Error AccountAction
+setIncome : Time -> Int -> Task Http.Error ()
 setIncome currentTime amount =
   post ("/income?amount=" ++ (toString amount))
-    |> Task.map (always (UA.ValidateUpdateIncome currentTime amount))
+    |> Task.map (always ())
 
-signOut : Task Http.Error Action
+signOut : Task Http.Error ()
 signOut =
   post "/signOut"
-    |> Task.map (always U.GoSignInView)
-
-initViewAction = Task.onError loggedInView (always <| Task.succeed U.GoSignInView)
-
-loggedInView : Task Http.Error Action
-loggedInView =
-  Task.map U.GoLoggedInView (Http.get usersDecoder "/users")
-    `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI")
-    `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments")
-    `Task.andMap` (Http.get paymentsDecoder "/payments")
-    `Task.andMap` (Http.get ("number" := Json.int) "/payments/count")
-    `Task.andMap` (Http.get payersDecoder "/payers")
+    |> Task.map (always ())
diff --git a/src/client/elm/SimpleHTTP.elm b/src/client/elm/SimpleHTTP.elm
deleted file mode 100644
index 3e01178..0000000
--- a/src/client/elm/SimpleHTTP.elm
+++ /dev/null
@@ -1,47 +0,0 @@
-module SimpleHTTP
-  ( post
-  , decodeHttpValue
-  ) where
-
-import Http exposing (..)
-import Task exposing (..)
-import Json.Decode as Json exposing (Decoder)
-
-post : String -> Task Error Value
-post url =
-  { verb = "POST"
-  , headers = []
-  , url = url
-  , body = empty
-  }
-    |> Http.send defaultSettings
-    |> mapError promoteError
-    |> flip Task.andThen handleResponse
-
-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
-    _ -> ""
-
-promoteError : RawError -> Error
-promoteError rawError =
-  case rawError of
-    RawTimeout -> Timeout
-    RawNetworkError -> NetworkError
-
-decodeHttpValue : Decoder a -> Value -> Task Error a
-decodeHttpValue decoder value =
-  case value of
-    Text str ->
-      case Json.decodeString decoder str of
-        Ok v -> succeed v
-        Err msg -> fail (UnexpectedPayload msg)
-    _ ->
-      fail (UnexpectedPayload "Response body is a blob, expecting a string.")
diff --git a/src/client/elm/Update.elm b/src/client/elm/Update.elm
index a78be68..bfc3bf6 100644
--- a/src/client/elm/Update.elm
+++ b/src/client/elm/Update.elm
@@ -20,8 +20,6 @@ import Model.View.LoggedInView exposing (..)
 import Update.LoggedIn exposing (updateLoggedIn)
 import Update.SignIn exposing (updateSignIn)
 
-import SimpleHTTP exposing (post)
-
 update : Action -> Model -> (Model, Effects Action)
 update action model =
   case action of
@@ -32,14 +30,15 @@ update action model =
     SignIn assertion ->
       ( applySignIn model (SignInAction.WaitingServer)
       , Server.signIn assertion
+          |> Task.map GoLoggedInView
           |> flip Task.onError (\_ ->
                Task.succeed (UpdateSignIn (SignInAction.ErrorLogin (getMessage "ErrorSignIn" model.translations)))
              )
           |> Effects.task
       )
 
-    GoLoggedInView users me monthlyPayments payments paymentsCount payers ->
-      ( { model | view = V.LoggedInView (initLoggedInView users me monthlyPayments payments paymentsCount payers) }
+    GoLoggedInView init ->
+      ( { model | view = V.LoggedInView (initLoggedInView init) }
       , Effects.none
       )
 
@@ -58,6 +57,7 @@ update action model =
     SignOut ->
       ( model
       , Server.signOut
+          |> Task.map (always GoSignInView)
           |> flip Task.onError (always <| Task.succeed NoOp)
           |> Effects.task
       )
diff --git a/src/client/elm/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm
index 134aec2..dfc2a1b 100644
--- a/src/client/elm/Update/LoggedIn.elm
+++ b/src/client/elm/Update/LoggedIn.elm
@@ -6,6 +6,7 @@ import Date
 import Dict
 import Debug
 import Task
+import String
 
 import Effects exposing (Effects)
 import Http exposing (Error(..))
@@ -21,6 +22,7 @@ import Model.Action.MonthlyAction as Monthly
 import Model.Action.AddPaymentAction as AddPayment
 import Model.View.LoggedInView exposing (..)
 import Model.View.LoggedIn.AddPayment exposing (..)
+import Model.Translations exposing (Translations, getMessage)
 
 import Update.LoggedIn.AddPayment exposing (updateAddPayment, addPaymentError)
 import Update.LoggedIn.Monthly exposing (updateMonthly)
@@ -44,7 +46,14 @@ updateLoggedIn model action loggedInView =
 
     AddPayment name cost frequency ->
       ( { loggedInView | add = updateAddPayment AddPayment.WaitingServer loggedInView.add }
-      , Server.addPayment model.translations name cost frequency
+      , Server.addPayment name cost frequency
+          |> Task.map (\paymentId ->
+               case String.toInt cost of
+                 Err _ ->
+                   UpdateAdd (AddPayment.AddError Nothing (Just (getMessage "CostRequired" model.translations)))
+                 Ok costNumber ->
+                   ValidateAddPayment paymentId name costNumber frequency
+             )
           |> flip Task.onError (\err ->
               case err of
                 BadResponse 400 jsonErr ->
@@ -89,6 +98,7 @@ updateLoggedIn model action loggedInView =
     DeletePayment payment frequency ->
       ( loggedInView
       , Server.deletePayment payment frequency
+          |> Task.map (always (ValidateDeletePayment payment frequency))
           |> flip Task.onError (always <| Task.succeed NoOp)
           |> Effects.task
       )
diff --git a/src/client/elm/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm
index 16d67ac..1773b9a 100644
--- a/src/client/elm/Update/LoggedIn/Account.elm
+++ b/src/client/elm/Update/LoggedIn/Account.elm
@@ -67,6 +67,7 @@ updateAccount action account =
     UpdateIncome currentTime amount ->
       ( account
       , Server.setIncome currentTime amount
+          |> Task.map (always (ValidateUpdateIncome currentTime amount))
           |> flip Task.onError (always <| Task.succeed NoOp)
           |> Effects.task
       )
diff --git a/src/client/elm/Utils/Http.elm b/src/client/elm/Utils/Http.elm
new file mode 100644
index 0000000..2cf1294
--- /dev/null
+++ b/src/client/elm/Utils/Http.elm
@@ -0,0 +1,47 @@
+module Utils.Http
+  ( post
+  , decodeHttpValue
+  ) where
+
+import Http exposing (..)
+import Task exposing (..)
+import Json.Decode as Json exposing (Decoder)
+
+post : String -> Task Error Value
+post url =
+  { verb = "POST"
+  , headers = []
+  , url = url
+  , body = empty
+  }
+    |> Http.send defaultSettings
+    |> mapError promoteError
+    |> flip Task.andThen handleResponse
+
+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
+    _ -> ""
+
+promoteError : RawError -> Error
+promoteError rawError =
+  case rawError of
+    RawTimeout -> Timeout
+    RawNetworkError -> NetworkError
+
+decodeHttpValue : Decoder a -> Value -> Task Error a
+decodeHttpValue decoder value =
+  case value of
+    Text str ->
+      case Json.decodeString decoder str of
+        Ok v -> succeed v
+        Err msg -> fail (UnexpectedPayload msg)
+    _ ->
+      fail (UnexpectedPayload "Response body is a blob, expecting a string.")
-- 
cgit v1.2.3