From 0ae7d068263dffbc1cc2dc92c7829dd0037c97e7 Mon Sep 17 00:00:00 2001
From: Joris
Date: Sun, 6 Sep 2015 15:54:38 +0200
Subject: The user can remove a monthly payment

---
 public/css/reset.css                     | 13 ++---
 src/client/Model/Translations.elm        |  8 +--
 src/client/ServerCommunication.elm       | 93 ++++++++++++++++----------------
 src/client/Update/LoggedView.elm         | 29 +++++-----
 src/client/Update/LoggedView/Monthly.elm | 16 ++++--
 src/client/View/Date.elm                 |  4 +-
 src/client/View/Payments/Add.elm         |  6 ++-
 src/client/View/Payments/Monthly.elm     | 27 ++++++----
 src/client/View/Payments/Table.elm       |  4 +-
 src/server/Design/Global.hs              | 46 +++++++++-------
 src/server/Model/Message.hs              |  8 +--
 src/server/View/Mail/SignIn.hs           |  4 +-
 12 files changed, 143 insertions(+), 115 deletions(-)

diff --git a/public/css/reset.css b/public/css/reset.css
index c8dafbf..dfaff5f 100644
--- a/public/css/reset.css
+++ b/public/css/reset.css
@@ -47,13 +47,8 @@ a {
   color: inherit;
 }
 
-button:hover {
-  cursor: pointer;
-}
+button { padding: 0; }
+button:hover { cursor: pointer; }
 
-html {
-  box-sizing: border-box;
-}
-*, *:before, *:after {
-  box-sizing: inherit;
-}
+html { box-sizing: border-box; }
+*, *:before, *:after { box-sizing: inherit; }
diff --git a/src/client/Model/Translations.elm b/src/client/Model/Translations.elm
index 2a8a3a7..a6de961 100644
--- a/src/client/Model/Translations.elm
+++ b/src/client/Model/Translations.elm
@@ -3,7 +3,7 @@ module Model.Translations
   , Translations
   , Translation
   , getMessage
-  , getVarMessage
+  , getParamMessage
   ) where
 
 import Maybe exposing (withDefault)
@@ -51,10 +51,10 @@ partDecoderWithTag tag =
 -----
 
 getMessage : String -> Translations -> String
-getMessage = getVarMessage []
+getMessage = getParamMessage []
 
-getVarMessage : List String -> String -> Translations -> String
-getVarMessage values key translations =
+getParamMessage : List String -> String -> Translations -> String
+getParamMessage values key translations =
   getTranslation key translations
     |> Maybe.map (\parts -> String.concat (List.map (replacePart values) parts))
     |> withDefault key
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index 30bd2bf..20e2b14 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -13,17 +13,20 @@ import Date
 import Model.Message exposing (messageDecoder)
 import Model.User exposing (UserId)
 import Model.Payment exposing (..)
-import Model.View.Payment.Add exposing (Frequency)
+import Model.View.Payment.Add exposing (Frequency(..))
 
 import Update as U
 import Update.SignIn exposing (..)
 import Update.LoggedView as UL
+import Update.LoggedView.Monthly as UM
 
 type Communication =
   NoCommunication
   | SignIn String
-  | AddPayment UserId String Int Frequency
+  | AddPayment UserId String Int
+  | AddMonthlyPayment String Int
   | DeletePayment PaymentId UserId Int Int
+  | DeleteMonthlyPayment PaymentId
   | UpdatePage Int
   | SignOut
 
@@ -42,18 +45,22 @@ sendRequest communication =
 getRequest : Communication -> Maybe Http.Request
 getRequest communication =
   case communication of
