Show montly payments with an expandable mechanism

15 files changed, 204 insertions, 80 deletions

diff --git a/src/client/Model/Payment.elm b/src/client/Model/Payment.elm
index 313c6be..1f1c4ed 100644
--- a/src/client/Model/Payment.elm
+++ b/src/client/Model/Payment.elm
@@ -4,6 +4,7 @@ module Model.Payment
   , Payment
   , PaymentId
   , paymentsDecoder
+  , paymentIdDecoder
   ) where
 
 import Date exposing (..)
diff --git a/src/client/Model/View/LoggedView.elm b/src/client/Model/View/LoggedView.elm
index 34a55a2..264fdf5 100644
--- a/src/client/Model/View/LoggedView.elm
+++ b/src/client/Model/View/LoggedView.elm
@@ -8,16 +8,17 @@ import Model.Payment exposing (Payments)
 import Model.Payers exposing (Payers)
 import Model.View.Payment.Add exposing (..)
 import Model.View.Payment.Edition exposing (..)
+import Model.View.Payment.Monthly exposing (..)
 
 type alias LoggedView =
   { users : Users
   , me : UserId
   , add : AddPayment
-  , monthlyPayments : Payments
+  , monthly : Monthly
   , payments : Payments
   , paymentsCount : Int
   , payers : Payers
-  , edition : Maybe Edition
+  , paymentEdition : Maybe Edition
   , currentPage : Int
   }
 
@@ -26,10 +27,10 @@ initLoggedView users me monthlyPayments payments paymentsCount payers =
   { users = users
   , me = me
   , add = initAddPayment Punctual
-  , monthlyPayments = monthlyPayments
+  , monthly = initMonthly monthlyPayments
   , payments = payments
   , paymentsCount = paymentsCount
   , payers = payers
-  , edition = Nothing
+  , paymentEdition = Nothing
   , currentPage = 1
   }
diff --git a/src/client/Model/View/Payment/Monthly.elm b/src/client/Model/View/Payment/Monthly.elm
new file mode 100644
index 0000000..15a5f2e
--- /dev/null
+++ b/src/client/Model/View/Payment/Monthly.elm
@@ -0,0 +1,17 @@
+module Model.View.Payment.Monthly
+  ( Monthly
+  , initMonthly
+  ) where
+
+import Model.Payment exposing (Payments)
+
+type alias Monthly =
+  { payments : Payments
+  , visibleDetail : Bool
+  }
+
+initMonthly : Payments -> Monthly
+initMonthly payments =
+  { payments = payments
+  , visibleDetail = False
+  }
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index 1f35fa1..30bd2bf 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -12,12 +12,12 @@ import Date
 
 import Model.Message exposing (messageDecoder)
 import Model.User exposing (UserId)
-import Model.Payment exposing (PaymentId, perPage, paymentsDecoder)
+import Model.Payment exposing (..)
 import Model.View.Payment.Add exposing (Frequency)
 
 import Update as U
 import Update.SignIn exposing (..)
-import Update.Payment as UP
+import Update.LoggedView as UL
 
 type Communication =
   NoCommunication
@@ -46,8 +46,8 @@ getRequest communication =
       Nothing
     SignIn login ->
       Just (simple "post" ("/signIn?login=" ++ login))
-    AddPayment userId paymentName cost frequency ->
-      Just (simple "post" ("/payment/add?name=" ++ paymentName ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)))
+    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 ->
@@ -76,36 +76,40 @@ serverResult communication response =
           Task.succeed U.NoOp
         SignIn login ->
           Task.succeed (U.UpdateSignIn (ValidLogin login))
-        AddPayment userId paymentName cost frequency ->
-          Http.send Http.defaultSettings (updatePageRequest 1)
-            |> Task.map (\response ->
-                 if response.status == 200
-                   then
-                     decodeResponse
-                       response
-                       paymentsDecoder
-                       (\payments -> U.UpdatePayment (UP.AddPayment userId cost payments))
-                   else
-                     U.NoOp
-               )
+        AddPayment userId name cost frequency ->
+          decodeResponse
+            response
+            ("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
+                   )
+            )
         DeletePayment id userId cost currentPage ->
           Http.send Http.defaultSettings (updatePageRequest currentPage)
