Adding UI to modify the income

11 files changed, 199 insertions, 16 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
diff --git a/src/server/Design/Helper.hs b/src/server/Design/Helper.hs
index 53839c1..6e2fde3 100644
--- a/src/server/Design/Helper.hs
+++ b/src/server/Design/Helper.hs
@@ -6,6 +6,7 @@ module Design.Helper
   , defaultInput
   , centeredWithMargin
   , expandBlock
+  , verticalCentering
   ) where
 
 import Clay
@@ -60,3 +61,9 @@ expandBlock headerBackground headerColor headerHeight = do
     position relative
     paddingLeft blockPadding
     paddingRight (px 55)
+
+verticalCentering :: Css
+verticalCentering = do
+  position absolute
+  top (pct 50)
+  "transform" -: "translateY(-50%)"
diff --git a/src/server/Design/LoggedIn.hs b/src/server/Design/LoggedIn.hs
index 6bfa034..35a30a6 100644
--- a/src/server/Design/LoggedIn.hs
+++ b/src/server/Design/LoggedIn.hs
@@ -6,10 +6,6 @@ module Design.LoggedIn
 
 import Clay
 
-import Design.Color as C
-import Design.Helper
-import Design.Constants
-
 import Design.LoggedIn.Add
 import Design.LoggedIn.Expandables
 import Design.LoggedIn.Table
diff --git a/src/server/Design/LoggedIn/Add.hs b/src/server/Design/LoggedIn/Add.hs
index 6d4de69..579cead 100644
--- a/src/server/Design/LoggedIn/Add.hs
+++ b/src/server/Design/LoggedIn/Add.hs
@@ -15,7 +15,7 @@ import Design.Constants
 addDesign :: Css
 addDesign =
 
-  form ? do
+  form # ".addPayment" ? do
     centeredWithMargin
     marginBottom blockMarginBottom
     display flex
@@ -28,7 +28,7 @@ addDesign =
       label ? do
         fontWeight bold
         display inlineBlock
-        width (px 40)
+        width (px 50)
         textAlign (alignSide sideCenter)
         backgroundColor C.darkGrey
         color C.white
diff --git a/src/server/Design/LoggedIn/Expandables.hs b/src/server/Design/LoggedIn/Expandables.hs
index 3807da4..66a9b06 100644
--- a/src/server/Design/LoggedIn/Expandables.hs
+++ b/src/server/Design/LoggedIn/Expandables.hs
@@ -4,6 +4,8 @@ module Design.LoggedIn.Expandables
   ( expandablesDesign
   ) where
 
+import Data.Monoid ((<>))
+
 import Clay
 
 import Design.Color as C
@@ -31,7 +33,30 @@ expandablesDesign =
 
       ".income" ? do
         backgroundColor C.lightGrey
-        lineHeight rowHeight
         padding (px 0) (px 20) (px 0) (px 20)
+        position relative
+        lineHeight rowHeight
+
+        input ? do
+          defaultInput inputHeight
+          marginLeft (px 20)
+          marginTop (px (-5))
+          width (px 100)
+
+        button ? do
+          marginLeft (px 20)
+          paddingLeft (px 15)
+          paddingRight (px 15)
+          marginTop (px (-5))
+
+        ".validateIncomeEdition" <> ".editIncomeEdition" ?
+          defaultButton C.red C.white (px inputHeight)
+
+        ".undoIncomeEdition" ?
+          defaultButton C.blue C.white (px inputHeight)
+
+        ".error" ? do
+          color C.redError
+          lineHeight (px 30)
 
     ".detail" |> ".header" ? borderRadius radius radius 0 0
diff --git a/src/server/Model/Message/Key.hs b/src/server/Model/Message/Key.hs
index 9f16f6b..bd2b567 100644
--- a/src/server/Model/Message/Key.hs
+++ b/src/server/Model/Message/Key.hs
@@ -45,6 +45,8 @@ data Key =
   | CategoryRequired
   | CostRequired
   | CostMustBeNonNullNumber
+  | IncomeRequired
+  | IncomeMustBeNonNullNumber
 
   -- Payments
 
@@ -60,5 +62,9 @@ data Key =
 
   | Income
   | NoIncome
+  | Edit
+  | Validate
+  | Undo
+  | NewIncome
 
   deriving (Enum, Bounded, Show)
diff --git a/src/server/Model/Message/Translations.hs b/src/server/Model/Message/Translations.hs
index 8c27a2d..8c6a233 100644
--- a/src/server/Model/Message/Translations.hs
+++ b/src/server/Model/Message/Translations.hs
@@ -193,6 +193,16 @@ m l CostMustBeNonNullNumber =
     English -> "The cost must be a non-null integer."
     French  -> "Le coût doit être un entier non nul."
 
+m l IncomeRequired =
+  case l of
+    English -> "Type an income."
+    French  -> "Entre un revenu."
+
+m l IncomeMustBeNonNullNumber =
+  case l of
+    English -> "The income must be a non-null integer."
+    French  -> "Le revenu doit être un entier non nul."
+
 -- Payments
 
 m l Add =
@@ -235,6 +245,8 @@ m l PluralMonthlyCount =
         French  -> "{1} paiements mensuels comptabilisant {2}"
     ]
 
+-- Income
+
 m l Income =
   T.concat
     [ case l of
@@ -246,3 +258,23 @@ m l NoIncome =
   case l of
     English -> "Income not given"
     French  -> "Revenu non renseigné"
+
+m l Edit =
+  case l of
+    English -> "Edit"
+    French  -> "Éditer"
+
+m l Validate =
+  case l of
+    English -> "Validate"
+    French  -> "Valider"
+
+m l Undo =
+  case l of
+    English -> "Undo"
+    French  -> "Annuler"
+
+m l NewIncome =
+  case l of
+    English -> "New income"
+    French  -> "Nouveau revenu"