-    NoCommunication ->
-      Nothing
-    SignIn login ->
-      Just (simple "post" ("/signIn?login=" ++ login))
-    AddPayment userId name cost frequency ->
-      Just (simple "post" ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)))
-    DeletePayment paymentId _ _ _ ->
-      Just (simple "post" ("payment/delete?id=" ++ (toString paymentId)))
-    UpdatePage page ->
-      Just (updatePageRequest page)
-    SignOut ->
-      Just (simple "post"  "/signOut")
+    NoCommunication                -> Nothing
+    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)
+    DeletePayment paymentId _ _ _  -> Just (deletePaymentRequest paymentId)
+    DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId)
+    UpdatePage page                -> Just (updatePageRequest page)
+    SignOut                        -> Just (simple "post"  "/signOut")
+
+addPaymentRequest : String -> Int -> Frequency -> Http.Request
+addPaymentRequest name cost frequency =
+  simple "post" ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency))
+
+deletePaymentRequest : PaymentId -> Http.Request
+deletePaymentRequest id =
+  simple "post" ("payment/delete?id=" ++ (toString id))
 
 updatePageRequest : Int -> Http.Request
 updatePageRequest page =
@@ -75,46 +82,33 @@ serverResult communication response =
         NoCommunication ->
           Task.succeed U.NoOp
         SignIn login ->
-          Task.succeed (U.UpdateSignIn (ValidLogin login))
-        AddPayment userId name cost frequency ->
-          decodeResponse
-            response
+          Task.succeed << U.UpdateSignIn <| ValidLogin login
+        AddPayment userId name cost ->
+          Http.send Http.defaultSettings (updatePageRequest 1)
+            |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments ->
+                 Task.succeed <| U.UpdateLoggedView (UL.AddPayment userId name cost payments)
+               ))
+        AddMonthlyPayment name cost ->
+          decodeOkResponse
             ("id" := paymentIdDecoder)
-            (\paymentId ->
-              Http.send Http.defaultSettings (updatePageRequest 1)
-                |> flip Task.andThen (\response2 ->
-                     if response2.status == 200
-                       then
-                         decodeResponse
-                           response2
-                           paymentsDecoder
-                           (\payments -> Task.succeed <| U.UpdateLoggedView (UL.AddPayment userId paymentId name cost frequency payments))
-                       else
-                         Task.succeed U.NoOp
-                   )
-            )
+            (\id -> Task.succeed <| U.UpdateLoggedView (UL.AddMonthlyPayment id name cost))
+            response
         DeletePayment id userId cost currentPage ->
           Http.send Http.defaultSettings (updatePageRequest currentPage)
-            |> flip Task.andThen (\response ->
-                 if response.status == 200
-                   then
-                     decodeResponse
-                       response
-                       paymentsDecoder
-                       (\payments -> Task.succeed <| U.UpdateLoggedView (UL.Remove userId cost payments))
-                   else
-                     Task.succeed U.NoOp
-               )
+            |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments ->
+                 Task.succeed <| U.UpdateLoggedView (UL.DeletePayment userId cost payments)
+               ))
+        DeleteMonthlyPayment id ->
+          Task.succeed <| U.UpdateLoggedView (UL.UpdateMonthly (UM.DeletePayment id))
         UpdatePage page ->
-          decodeResponse
-            response
+          decodeOkResponse
             paymentsDecoder
             (\payments -> Task.succeed <| U.UpdateLoggedView (UL.UpdatePage page payments))
+            response
         SignOut ->
           Task.succeed (U.GoSignInView)
     else
       decodeResponse
-        response
         messageDecoder
         (\error ->
           case communication of
@@ -123,9 +117,16 @@ serverResult communication response =
             _ ->
               Task.succeed <| U.NoOp
         )
+        response
+
+decodeOkResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action
+decodeOkResponse decoder responseToAction response =
+  if response.status == 200
+    then decodeResponse decoder responseToAction response
+    else Task.succeed U.NoOp
 
-decodeResponse : Http.Response -> Decoder a -> (a -> Task b U.Action) -> Task b U.Action
-decodeResponse response decoder responseToAction =
+decodeResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action
+decodeResponse decoder responseToAction response =
   case response.value of
     Http.Text text ->
       case decodeString decoder text of
