Adding UI to modify the income

5 files changed, 126 insertions, 9 deletions

diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/Model/View/LoggedIn/Account.elm
index 410345c..7f0fbe3 100644
--- a/src/client/Model/View/LoggedIn/Account.elm
+++ b/src/client/Model/View/LoggedIn/Account.elm
@@ -1,14 +1,28 @@
 module Model.View.LoggedIn.Account
   ( Account
+  , IncomeEdition
   , initAccount
+  , initIncomeEdition
+  , validateIncome
   ) where
 
+import Result as Result exposing (Result(..))
+
+import Utils.Validation exposing (..)
+
+import Model.Translations exposing (..)
 import Model.Payers exposing (..)
 
 type alias Account =
   { payers : Payers
   , income : Maybe Int
   , visibleDetail : Bool
+  , incomeEdition : Maybe IncomeEdition
+  }
+
+type alias IncomeEdition =
+  { income : String
+  , error : Maybe String
   }
 
 initAccount : Payers -> Maybe Int -> Account
@@ -16,4 +30,17 @@ initAccount payers income =
   { payers = payers
   , income = income
   , visibleDetail = False
+  , incomeEdition = Nothing
   }
+
+initIncomeEdition : Int -> IncomeEdition
+initIncomeEdition income =
+  { income = toString income
+  , error = Nothing
+  }
+
+validateIncome : String -> Translations -> Result String Int
+validateIncome amount translations =
+  amount
+    |> validateNonEmpty (getMessage "IncomeRequired" translations)
+    |> flip Result.andThen (validateNumber (getMessage "IncomeMustBeNonNullNumber" translations) ((/=) 0))
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index 5736f77..47d8c27 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -18,12 +18,14 @@ import Update as U
 import Update.SignIn exposing (..)
 import Update.LoggedIn as UL
 import Update.LoggedIn.Monthly as UM
+import Update.LoggedIn.Account as UA
 
 type Communication =
   NoCommunication
   | SignIn String
   | AddPayment UserId String Int
   | AddMonthlyPayment String Int
+  | SetIncome Int
   | DeletePayment PaymentId UserId Int Int
   | DeleteMonthlyPayment PaymentId
   | UpdatePage Int
@@ -48,6 +50,7 @@ getRequest communication =
     SignIn login                   -> Just (simple "post" ("/signIn?login=" ++ login))
     AddPayment userId name cost    -> Just (addPaymentRequest name cost Punctual)
     AddMonthlyPayment name cost    -> Just (addPaymentRequest name cost Monthly)
+    SetIncome amount               -> Just (simple "post" ("/income?amount=" ++ (toString amount)))
     DeletePayment paymentId _ _ _  -> Just (deletePaymentRequest paymentId)
     DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId)
     UpdatePage page                -> Just (updatePageRequest page)
@@ -88,10 +91,12 @@ serverResult communication response =
                  Task.succeed <| U.UpdateLoggedIn (UL.AddPayment userId name cost payments)
                ))
         AddMonthlyPayment name cost ->
-          decodeOkResponse
+          decodeResponse
             ("id" := paymentIdDecoder)
             (\id -> Task.succeed <| U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost))
             response
+        SetIncome amount ->
+          Task.succeed <| U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome amount))
         DeletePayment id userId cost currentPage ->
           Http.send Http.defaultSettings (updatePageRequest currentPage)
             |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments ->
@@ -100,7 +105,7 @@ serverResult communication response =
         DeleteMonthlyPayment id ->
           Task.succeed <| U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id))
         UpdatePage page ->
-          decodeOkResponse
+          decodeResponse
             paymentsDecoder
             (\payments -> Task.succeed <| U.UpdateLoggedIn (UL.UpdatePage page payments))
             response
diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/Update/LoggedIn/Account.elm
index ab07c2e..2d9cd87 100644
--- a/src/client/Update/LoggedIn/Account.elm
+++ b/src/client/Update/LoggedIn/Account.elm
@@ -3,13 +3,21 @@ module Update.LoggedIn.Account
   , updateAccount
   ) where
 
+import Maybe
+
 import Model.User exposing (UserId)
 import Model.Payers exposing (..)
 import Model.View.LoggedIn.Account exposing (..)
 
+import Utils.Maybe exposing (isJust)
+
 type AccountAction =
   ToggleDetail
   | UpdatePayer UserId Int
+  | ToggleIncomeEdition
+  | UpdateIncomeEdition String
+  | UpdateEditionError String
+  | UpdateIncome Int
 
 updateAccount : AccountAction -> Account -> Account
 updateAccount action account =
@@ -18,3 +26,26 @@ updateAccount action account =
       { account | visibleDetail <- not account.visibleDetail }
     UpdatePayer userId cost ->
       { account | payers <- updatePayers account.payers userId cost }