-            |> Task.map (\response ->
+            |> flip Task.andThen (\response ->
                  if response.status == 200
                    then
                      decodeResponse
                        response
                        paymentsDecoder
-                       (\payments -> U.UpdatePayment (UP.Remove userId cost payments))
+                       (\payments -> Task.succeed <| U.UpdateLoggedView (UL.Remove userId cost payments))
                    else
-                     U.NoOp
+                     Task.succeed U.NoOp
                )
         UpdatePage page ->
           decodeResponse
             response
             paymentsDecoder
-            (\payments -> U.UpdatePayment (UP.UpdatePage page payments))
-          |> Task.succeed
+            (\payments -> Task.succeed <| U.UpdateLoggedView (UL.UpdatePage page payments))
         SignOut ->
           Task.succeed (U.GoSignInView)
     else
@@ -115,13 +119,12 @@ serverResult communication response =
         (\error ->
           case communication of
             SignIn _ ->
-              U.UpdateSignIn (ErrorLogin error)
+              Task.succeed <| U.UpdateSignIn (ErrorLogin error)
             _ ->
-              U.NoOp
+              Task.succeed <| U.NoOp
         )
-      |> Task.succeed
 
-decodeResponse : Http.Response -> Decoder a -> (a -> U.Action) -> U.Action
+decodeResponse : Http.Response -> Decoder a -> (a -> Task b U.Action) -> Task b U.Action
 decodeResponse response decoder responseToAction =
   case response.value of
     Http.Text text ->
@@ -129,6 +132,6 @@ decodeResponse response decoder responseToAction =
         Ok x ->
           responseToAction x
         Err _ ->
-          U.NoOp
+          Task.succeed U.NoOp
     Http.Blob _ ->
-      U.NoOp
+      Task.succeed U.NoOp
diff --git a/src/client/Update.elm b/src/client/Update.elm
index 08547e3..6ee5ab6 100644
--- a/src/client/Update.elm
+++ b/src/client/Update.elm
@@ -15,7 +15,7 @@ import Model.View.SignInView exposing (..)
 import Model.View.LoggedView exposing (..)
 
 import Update.SignIn exposing (..)
-import Update.Payment exposing (..)
+import Update.LoggedView exposing (..)
 
 type Action =
   NoOp
@@ -24,7 +24,7 @@ type Action =
   | SignInError String
   | UpdateSignIn SignInAction
   | GoLoggedView Users UserId Payments Payments Int Payers
-  | UpdatePayment PaymentAction
+  | UpdateLoggedView LoggedAction
 
 actions : Signal.Mailbox Action
 actions = Signal.mailbox NoOp
@@ -49,9 +49,9 @@ updateModel action model =
           { model | view <- V.SignInView (updateSignIn signInAction signInView) }
         _ ->
           model
-    UpdatePayment paymentAction ->
+    UpdateLoggedView loggedAction ->
       case model.view of
         V.LoggedView loggedView ->
-          { model | view <- V.LoggedView (updatePayment model paymentAction loggedView) }
+          { model | view <- V.LoggedView (updateLoggedView model loggedAction loggedView) }
         _ ->
           model
diff --git a/src/client/Update/Payment.elm b/src/client/Update/LoggedView.elm
index 2cae679..4a53ac4 100644
--- a/src/client/Update/Payment.elm
+++ b/src/client/Update/LoggedView.elm
@@ -1,6 +1,6 @@
-module Update.Payment
-  ( PaymentAction(..)
-  , updatePayment
+module Update.LoggedView
+  ( LoggedAction(..)
+  , updateLoggedView
   ) where
 
 import Date
@@ -13,33 +13,42 @@ import Model.Payers exposing (..)
 import Model.View.LoggedView exposing (..)
 import Model.View.Payment.Add exposing (..)
 
-import Update.Payment.Add exposing (..)
+import Update.LoggedView.Add exposing (..)
+import Update.LoggedView.Monthly exposing (..)
 
-type PaymentAction =
+type LoggedAction =
   UpdateAdd AddPaymentAction
   | UpdatePayments Payments
-  | AddPayment UserId Int Payments
+  | AddPayment UserId PaymentId String Int Frequency Payments
   | ToggleEdit PaymentId
   | Remove UserId Int Payments
   | UpdatePage Int Payments
+  | UpdateMonthly MonthlyAction
 
-updatePayment : Model -> PaymentAction -> LoggedView -> LoggedView
-updatePayment model action loggedView =
+updateLoggedView : Model -> LoggedAction -> LoggedView -> LoggedView
+updateLoggedView model action loggedView =
   case action of
     UpdateAdd addPaymentAction ->
       { loggedView | add <- updateAddPayment addPaymentAction loggedView.add }
     UpdatePayments payments ->
       { loggedView | payments <- payments }
-    AddPayment userId cost payments ->
+    AddPayment userId paymentId name cost frequency payments ->
       { loggedView
       | payments <- payments
       , currentPage <- 1
       , add <- initAddPayment loggedView.add.frequency
       , payers <- updatePayers loggedView.payers userId cost
       , paymentsCount <- loggedView.paymentsCount + 1
+      , 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
       }
     ToggleEdit id ->
-      { loggedView | edition <- if loggedView.edition == Just id then Nothing else Just id }
+      { loggedView | paymentEdition <- if loggedView.paymentEdition == Just id then Nothing else Just id }
     Remove userId cost payments ->
       { loggedView
       | payments <- payments
@@ -51,3 +60,5 @@ updatePayment model action loggedView =
       | currentPage <- page
       , payments <- payments
       }
+    UpdateMonthly monthlyAction ->
+      { loggedView | monthly <- updateMonthly monthlyAction loggedView.monthly }
diff --git a/src/client/Update/Payment/Add.elm b/src/client/Update/LoggedView/Add.elm
index 27f2af0..05c2c30 100644
--- a/src/client/Update/Payment/Add.elm
+++ b/src/client/Update/LoggedView/Add.elm
@@ -1,4 +1,4 @@
-module Update.Payment.Add
+module Update.LoggedView.Add
   ( AddPaymentAction(..)
   , updateAddPayment
   ) where
diff --git a/src/client/Update/LoggedView/Monthly.elm b/src/client/Update/LoggedView/Monthly.elm
new file mode 100644
index 0000000..8d02c5e
--- /dev/null
+++ b/src/client/Update/LoggedView/Monthly.elm
@@ -0,0 +1,19 @@
+module Update.LoggedView.Monthly
+  ( MonthlyAction(..)
+  , updateMonthly
+  ) where
+
+import Model.Payment exposing (Payment)
+import Model.View.Payment.Monthly exposing (..)
+
+type MonthlyAction =
+  ToggleDetail
+  | AddMonthlyPayment Payment
+
+updateMonthly : MonthlyAction -> Monthly -> Monthly
+updateMonthly action monthly =
+  case action of
+    ToggleDetail ->
+      { monthly | visibleDetail <- not monthly.visibleDetail }
+    AddMonthlyPayment payment ->
+      { monthly | payments <- payment :: monthly.payments }
diff --git a/src/client/View/Payments/Add.elm b/src/client/View/Payments/Add.elm
index a22c1f1..21406b2 100644
--- a/src/client/View/Payments/Add.elm
+++ b/src/client/View/Payments/Add.elm
@@ -11,8 +11,8 @@ import Result exposing (..)
 import ServerCommunication as SC exposing (serverCommunications)
 
 import Update exposing (..)
-import Update.Payment exposing (..)
-import Update.Payment.Add exposing (..)
+import Update.LoggedView exposing (..)
+import Update.LoggedView.Add exposing (..)
 
 import Model exposing (Model)
 import Model.View.Payment.Add exposing (..)
@@ -33,7 +33,7 @@ addPayment model loggedView =
         (Ok name, Ok cost) ->
           onSubmitPrevDefault serverCommunications.address (SC.AddPayment loggedView.me name cost loggedView.add.frequency)
         (resName, resCost) ->
-          onSubmitPrevDefault actions.address (UpdatePayment <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
+          onSubmitPrevDefault actions.address (UpdateLoggedView <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
     ]
     [ addPaymentName loggedView.add
     , addPaymentCost model loggedView.add
@@ -50,7 +50,7 @@ addPaymentName addPayment =
     [ input
         [ id "nameInput"
         , value addPayment.name
-        , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateName)
+        , on "input" targetValue (Signal.message actions.address << UpdateLoggedView << UpdateAdd << UpdateName)
         , maxlength 20
         ]
         []
@@ -71,7 +71,7 @@ addPaymentCost model addPayment =
     [ input
         [ id "costInput"
         , value addPayment.cost
-        , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateAdd << UpdateCost)
+        , on "input" targetValue (Signal.message actions.address << UpdateLoggedView << UpdateAdd << UpdateCost)
         , maxlength 7
         ]
         []
@@ -89,7 +89,7 @@ paymentFrequency : Model -> AddPayment -> Html
 paymentFrequency model addPayment =
   div
     [ class "frequency"
-    , onClick actions.address (UpdatePayment << UpdateAdd <| ToggleFrequency)
+    , onClick actions.address (UpdateLoggedView << UpdateAdd <| ToggleFrequency)
     ]
     [ div
         [ class ("punctual" ++ if addPayment.frequency == Punctual then " selected" else "") ]
diff --git a/src/client/View/Payments/Monthly.elm b/src/client/View/Payments/Monthly.elm
index 366af92..e115dbf 100644
--- a/src/client/View/Payments/Monthly.elm
+++ b/src/client/View/Payments/Monthly.elm
@@ -6,19 +6,58 @@ import Html exposing (..)
 import Html.Attributes exposing (..)
 import Html.Events exposing (..)
 
+import Update exposing (..)
+import Update.LoggedView exposing (..)
+import Update.LoggedView.Monthly exposing (..)
+
 import Model exposing (Model)
-import Model.Payment exposing (Payments)
+import Model.View.Payment.Monthly exposing (Monthly)
+import Model.Payment exposing (Payments, Payment)
 import Model.View.LoggedView exposing (LoggedView)
-import Model.Translations exposing (getVarMessage)
+import Model.Translations exposing (getMessage, getVarMessage)
+
+import View.Icon exposing (renderIcon)
 
 monthlyPayments : Model -> LoggedView -> Html
 monthlyPayments model loggedView =
-  div
-    [ class "monthlyPayments" ]
-    [ monthlyCount model loggedView.monthlyPayments ]
+  let monthly = loggedView.monthly
+  in  if List.isEmpty monthly.payments
+        then
+          text ""
+        else
+          div
+            [ class ("monthlyPayments" ++ if monthly.visibleDetail then " detail" else "") ]
+            [ monthlyCount model monthly
+            , if monthly.visibleDetail then paymentsTable model monthly else text ""
+            ]
 
-monthlyCount : Model -> Payments -> Html
-monthlyCount model monthlyPayments =
-  let count = List.length monthlyPayments
+monthlyCount : Model -> Monthly -> Html
+monthlyCount model monthly =
+  let count = List.length monthly.payments
       key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount"
-  in  text (getVarMessage [toString count] key model.translations)
+  in  button
+        [ class "count"
+        , onClick actions.address (UpdateLoggedView << UpdateMonthly <| ToggleDetail)
+        ]
+        [ text (getVarMessage [toString count] key model.translations)
+        , div
+            [ class "expand" ]
+            [ if monthly.visibleDetail
+                then renderIcon "chevron-up"
+                else renderIcon "chevron-down"
+            ]
+        ]
+
+paymentsTable : Model -> Monthly -> Html
+paymentsTable model monthly =
+  div
+    [ class "table" ]
+    ( List.map (paymentLine model) monthly.payments )
+
+paymentLine : Model -> Payment -> Html
+paymentLine model payment =
+  a
+    [ class "row" ]
+    [ div [ class "cell" ] [ text (payment.name) ]
+    , div [ class "cell" ] [ text (toString payment.cost ++ " " ++ getMessage "MoneySymbol" model.translations) ]
+    ]
diff --git a/src/client/View/Payments/Paging.elm b/src/client/View/Payments/Paging.elm
index b06d749..53df3b3 100644
--- a/src/client/View/Payments/Paging.elm
+++ b/src/client/View/Payments/Paging.elm
@@ -12,7 +12,7 @@ import Model.Payment exposing (perPage)
 import ServerCommunication as SC exposing (serverCommunications)
 
 import Update exposing (..)
-import Update.Payment exposing (..)
+import Update.LoggedView exposing (..)
 
 import View.Icon exposing (renderIcon)
 
diff --git a/src/client/View/Payments/Table.elm b/src/client/View/Payments/Table.elm
index 4a1ed50..4642f65 100644
--- a/src/client/View/Payments/Table.elm
+++ b/src/client/View/Payments/Table.elm
@@ -21,7 +21,7 @@ import Model.Translations exposing (getMessage)
 import ServerCommunication as SC exposing (serverCommunications)
 
 import Update exposing (..)
-import Update.Payment exposing (..)
+import Update.LoggedView exposing (..)
 
 import View.Icon exposing (renderIcon)
 import View.Date exposing (..)
@@ -30,15 +30,18 @@ paymentsTable : Model -> LoggedView -> Html
 paymentsTable model loggedView =
   div
     [ class "table" ]
-    ([ div
-        [ class "header" ]
-        [ div [ class "cell category" ] [ renderIcon "shopping-cart" ]
-        , div [ class "cell cost" ] [ text (getMessage "MoneySymbol" model.translations) ]
-        , div [ class "cell user" ] [ renderIcon "user" ]
-        , div [ class "cell date" ] [ renderIcon "calendar" ]
-        , div [ class "cell" ] []
-        ]
-    ] ++ (paymentLines model loggedView))
+    ( headerLine model :: paymentLines model loggedView)
+
+headerLine : Model -> Html
+headerLine model =
+  div
+    [ class "header" ]
+    [ div [ class "cell category" ] [ renderIcon "shopping-cart" ]
+    , div [ class "cell cost" ] [ text (getMessage "MoneySymbol" model.translations) ]
+    , div [ class "cell user" ] [ renderIcon "user" ]
+    , div [ class "cell date" ] [ renderIcon "calendar" ]
+    , div [ class "cell" ] []
+    ]
 
 paymentLines : Model -> LoggedView -> List Html
 paymentLines model loggedView =
@@ -50,8 +53,8 @@ paymentLines model loggedView =
 paymentLine : Model -> LoggedView -> Payment -> Html
 paymentLine model loggedView payment =
   a
-    [ class ("row " ++ (if loggedView.edition == Just payment.id then "edition" else ""))
-    , onClick actions.address (UpdatePayment (ToggleEdit payment.id))
+    [ 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 ]
     , div [ class "cell cost" ] [ text ((toString payment.cost) ++ " " ++ (getMessage "MoneySymbol" model.translations)) ]
diff --git a/src/server/Controller/Payment.hs b/src/server/Controller/Payment.hs
index 7944ecd..25d3261 100644
--- a/src/server/Controller/Payment.hs
+++ b/src/server/Controller/Payment.hs
@@ -24,6 +24,7 @@ import Model.Payment
 import Model.Frequency
 import Model.Json.Message
 import Model.Json.Number
+import qualified Model.Json.PaymentId as JP
 import Model.Message
 import Model.Message.Key (Key(PaymentNotDeleted))
 
@@ -42,8 +43,8 @@ getMonthlyPaymentsAction =
 createPaymentAction :: Text -> Int -> Frequency -> ActionM ()
 createPaymentAction name cost frequency =
   Secure.loggedAction (\user -> do
-    _ <- liftIO . runDb $ createPayment (entityKey user) name cost frequency
-    status ok200
+    paymentId <- liftIO . runDb $ createPayment (entityKey user) name cost frequency
+    json (JP.PaymentId paymentId)
   )
 
 deletePaymentAction :: Text -> ActionM ()
diff --git a/src/server/Design/Global.hs b/src/server/Design/Global.hs
index 0af071e..098269b 100644
--- a/src/server/Design/Global.hs
+++ b/src/server/Design/Global.hs
@@ -54,6 +54,7 @@ global = do
       hover & transform (scale 1.2 1.2)
 
   ".payments" ? do
+    let inputHeight = 40
 
     ".exceedingPayers" ? do
       width (pct 95)
@@ -67,7 +68,6 @@ global = do
       ".exceedingPayer" Clay.** ".userName" ? marginRight (px 10)
 
     form # ".add" ? do
-      let inputHeight = 40
       width (pct 95)
       marginLeft auto
       marginRight auto
@@ -143,9 +143,21 @@ global = do
     ".monthlyPayments" ? do
       width (pct 95)
       margin (px 0) auto (px 45) auto
-      padding (px 10) (px 10) (px 10) (px 10)
-      backgroundColor C.lightGrey
-      borderRadius radius radius radius radius
+
+      button # ".count" ? do
+        width (pct 100)
+        defaultButton C.blue C.white inputHeight
+        borderRadius radius radius radius radius
+        textAlign (alignSide sideLeft)
+        position relative
+
+        ".expand" ? do
+          float floatRight
+          marginTop (px (-2))
+
+      ".detail" &
+        button # ".count" ?
+          borderRadius radius radius 0 0
 
     ".table" ? do
       display D.table
diff --git a/src/server/Model/Json/PaymentId.hs b/src/server/Model/Json/PaymentId.hs
new file mode 100644
index 0000000..3cbeb3c
--- /dev/null
+++ b/src/server/Model/Json/PaymentId.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Model.Json.PaymentId
+  ( PaymentId(..)
+  ) where
+
+import Data.Aeson
+import GHC.Generics
+
+import qualified Model.Database as D
+
+data PaymentId = PaymentId
+  { id :: D.PaymentId
+  } deriving (Show, Generic)
+
+instance FromJSON PaymentId
+instance ToJSON PaymentId