diff --git a/src/client/Update/LoggedView.elm b/src/client/Update/LoggedView.elm
index 4a53ac4..cf6bcb2 100644
--- a/src/client/Update/LoggedView.elm
+++ b/src/client/Update/LoggedView.elm
@@ -14,16 +14,17 @@ import Model.View.LoggedView exposing (..)
 import Model.View.Payment.Add exposing (..)
 
 import Update.LoggedView.Add exposing (..)
-import Update.LoggedView.Monthly exposing (..)
+import Update.LoggedView.Monthly as UM
 
 type LoggedAction =
   UpdateAdd AddPaymentAction
   | UpdatePayments Payments
-  | AddPayment UserId PaymentId String Int Frequency Payments
+  | AddPayment UserId String Int Payments
+  | AddMonthlyPayment PaymentId String Int
   | ToggleEdit PaymentId
-  | Remove UserId Int Payments
+  | DeletePayment UserId Int Payments
   | UpdatePage Int Payments
-  | UpdateMonthly MonthlyAction
+  | UpdateMonthly UM.MonthlyAction
 
 updateLoggedView : Model -> LoggedAction -> LoggedView -> LoggedView
 updateLoggedView model action loggedView =
@@ -32,24 +33,24 @@ updateLoggedView model action loggedView =
       { loggedView | add <- updateAddPayment addPaymentAction loggedView.add }
     UpdatePayments payments ->
       { loggedView | payments <- payments }
-    AddPayment userId paymentId name cost frequency payments ->
+    AddPayment userId name cost payments ->
       { loggedView
       | payments <- payments
       , currentPage <- 1
-      , add <- initAddPayment loggedView.add.frequency
+      , add <- initAddPayment Punctual
       , payers <- updatePayers loggedView.payers userId cost
       , paymentsCount <- loggedView.paymentsCount + 1
+      }
+    AddMonthlyPayment id name cost ->
+      { loggedView
+      | add <- initAddPayment Monthly
       , monthly <-
-          if frequency == Monthly
-            then
-              let payment = Payment paymentId (Date.fromTime model.currentTime) name cost userId
-              in  updateMonthly (AddMonthlyPayment payment) loggedView.monthly
-            else
-              loggedView.monthly
+          let payment = Payment id (Date.fromTime model.currentTime) name cost loggedView.me
+          in  UM.updateMonthly (UM.AddPayment payment) loggedView.monthly
       }
     ToggleEdit id ->
       { loggedView | paymentEdition <- if loggedView.paymentEdition == Just id then Nothing else Just id }
-    Remove userId cost payments ->
+    DeletePayment userId cost payments ->
       { loggedView
       | payments <- payments
       , payers <- updatePayers loggedView.payers userId -cost
@@ -61,4 +62,4 @@ updateLoggedView model action loggedView =
       , payments <- payments
       }
     UpdateMonthly monthlyAction ->
-      { loggedView | monthly <- updateMonthly monthlyAction loggedView.monthly }
+      { loggedView | monthly <- UM.updateMonthly monthlyAction loggedView.monthly }
diff --git a/src/client/Update/LoggedView/Monthly.elm b/src/client/Update/LoggedView/Monthly.elm
index 8d02c5e..567025f 100644
--- a/src/client/Update/LoggedView/Monthly.elm
+++ b/src/client/Update/LoggedView/Monthly.elm
@@ -3,17 +3,25 @@ module Update.LoggedView.Monthly
   , updateMonthly
   ) where
 
-import Model.Payment exposing (Payment)
+import Model.Payment exposing (Payment, PaymentId)
 import Model.View.Payment.Monthly exposing (..)
 
 type MonthlyAction =
   ToggleDetail
-  | AddMonthlyPayment Payment
+  | AddPayment Payment
+  | DeletePayment PaymentId
 
 updateMonthly : MonthlyAction -> Monthly -> Monthly
 updateMonthly action monthly =
   case action of
     ToggleDetail ->
       { monthly | visibleDetail <- not monthly.visibleDetail }