+    ToggleIncomeEdition ->
+      { account | incomeEdition <-
+          if isJust account.incomeEdition
+            then Nothing
+            else Just (initIncomeEdition (Maybe.withDefault 0 account.income))
+      }
+    UpdateIncomeEdition income ->
+      case account.incomeEdition of
+        Just incomeEdition ->
+          { account | incomeEdition <- Just { incomeEdition | income <- income } }
+        Nothing ->
+          account
+    UpdateEditionError error ->
+      case account.incomeEdition of
+        Just incomeEdition ->
+          { account | incomeEdition <- Just { incomeEdition | error <- Just error } }
+        Nothing ->
+          account
+    UpdateIncome amount ->
+      { account
+      | income <- Just amount
+      , incomeEdition <- Nothing
+      }
diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/View/LoggedIn/Account.elm
index 88f39c3..253647a 100644
--- a/src/client/View/LoggedIn/Account.elm
+++ b/src/client/View/LoggedIn/Account.elm
@@ -3,10 +3,13 @@ module View.LoggedIn.Account
   ) where
 
 import Html exposing (..)
+import Html as H exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 import List
 
+import ServerCommunication as SC exposing (serverCommunications)
+
 import Update exposing (..)
 import Update.LoggedIn exposing (..)
 import Update.LoggedIn.Account exposing (..)
@@ -16,10 +19,13 @@ import Model.User exposing (getUserName)
 import Model.Payers exposing (..)
 import Model.View.LoggedInView exposing (LoggedInView)
 import Model.Translations exposing (getParamMessage, getMessage)
-import Model.View.LoggedIn.Account exposing (Account)
+import Model.View.LoggedIn.Account exposing (..)
 
 import View.Expand exposing (..)
 import View.Price exposing (price)
+import View.Events exposing (onSubmitPrevDefault)
+
+import Utils.Either exposing (toMaybeError)
 
 account : Model -> LoggedInView -> Html
 account model loggedInView =
@@ -64,11 +70,58 @@ exceedingPayer model loggedInView payer =
 
 income : Model -> Account -> Html
 income model account =
+  case account.incomeEdition of
+    Just edition ->
+      incomeEdition model account edition
+    Nothing ->
+      incomeRead model account
+
+incomeRead : Model -> Account -> Html
+incomeRead model account =
   div
     [ class "income" ]
-    ( case account.income of
-        Nothing ->
-          [ text (getMessage "NoIncome" model.translations) ]
-        Just income ->
-          [ text (getParamMessage [price model income] "Income" model.translations) ]
-    )
+    [ ( case account.income of
+          Nothing ->
+            text (getMessage "NoIncome" model.translations)
+          Just income ->
+            text (getParamMessage [price model income] "Income" model.translations)
+      )
+    , toggleIncomeEdition "editIncomeEdition" (getMessage "Edit" model.translations)
+    ]
+
+incomeEdition : Model -> Account -> IncomeEdition -> Html
+incomeEdition model account edition =
+  H.form
+    [ case validateIncome edition.income model.translations of
+        Ok validatedAmount ->
+          onSubmitPrevDefault serverCommunications.address (SC.SetIncome validatedAmount)
+        Err error ->
+          onSubmitPrevDefault actions.address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error)
+    , class "income"
+    ]
+    [ label
+        [ for "incomeInput" ]
+        [ text (getMessage "NewIncome" model.translations) ]
+    , input
+        [ id "incomeInput"
+        , value edition.income
+        , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAccount << UpdateIncomeEdition)
+        , maxlength 10
+        ]
+        []
+    , button
+        [ class "validateIncomeEdition" ]
+        [ text (getMessage "Validate" model.translations) ]
+    , toggleIncomeEdition "undoIncomeEdition" (getMessage "Undo" model.translations)
+    , case edition.error of
+        Just error -> div [ class "error" ] [ text error ]
+        Nothing -> text ""
+    ]
+
+toggleIncomeEdition : String -> String -> Html
+toggleIncomeEdition className name =
+  button
+    [ class className
+    , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleIncomeEdition)
+    ]
+    [ text name ]
diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/View/LoggedIn/Add.elm
index bae3853..2167a7f 100644
--- a/src/client/View/LoggedIn/Add.elm
+++ b/src/client/View/LoggedIn/Add.elm
@@ -37,6 +37,7 @@ addPayment model loggedInView =
           in onSubmitPrevDefault serverCommunications.address action
         (resName, resCost) ->
           onSubmitPrevDefault actions.address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
+    , class "addPayment"
     ]
     [ addPaymentName loggedInView.add
     , addPaymentCost model loggedInView.add