aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/client/Model/Payment.elm1
-rw-r--r--src/client/Model/View/LoggedView.elm9
-rw-r--r--src/client/Model/View/Payment/Monthly.elm17
-rw-r--r--src/client/ServerCommunication.elm57
-rw-r--r--src/client/Update.elm8
-rw-r--r--src/client/Update/LoggedView.elm (renamed from src/client/Update/Payment.elm)31
-rw-r--r--src/client/Update/LoggedView/Add.elm (renamed from src/client/Update/Payment/Add.elm)2
-rw-r--r--src/client/Update/LoggedView/Monthly.elm19
-rw-r--r--src/client/View/Payments/Add.elm12
-rw-r--r--src/client/View/Payments/Monthly.elm57
-rw-r--r--src/client/View/Payments/Paging.elm2
-rw-r--r--src/client/View/Payments/Table.elm27
-rw-r--r--src/server/Controller/Payment.hs5
-rw-r--r--src/server/Design/Global.hs20
-rw-r--r--src/server/Model/Json/PaymentId.hs17
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 17:53:44 +0000