-    AddMonthlyPayment payment ->
-      { monthly | payments <- payment :: monthly.payments }
+    AddPayment payment ->
+      { monthly
+      | payments <- payment :: monthly.payments
+      , visibleDetail <- True
+      }
+    DeletePayment id ->
+      { monthly
+      | payments <- List.filter (\payment -> payment.id /= id) monthly.payments
+      }
diff --git a/src/client/View/Date.elm b/src/client/View/Date.elm
index c239713..81c5112 100644
--- a/src/client/View/Date.elm
+++ b/src/client/View/Date.elm
@@ -15,7 +15,7 @@ renderShortDate date translations =
         , String.pad 2 '0' (toString (getMonthNumber (Date.month date)))
         , toString (Date.year date)
         ]
-  in  getVarMessage params "ShortDate" translations
+  in  getParamMessage params "ShortDate" translations
 
 renderLongDate : Date -> Translations -> String
 renderLongDate date translations =
@@ -24,7 +24,7 @@ renderLongDate date translations =
         , (getMessage (getMonthKey (Date.month date)) translations)
         , toString (Date.year date)
         ]
-  in  getVarMessage params "LongDate" translations
+  in  getParamMessage params "LongDate" translations
 
 getMonthNumber : Month -> Int
 getMonthNumber month =
diff --git a/src/client/View/Payments/Add.elm b/src/client/View/Payments/Add.elm
index 21406b2..deffb95 100644
--- a/src/client/View/Payments/Add.elm
+++ b/src/client/View/Payments/Add.elm
@@ -31,7 +31,11 @@ addPayment model loggedView =
     [ class "add"
     , case (validateName loggedView.add.name model.translations, validateCost loggedView.add.cost model.translations) of
         (Ok name, Ok cost) ->
-          onSubmitPrevDefault serverCommunications.address (SC.AddPayment loggedView.me name cost loggedView.add.frequency)
+          let action =
+                case loggedView.add.frequency of
+                  Punctual -> SC.AddPayment loggedView.me name cost
+                  Monthly -> SC.AddMonthlyPayment name cost
+          in onSubmitPrevDefault serverCommunications.address action
         (resName, resCost) ->
           onSubmitPrevDefault actions.address (UpdateLoggedView <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
     ]
diff --git a/src/client/View/Payments/Monthly.elm b/src/client/View/Payments/Monthly.elm
index e115dbf..944314c 100644
--- a/src/client/View/Payments/Monthly.elm
+++ b/src/client/View/Payments/Monthly.elm
@@ -14,7 +14,9 @@ import Model exposing (Model)
 import Model.View.Payment.Monthly exposing (Monthly)
 import Model.Payment exposing (Payments, Payment)
 import Model.View.LoggedView exposing (LoggedView)
-import Model.Translations exposing (getMessage, getVarMessage)
+import Model.Translations exposing (getMessage, getParamMessage)
+
+import ServerCommunication as SC exposing (serverCommunications)
 
 import View.Icon exposing (renderIcon)
 
@@ -28,7 +30,7 @@ monthlyPayments model loggedView =
           div
             [ class ("monthlyPayments" ++ if monthly.visibleDetail then " detail" else "") ]
             [ monthlyCount model monthly
-            , if monthly.visibleDetail then paymentsTable model monthly else text ""
+            , if monthly.visibleDetail then paymentsTable model loggedView monthly else text ""
             ]
 
 monthlyCount : Model -> Monthly -> Html
@@ -39,7 +41,7 @@ monthlyCount model monthly =
         [ class "count"
         , onClick actions.address (UpdateLoggedView << UpdateMonthly <| ToggleDetail)
         ]
-        [ text (getVarMessage [toString count] key model.translations)
+        [ text (getParamMessage [toString count] key model.translations)
         , div
             [ class "expand" ]
             [ if monthly.visibleDetail
@@ -48,16 +50,23 @@ monthlyCount model monthly =
             ]
         ]
 
-paymentsTable : Model -> Monthly -> Html
-paymentsTable model monthly =
+paymentsTable : Model -> LoggedView -> Monthly -> Html
+paymentsTable model loggedView monthly =
   div
     [ class "table" ]
-    ( List.map (paymentLine model) monthly.payments )
+    ( List.map (paymentLine model loggedView) monthly.payments )
 
-paymentLine : Model -> Payment -> Html
-paymentLine model payment =
+paymentLine : Model -> LoggedView -> Payment -> Html
+paymentLine model loggedView payment =
   a
-    [ class "row" ]
+    [ class ("row" ++ (if loggedView.paymentEdition == Just payment.id then " edition" else ""))
+    , onClick actions.address (UpdateLoggedView (ToggleEdit payment.id))
+    ]
     [ div [ class "cell" ] [ text (payment.name) ]
     , div [ class "cell" ] [ text (toString payment.cost ++ " " ++ getMessage "MoneySymbol" model.translations) ]
+    , div
+        [ class "cell delete"
+        , onClick serverCommunications.address (SC.DeleteMonthlyPayment payment.id)
+        ]
+        [ renderIcon "times" ]
     ]
diff --git a/src/client/View/Payments/Table.elm b/src/client/View/Payments/Table.elm
index 4642f65..1646186 100644
--- a/src/client/View/Payments/Table.elm
+++ b/src/client/View/Payments/Table.elm
@@ -53,7 +53,7 @@ paymentLines model loggedView =
 paymentLine : Model -> LoggedView -> Payment -> Html
 paymentLine model loggedView payment =
   a
-    [ class ("row " ++ (if loggedView.paymentEdition == Just payment.id then "edition" else ""))
+    [ class ("row" ++ (if loggedView.paymentEdition == Just payment.id then " edition" else ""))
     , onClick actions.address (UpdateLoggedView (ToggleEdit payment.id))
     ]
     [ div [ class "cell category" ] [ text payment.name ]
@@ -77,7 +77,7 @@ paymentLine model loggedView payment =
     , if loggedView.me == payment.userId
         then
           div
-            [ class "cell remove"
+            [ class "cell delete"
             , onClick serverCommunications.address (SC.DeletePayment payment.id payment.userId payment.cost loggedView.currentPage)
             ]
             [ renderIcon "times" ]
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 098269b..80498f8 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -17,12 +17,15 @@ import Design.Media
 globalDesign :: Text
 globalDesign = renderWith compact [] global
 
-iconFontSize :: Integer
-iconFontSize = 32
+iconFontSize :: Size Abs
+iconFontSize = px 32
 
 radius :: Size Abs
 radius = px 3
 
+blockPadding :: Size Abs
+blockPadding = px 15
+
 global :: Css
 global = do
 
@@ -50,28 +53,27 @@ global = do
       backgroundColor C.white
       color C.red
       borderWidth (px 0)
-      fontSize (px iconFontSize)
+      fontSize iconFontSize
       hover & transform (scale 1.2 1.2)
 
   ".payments" ? do
     let inputHeight = 40
 
     ".exceedingPayers" ? do
-      width (pct 95)
-      margin (px 0) auto (px 45) auto
-      padding (px 15) (px 15) (px 15) (px 15)
+      centeredWithMargin
       backgroundColor C.green
       color C.white
       fontWeight bold
-      borderRadius (px 5) (px 5) (px 5) (px 5)
+      borderRadius radius radius radius radius
+      paddingLeft blockPadding
+      paddingRight blockPadding
 
-      ".exceedingPayer" Clay.** ".userName" ? marginRight (px 10)
+      ".exceedingPayer" ? do
+        lineHeight (px inputHeight)
+        ".userName" ? marginRight (px 10)
 
     form # ".add" ? do
-      width (pct 95)
-      marginLeft auto
-      marginRight auto
-      marginBottom (px 45)
+      centeredWithMargin
       clearFix
 
       ".name" <> ".cost" ? do
@@ -141,8 +143,7 @@ global = do
         left (px 0)
 
     ".monthlyPayments" ? do
-      width (pct 95)
-      margin (px 0) auto (px 45) auto
+      centeredWithMargin
 
       button # ".count" ? do
         width (pct 100)
@@ -150,6 +151,8 @@ global = do
         borderRadius radius radius radius radius
         textAlign (alignSide sideLeft)
         position relative
+        paddingLeft blockPadding
+        paddingRight blockPadding
 
         ".expand" ? do
           float floatRight
@@ -171,7 +174,7 @@ global = do
         fontWeight bold
         backgroundColor C.red
         color C.white
-        fontSize (px iconFontSize)
+        fontSize iconFontSize
         lineHeight (px 70)
 
       ".row" ? do
@@ -181,7 +184,7 @@ global = do
         nthChild "odd" & backgroundColor C.lightGrey
         ".edition" & do
           backgroundColor C.paymentFocus
-          ".remove" ? visibility visible
+          ".delete" ? visibility visible
 
       ".cell" ? do
         display tableCell
@@ -196,7 +199,7 @@ global = do
           largeScreen $ do
             ".shortDate" ? display none
             ".longDate" ? display inline
-        ".remove" & do
+        ".delete" & do
           width (px 10)
           height (px 10)
           textAlign (alignSide sideCenter)
@@ -212,7 +215,7 @@ global = do
         display inlineBlock
         border solid (px 2) C.darkGrey
         color C.darkGrey
-        borderRadius (px 2) (px 2) (px 2) (px 2)
+        borderRadius radius radius radius radius
         marginRight (px 10)
         let side = 50
         width (px side)
@@ -280,3 +283,10 @@ defaultInput inputHeight = do
   border solid (px 1) C.darkGrey
   focus & borderColor C.grey
   verticalAlign middle
+
+centeredWithMargin :: Css
+centeredWithMargin = do
+  width (pct 95)
+  marginLeft auto
+  marginRight auto
+  marginBottom (px 45)
diff --git a/src/server/Model/Message.hs b/src/server/Model/Message.hs
index 12893b8..f647ce2 100644
--- a/src/server/Model/Message.hs
+++ b/src/server/Model/Message.hs
@@ -1,6 +1,6 @@
 module Model.Message
   ( getMessage
-  , getVarMessage
+  , getParamMessage
   , getTranslations
   ) where
 
@@ -16,10 +16,10 @@ import Model.Json.Translations
 import Model.Json.Translation
 
 getMessage :: Key -> Text
-getMessage = getVarMessage []
+getMessage = getParamMessage []
 
-getVarMessage :: [Text] -> Key -> Text
-getVarMessage values key = replaceParts values (getNonFormattedMessage lang key)
+getParamMessage :: [Text] -> Key -> Text
+getParamMessage values key = replaceParts values (getNonFormattedMessage lang key)
 
 getTranslations :: Translations
 getTranslations = Translations (map getTranslation [minBound..])
diff --git a/src/server/View/Mail/SignIn.hs b/src/server/View/Mail/SignIn.hs
index 5eb181b..fc73dae 100644
--- a/src/server/View/Mail/SignIn.hs
+++ b/src/server/View/Mail/SignIn.hs
@@ -31,7 +31,7 @@ plainBody :: User -> Text -> LT.Text
 plainBody user url =
   LT.intercalate
     "\n"
-    [ strictToLazy (getVarMessage [userName user] HiMail)
+    [ strictToLazy (getParamMessage [userName user] HiMail)
     , ""
     , strictToLazy (getMessage SignInLinkMail)
     , strictToLazy url
@@ -40,7 +40,7 @@ plainBody user url =
 htmlBody :: User -> Text -> LT.Text
 htmlBody user url =
   renderHtml . docTypeHtml . body $ do
-    toHtml $ strictToLazy (getVarMessage [userName user] HiMail)
+    toHtml $ strictToLazy (getParamMessage [userName user] HiMail)
     br
     br
     toHtml $ strictToLazy (getMessage SignInLinkMail)
-- 
cgit v1.2.3