From 166cd04e4b28770ede854dafc9ae30eae64102fe Mon Sep 17 00:00:00 2001 From: Joris Date: Mon, 28 Mar 2016 17:51:14 +0200 Subject: Create an empty but reachable user page --- src/client/elm/LoggedIn/Home/Account/Action.elm | 17 +++ src/client/elm/LoggedIn/Home/Account/Model.elm | 64 ++++++++++ src/client/elm/LoggedIn/Home/Account/Update.elm | 75 +++++++++++ src/client/elm/LoggedIn/Home/Account/View.elm | 133 ++++++++++++++++++++ src/client/elm/LoggedIn/Home/Action.elm | 22 ++++ src/client/elm/LoggedIn/Home/AddPayment/Action.elm | 11 ++ src/client/elm/LoggedIn/Home/AddPayment/Model.elm | 29 +++++ src/client/elm/LoggedIn/Home/AddPayment/Update.elm | 55 ++++++++ src/client/elm/LoggedIn/Home/AddPayment/View.elm | 129 +++++++++++++++++++ src/client/elm/LoggedIn/Home/Model.elm | 37 ++++++ src/client/elm/LoggedIn/Home/Model/Payer.elm | 122 ++++++++++++++++++ src/client/elm/LoggedIn/Home/Monthly/Action.elm | 10 ++ src/client/elm/LoggedIn/Home/Monthly/Model.elm | 17 +++ src/client/elm/LoggedIn/Home/Monthly/Update.elm | 21 ++++ src/client/elm/LoggedIn/Home/Monthly/View.elm | 91 ++++++++++++++ src/client/elm/LoggedIn/Home/Update.elm | 139 +++++++++++++++++++++ src/client/elm/LoggedIn/Home/View.elm | 34 +++++ src/client/elm/LoggedIn/Home/View/Date.elm | 59 +++++++++ src/client/elm/LoggedIn/Home/View/Expand.elm | 25 ++++ src/client/elm/LoggedIn/Home/View/Paging.elm | 102 +++++++++++++++ src/client/elm/LoggedIn/Home/View/Price.elm | 38 ++++++ src/client/elm/LoggedIn/Home/View/Table.elm | 98 +++++++++++++++ 22 files changed, 1328 insertions(+) create mode 100644 src/client/elm/LoggedIn/Home/Account/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/Account/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/Account/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/Account/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/AddPayment/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/Model/Payer.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/Action.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/Model.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/Monthly/View.elm create mode 100644 src/client/elm/LoggedIn/Home/Update.elm create mode 100644 src/client/elm/LoggedIn/Home/View.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Date.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Expand.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Paging.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Price.elm create mode 100644 src/client/elm/LoggedIn/Home/View/Table.elm (limited to 'src/client/elm/LoggedIn/Home') diff --git a/src/client/elm/LoggedIn/Home/Account/Action.elm b/src/client/elm/LoggedIn/Home/Account/Action.elm new file mode 100644 index 0000000..61dae42 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/Action.elm @@ -0,0 +1,17 @@ +module LoggedIn.Home.Account.Action + ( Action(..) + ) where + +import Time exposing (Time) + +import Model.User exposing (UserId) +import Model.Income exposing (IncomeId) + +type Action = + NoOp + | ToggleDetail + | ToggleIncomeEdition + | UpdateIncomeEdition String + | UpdateEditionError String + | UpdateIncome Time Int + | ValidateUpdateIncome IncomeId Time Int diff --git a/src/client/elm/LoggedIn/Home/Account/Model.elm b/src/client/elm/LoggedIn/Home/Account/Model.elm new file mode 100644 index 0000000..d8bf748 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/Model.elm @@ -0,0 +1,64 @@ +module LoggedIn.Home.Account.Model + ( Model + , IncomeEdition + , init + , initIncomeEdition + , getCurrentIncome + , validateIncome + ) where + +import Result as Result exposing (Result(..)) +import Dict +import String + +import Utils.Dict exposing (mapValues) + +import Model.Translations exposing (..) +import Model.Income exposing (..) +import Model.User exposing (UserId) + +type alias Model = + { me : UserId + , incomes : Incomes + , visibleDetail : Bool + , incomeEdition : Maybe IncomeEdition + } + +init : UserId -> Incomes -> Model +init me incomes = + { me = me + , incomes = incomes + , visibleDetail = False + , incomeEdition = Nothing + } + +getCurrentIncome : Model -> Maybe Int +getCurrentIncome account = + account.incomes + |> Dict.filter (\_ income -> income.userId == account.me) + |> Dict.values + |> List.sortBy .creation + |> List.reverse + |> List.head + |> Maybe.map .amount + +type alias IncomeEdition = + { income : String + , error : Maybe String + } + +initIncomeEdition : Int -> IncomeEdition +initIncomeEdition income = + { income = toString income + , error = Nothing + } + +validateIncome : String -> Translations -> Result String Int +validateIncome amount translations = + case String.toInt amount of + Ok number -> + if number > 0 + then Ok number + else Err <| getMessage "IncomeMustBePositiveNumber" translations + Err _ -> + Err <| getMessage "IncomeRequired" translations diff --git a/src/client/elm/LoggedIn/Home/Account/Update.elm b/src/client/elm/LoggedIn/Home/Account/Update.elm new file mode 100644 index 0000000..8d002a3 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/Update.elm @@ -0,0 +1,75 @@ +module LoggedIn.Home.Account.Update + ( update + ) where + +import Maybe +import Dict +import Task + +import Effects exposing (Effects) + +import Server + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.Account.Model as AccountModel + +import Utils.Maybe exposing (isJust) + +update : AccountAction.Action -> AccountModel.Model -> (AccountModel.Model, Effects AccountAction.Action) +update action account = + case action of + + AccountAction.NoOp -> + (account, Effects.none) + + AccountAction.ToggleDetail -> + ( { account | visibleDetail = not account.visibleDetail } + , Effects.none + ) + + AccountAction.ToggleIncomeEdition -> + ( { account | incomeEdition = + if isJust account.incomeEdition + then Nothing + else Just (AccountModel.initIncomeEdition (Maybe.withDefault 0 (AccountModel.getCurrentIncome account))) + } + , Effects.none + ) + + AccountAction.UpdateIncomeEdition income -> + case account.incomeEdition of + Just incomeEdition -> + ( { account | incomeEdition = Just { incomeEdition | income = income } } + , Effects.none + ) + Nothing -> + ( account + , Effects.none + ) + + AccountAction.UpdateEditionError error -> + case account.incomeEdition of + Just incomeEdition -> + ( { account | incomeEdition = Just { incomeEdition | error = Just error } } + , Effects.none + ) + Nothing -> + ( account + , Effects.none + ) + + AccountAction.UpdateIncome currentTime amount -> + ( account + , Server.setIncome currentTime amount + |> Task.map (\incomeId -> (AccountAction.ValidateUpdateIncome incomeId currentTime amount)) + |> flip Task.onError (always <| Task.succeed AccountAction.NoOp) + |> Effects.task + ) + + AccountAction.ValidateUpdateIncome incomeId currentTime amount -> + ( { account + | incomes = Dict.insert incomeId { userId = account.me, creation = currentTime, amount = amount } account.incomes + , incomeEdition = Nothing + } + , Effects.none + ) diff --git a/src/client/elm/LoggedIn/Home/Account/View.elm b/src/client/elm/LoggedIn/Home/Account/View.elm new file mode 100644 index 0000000..252f8cf --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Account/View.elm @@ -0,0 +1,133 @@ +module LoggedIn.Home.Account.View + ( view + ) where + +import List +import Signal exposing (Address) + +import Html exposing (..) +import Html as H exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.Model.Payer exposing (..) +import LoggedIn.Home.View.Price exposing (price) +import LoggedIn.Home.View.Expand exposing (..) + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.Account.Model as AccountModel + +import Model exposing (Model) +import Model.User exposing (getUserName) +import Model.Translations exposing (getParamMessage, getMessage) +import Action exposing (..) + +import View.Events exposing (onSubmitPrevDefault) + +import Utils.Either exposing (toMaybeError) + +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = + let account = homeModel.account + in div + [ classList + [ ("account", True) + , ("detail", account.visibleDetail) + ] + ] + [ exceedingPayers address model homeModel + , if account.visibleDetail + then income address model account + else text "" + ] + +exceedingPayers : Address Action -> Model -> HomeModel.Model -> Html +exceedingPayers address model homeModel = + button + [ class "header" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.ToggleDetail) + ] + ( (List.map (exceedingPayer model homeModel) (getOrderedExceedingPayers model.currentTime homeModel.users homeModel.account.incomes homeModel.payments)) + ++ [ expand ExpandDown homeModel.account.visibleDetail ] + ) + +exceedingPayer : Model -> HomeModel.Model -> ExceedingPayer -> Html +exceedingPayer model homeModel payer = + div + [ class "exceedingPayer" ] + [ span + [ class "userName" ] + [ payer.userId + |> getUserName homeModel.users + |> Maybe.withDefault "−" + |> text + ] + , span + [ class "amount" ] + [ text ("+ " ++ (price model payer.amount)) ] + ] + +income : Address Action -> Model -> AccountModel.Model -> Html +income address model account = + case account.incomeEdition of + Nothing -> + incomeRead address model account + Just edition -> + incomeEdition address model account edition + +incomeRead : Address Action -> Model -> AccountModel.Model -> Html +incomeRead address model account = + div + [ class "income" ] + [ ( case AccountModel.getCurrentIncome account of + Nothing -> + text (getMessage "NoIncome" model.translations) + Just income -> + text (getParamMessage [price model income] "Income" model.translations) + ) + , toggleIncomeEdition address "editIncomeEdition" (getMessage "Edit" model.translations) + ] + +incomeEdition : Address Action -> Model -> AccountModel.Model -> AccountModel.IncomeEdition -> Html +incomeEdition address model account edition = + H.form + [ case AccountModel.validateIncome edition.income model.translations of + Ok validatedAmount -> + onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.UpdateIncome model.currentTime validatedAmount) + Err error -> + onSubmitPrevDefault address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateEditionError <| error) + , class "income" + ] + [ label + [ for "incomeInput" ] + [ text (getMessage "NewIncome" model.translations) ] + , input + [ id "incomeInput" + , value edition.income + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount << AccountAction.UpdateIncomeEdition) + , maxlength 10 + ] + [] + , button + [ type' "submit" + , class "validateIncomeEdition" + ] + [ text (getMessage "Validate" model.translations) ] + , toggleIncomeEdition address "undoIncomeEdition" (getMessage "Undo" model.translations) + , case edition.error of + Just error -> div [ class "error" ] [ text error ] + Nothing -> text "" + ] + +toggleIncomeEdition : Address Action -> String -> String -> Html +toggleIncomeEdition address className name = + button + [ type' "button" + , class className + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAccount <| AccountAction.ToggleIncomeEdition) + ] + [ text name ] diff --git a/src/client/elm/LoggedIn/Home/Action.elm b/src/client/elm/LoggedIn/Home/Action.elm new file mode 100644 index 0000000..d6d82d0 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Action.elm @@ -0,0 +1,22 @@ +module LoggedIn.Home.Action + ( Action(..) + ) where + +import Model.Payment exposing (Payments, Payment, PaymentId, PaymentFrequency) + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.Monthly.Action as MonthlyAction + +type Action = + NoOp + | UpdateAdd AddPaymentAction.Action + | UpdatePayments Payments + | AddPayment String String PaymentFrequency + | ValidateAddPayment PaymentId String Int PaymentFrequency + | DeletePayment Payment PaymentFrequency + | ValidateDeletePayment Payment PaymentFrequency + | ToggleEdit PaymentId + | UpdatePage Int + | UpdateMonthly MonthlyAction.Action + | UpdateAccount AccountAction.Action diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Action.elm b/src/client/elm/LoggedIn/Home/AddPayment/Action.elm new file mode 100644 index 0000000..095863f --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/Action.elm @@ -0,0 +1,11 @@ +module LoggedIn.Home.AddPayment.Action + ( Action(..) + ) where + +type Action = + NoOp + | UpdateName String + | UpdateCost String + | AddError (Maybe String) (Maybe String) + | ToggleFrequency + | WaitingServer diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Model.elm b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm new file mode 100644 index 0000000..22b6883 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/Model.elm @@ -0,0 +1,29 @@ +module LoggedIn.Home.AddPayment.Model + ( Model + , init + ) where + +import Result as Result exposing (Result(..)) +import Json.Decode exposing ((:=)) + +import Model.Translations exposing (..) +import Model.Payment exposing (PaymentFrequency(..)) + +type alias Model = + { name : String + , nameError : Maybe String + , cost : String + , costError : Maybe String + , frequency : PaymentFrequency + , waitingServer : Bool + } + +init : PaymentFrequency -> Model +init frequency = + { name = "" + , nameError = Nothing + , cost = "" + , costError = Nothing + , frequency = frequency + , waitingServer = False + } diff --git a/src/client/elm/LoggedIn/Home/AddPayment/Update.elm b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm new file mode 100644 index 0000000..b8020f1 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/Update.elm @@ -0,0 +1,55 @@ +module LoggedIn.Home.AddPayment.Update + ( update + , addPaymentError + ) where + +import Maybe +import Json.Decode as Json exposing ((:=)) + +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.AddPayment.Model as AddPaymentModel + +import Model.Translations exposing (Translations, getMessage) +import Model.Payment exposing (PaymentFrequency(..)) + +update : AddPaymentAction.Action -> AddPaymentModel.Model -> AddPaymentModel.Model +update action addPayment = + case action of + + AddPaymentAction.NoOp -> + addPayment + + AddPaymentAction.UpdateName name -> + { addPayment | name = name } + + AddPaymentAction.UpdateCost cost -> + { addPayment | cost = cost } + + AddPaymentAction.AddError nameError costError -> + { addPayment + | nameError = nameError + , costError = costError + , waitingServer = False + } + + AddPaymentAction.ToggleFrequency -> + { addPayment + | frequency = if addPayment.frequency == Punctual then Monthly else Punctual + } + + AddPaymentAction.WaitingServer -> + { addPayment | waitingServer = True } + +addPaymentError : Translations -> String -> Maybe AddPaymentAction.Action +addPaymentError translations jsonErr = + let decoder = + Json.object2 (,) + (Json.maybe <| "name" := Json.string) + (Json.maybe <| "cost" := Json.string) + in case Json.decodeString decoder jsonErr of + Err _ -> + Nothing + Ok (mbNameKey, mbCostKey) -> + Just <| AddPaymentAction.AddError + (Maybe.map (flip getMessage translations) mbNameKey) + (Maybe.map (flip getMessage translations) mbCostKey) diff --git a/src/client/elm/LoggedIn/Home/AddPayment/View.elm b/src/client/elm/LoggedIn/Home/AddPayment/View.elm new file mode 100644 index 0000000..09d5fbf --- /dev/null +++ b/src/client/elm/LoggedIn/Home/AddPayment/View.elm @@ -0,0 +1,129 @@ +module LoggedIn.Home.AddPayment.View + ( view + ) where + +import Result exposing (..) +import Signal exposing (Address) + +import Html as H exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel + +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.AddPayment.Model as AddPaymentModel + +import Model exposing (Model) +import Model.Payment exposing (PaymentFrequency(..)) +import Model.Translations exposing (getMessage) +import Action as Action exposing (..) + +import View.Events exposing (onSubmitPrevDefault) +import View.Icon exposing (..) + +import Utils.Maybe exposing (isJust) +import Utils.Either exposing (toMaybeError) + +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = + H.form + [ let update = + if homeModel.add.waitingServer + then + Action.NoOp + else + UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.AddPayment homeModel.add.name homeModel.add.cost homeModel.add.frequency + in onSubmitPrevDefault address update + , class "addPayment" + ] + [ addPaymentName address homeModel.add + , addPaymentCost address model homeModel.add + , paymentFrequency address model homeModel.add + , button + [ type' "submit" + , classList + [ ("add", True) + , ("waitingServer", homeModel.add.waitingServer) + ] + ] + [ text (getMessage "Add" model.translations) + , if homeModel.add.waitingServer then renderSpinIcon else text "" + ] + ] + +addPaymentName : Address Action -> AddPaymentModel.Model -> Html +addPaymentName address addPayment = + div + [ classList + [ ("name", True) + , ("error", isJust addPayment.nameError) + ] + ] + [ input + [ id "nameInput" + , value addPayment.name + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateName) + , maxlength 20 + ] + [] + , label + [ for "nameInput" ] + [ renderIcon "shopping-cart" ] + , case addPayment.nameError of + Just error -> + div [ class "errorMessage" ] [ text error ] + Nothing -> + text "" + ] + +addPaymentCost : Address Action -> Model -> AddPaymentModel.Model -> Html +addPaymentCost address model addPayment = + div + [ classList + [ ("cost", True) + , ("error", isJust addPayment.costError) + ] + ] + [ input + [ id "costInput" + , value addPayment.cost + , on "input" targetValue (Signal.message address << UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd << AddPaymentAction.UpdateCost) + , maxlength 7 + ] + [] + , label + [ for "costInput" ] + [ text model.conf.currency ] + , case addPayment.costError of + Just error -> + div [ class "errorMessage" ] [ text error ] + Nothing -> + text "" + ] + +paymentFrequency : Address Action -> Model -> AddPaymentModel.Model -> Html +paymentFrequency address model addPayment = + button + [ type' "button" + , class "frequency" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateAdd <| AddPaymentAction.ToggleFrequency) + ] + [ div + [ classList + [ ("punctual", True) + , ("selected", addPayment.frequency == Punctual) + ] + ] + [ text (getMessage "Punctual" model.translations) ] + , div + [ classList + [ ("monthly", True) + , ("selected", addPayment.frequency == Monthly) + ] + ] + [ text (getMessage "Monthly" model.translations) ] + ] diff --git a/src/client/elm/LoggedIn/Home/Model.elm b/src/client/elm/LoggedIn/Home/Model.elm new file mode 100644 index 0000000..14ab86c --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Model.elm @@ -0,0 +1,37 @@ +module LoggedIn.Home.Model + ( Model + , init + ) where + +import LoggedIn.Home.Model.Payer exposing (Payers) + +import Model.User exposing (Users, UserId) +import Model.Payment exposing (PaymentId, Payments, PaymentFrequency(..)) +import Model.Init exposing (..) + +import LoggedIn.Home.Account.Model as AccountModel +import LoggedIn.Home.AddPayment.Model as AddPaymentModel +import LoggedIn.Home.Monthly.Model as MonthlyModel + +type alias Model = + { users : Users + , add : AddPaymentModel.Model + , monthly : MonthlyModel.Model + , account : AccountModel.Model + , payments : Payments + , paymentsCount : Int + , paymentEdition : Maybe PaymentId + , currentPage : Int + } + +init : Init -> Model +init initData = + { users = initData.users + , add = AddPaymentModel.init Punctual + , monthly = MonthlyModel.init initData.monthlyPayments + , account = AccountModel.init initData.me initData.incomes + , payments = initData.payments + , paymentsCount = initData.paymentsCount + , paymentEdition = Nothing + , currentPage = 1 + } diff --git a/src/client/elm/LoggedIn/Home/Model/Payer.elm b/src/client/elm/LoggedIn/Home/Model/Payer.elm new file mode 100644 index 0000000..65e3f0e --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Model/Payer.elm @@ -0,0 +1,122 @@ +module LoggedIn.Home.Model.Payer + ( Payers + , Payer + , ExceedingPayer + , getOrderedExceedingPayers + ) where + +import Json.Decode as Json exposing (..) +import Dict exposing (..) +import List +import Maybe +import Time exposing (Time) +import Date + +import Model.Payment exposing (Payments, totalPayments) +import Model.User exposing (Users, UserId, userIdDecoder) +import Model.Income exposing (..) + +import Utils.Dict exposing (mapValues) +import Utils.Maybe exposing (isJust) + +type alias Payers = Dict UserId Payer + +type alias Payer = + { preIncomePaymentSum : Int + , postIncomePaymentSum : Int + , incomes : List Income + } + +type alias ExceedingPayer = + { userId : UserId + , amount : Int + } + +getOrderedExceedingPayers : Time -> Users -> Incomes -> Payments -> List ExceedingPayer +getOrderedExceedingPayers currentTime users incomes payments = + let payers = getPayers currentTime users incomes payments + exceedingPayersOnPreIncome = + payers + |> mapValues .preIncomePaymentSum + |> Dict.toList + |> exceedingPayersFromAmounts + in case incomeDefinedForAll (Dict.keys users) incomes of + Just since -> + let postPaymentPayers = mapValues (getPostPaymentPayer currentTime since) payers + mbMaxRatio = + postPaymentPayers + |> Dict.toList + |> List.map (.ratio << snd) + |> List.maximum + in case mbMaxRatio of + Just maxRatio -> + postPaymentPayers + |> mapValues (getFinalDiff maxRatio) + |> Dict.toList + |> exceedingPayersFromAmounts + Nothing -> + exceedingPayersOnPreIncome + Nothing -> + exceedingPayersOnPreIncome + +getPayers : Time -> Users -> Incomes -> Payments -> Payers +getPayers currentTime users incomes payments = + let incomesDefined = incomeDefinedForAll (Dict.keys users) incomes + in Dict.keys users + |> List.map (\userId -> + ( userId + , { preIncomePaymentSum = + totalPayments + (\p -> (Date.toTime p.creation) < (Maybe.withDefault currentTime incomesDefined)) + userId + payments + , postIncomePaymentSum = + totalPayments + (\p -> + case incomesDefined of + Nothing -> False + Just t -> (Date.toTime p.creation) >= t + ) + userId + payments + , incomes = List.filter ((==) userId << .userId) (Dict.values incomes) + } + ) + ) + |> Dict.fromList + +exceedingPayersFromAmounts : List (UserId, Int) -> List ExceedingPayer +exceedingPayersFromAmounts userAmounts = + let mbMinAmount = List.minimum << List.map snd <| userAmounts + in case mbMinAmount of + Nothing -> + [] + Just minAmount -> + userAmounts + |> List.map (\userAmount -> + { userId = fst userAmount + , amount = snd userAmount - minAmount + } + ) + |> List.filter (\payer -> payer.amount > 0) + +type alias PostPaymentPayer = + { preIncomePaymentSum : Int + , cumulativeIncome : Int + , ratio : Float + } + +getPostPaymentPayer : Time -> Time -> Payer -> PostPaymentPayer +getPostPaymentPayer currentTime since payer = + let cumulativeIncome = cumulativeIncomesSince currentTime since payer.incomes + in { preIncomePaymentSum = payer.preIncomePaymentSum + , cumulativeIncome = cumulativeIncome + , ratio = toFloat payer.postIncomePaymentSum / toFloat cumulativeIncome + } + +getFinalDiff : Float -> PostPaymentPayer -> Int +getFinalDiff maxRatio payer = + let postIncomeDiff = + -1 * (maxRatio - payer.ratio) * toFloat payer.cumulativeIncome + |> truncate + in postIncomeDiff + payer.preIncomePaymentSum diff --git a/src/client/elm/LoggedIn/Home/Monthly/Action.elm b/src/client/elm/LoggedIn/Home/Monthly/Action.elm new file mode 100644 index 0000000..0a1faf4 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/Action.elm @@ -0,0 +1,10 @@ +module LoggedIn.Home.Monthly.Action + ( Action(..) + ) where + +import Model.Payment exposing (Payment) + +type Action = + ToggleDetail + | AddPayment Payment + | DeletePayment Payment diff --git a/src/client/elm/LoggedIn/Home/Monthly/Model.elm b/src/client/elm/LoggedIn/Home/Monthly/Model.elm new file mode 100644 index 0000000..7f6fd4c --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/Model.elm @@ -0,0 +1,17 @@ +module LoggedIn.Home.Monthly.Model + ( Model + , init + ) where + +import Model.Payment exposing (Payments) + +type alias Model = + { payments : Payments + , visibleDetail : Bool + } + +init : Payments -> Model +init payments = + { payments = payments + , visibleDetail = False + } diff --git a/src/client/elm/LoggedIn/Home/Monthly/Update.elm b/src/client/elm/LoggedIn/Home/Monthly/Update.elm new file mode 100644 index 0000000..70b2f9c --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/Update.elm @@ -0,0 +1,21 @@ +module LoggedIn.Home.Monthly.Update + ( update + ) where + +import LoggedIn.Home.Monthly.Action as MonthlyAction +import LoggedIn.Home.Monthly.Model as MonthlyModel + +update : MonthlyAction.Action -> MonthlyModel.Model -> MonthlyModel.Model +update action monthly = + case action of + MonthlyAction.ToggleDetail -> + { monthly | visibleDetail = not monthly.visibleDetail } + MonthlyAction.AddPayment payment -> + { monthly + | payments = payment :: monthly.payments + , visibleDetail = True + } + MonthlyAction.DeletePayment payment -> + { monthly + | payments = List.filter (((/=) payment.id) << .id) monthly.payments + } diff --git a/src/client/elm/LoggedIn/Home/Monthly/View.elm b/src/client/elm/LoggedIn/Home/Monthly/View.elm new file mode 100644 index 0000000..f5ab721 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Monthly/View.elm @@ -0,0 +1,91 @@ +module LoggedIn.Home.Monthly.View + ( view + ) where + +import String +import Signal exposing (Address) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.View.Price exposing (price) +import LoggedIn.Home.View.Expand exposing (..) + +import LoggedIn.Home.Monthly.Action as MonthlyAction +import LoggedIn.Home.Monthly.Model as MonthlyModel + +import Model exposing (Model) +import Model.Payment as Payment exposing (Payments, Payment) +import Model.Translations exposing (getMessage, getParamMessage) +import Action exposing (..) + +import View.Icon exposing (renderIcon) + +view : Address Action -> Model -> HomeModel.Model -> Html +view address model homeModel = + let monthly = homeModel.monthly + in if List.length monthly.payments == 0 + then + text "" + else + div + [ classList + [ ("monthlyPayments", True) + , ("detail", monthly.visibleDetail) + ] + ] + [ monthlyCount address model monthly + , if monthly.visibleDetail then paymentsTable address model homeModel monthly else text "" + ] + +monthlyCount : Address Action -> Model -> MonthlyModel.Model -> Html +monthlyCount address model monthly = + let count = List.length monthly.payments + total = List.sum << List.map .cost <| monthly.payments + key = if count > 1 then "PluralMonthlyCount" else "SingularMonthlyCount" + in button + [ class "header" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdateMonthly <| MonthlyAction.ToggleDetail) + ] + [ text (getParamMessage [toString count, price model total] key model.translations) + , expand ExpandDown monthly.visibleDetail + ] + +paymentsTable : Address Action -> Model -> HomeModel.Model -> MonthlyModel.Model -> Html +paymentsTable address model homeModel monthly = + div + [ class "table" ] + ( monthly.payments + |> List.sortBy (String.toLower << .name) + |> List.map (paymentLine address model homeModel) + ) + +paymentLine : Address Action -> Model -> HomeModel.Model -> Payment -> Html +paymentLine address model homeModel payment = + a + [ classList + [ ("row", True) + , ("edition", homeModel.paymentEdition == Just payment.id) + ] + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.ToggleEdit payment.id) + ] + [ div [ class "cell category" ] [ text (payment.name) ] + , div + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (price model payment.cost) ] + , div + [ class "cell delete" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction <| HomeAction.DeletePayment payment Payment.Monthly) + ] + [ button [] [ renderIcon "times" ] + ] + ] diff --git a/src/client/elm/LoggedIn/Home/Update.elm b/src/client/elm/LoggedIn/Home/Update.elm new file mode 100644 index 0000000..352c76b --- /dev/null +++ b/src/client/elm/LoggedIn/Home/Update.elm @@ -0,0 +1,139 @@ +module LoggedIn.Home.Update + ( update + ) where + +import Date +import Dict +import Debug +import Task +import String + +import Effects exposing (Effects) +import Http exposing (Error(..)) + +import Server + +import LoggedIn.Home.Action as LoggedInAction +import LoggedIn.Home.Model as LoggedInModel + +import LoggedIn.Home.Account.Action as AccountAction +import LoggedIn.Home.Account.Update as AccountUpdate + +import LoggedIn.Home.AddPayment.Action as AddPaymentAction +import LoggedIn.Home.AddPayment.Model as AddPaymentModel +import LoggedIn.Home.AddPayment.Update as AddPaymentUpdate + +import LoggedIn.Home.Monthly.Action as MonthlyAction +import LoggedIn.Home.Monthly.Model as MonthlyModel +import LoggedIn.Home.Monthly.Update as MonthlyUpdate + +import Model exposing (Model) +import Model.User exposing (UserId) +import Model.Payment exposing (..) +import Model.Translations exposing (Translations, getMessage) + +update : Model -> LoggedInAction.Action -> LoggedInModel.Model -> (LoggedInModel.Model, Effects LoggedInAction.Action) +update model action loggedInModel = + case action of + + LoggedInAction.NoOp -> (loggedInModel, Effects.none) + + LoggedInAction.UpdateAdd addPaymentAction -> + ( { loggedInModel | add = AddPaymentUpdate.update addPaymentAction loggedInModel.add } + , Effects.none + ) + + LoggedInAction.UpdatePayments payments -> + ( { loggedInModel | payments = payments } + , Effects.none + ) + + LoggedInAction.AddPayment name cost frequency -> + ( { loggedInModel | add = AddPaymentUpdate.update AddPaymentAction.WaitingServer loggedInModel.add } + , Server.addPayment name cost frequency + |> Task.map (\paymentId -> + case String.toInt cost of + Err _ -> + LoggedInAction.UpdateAdd (AddPaymentAction.AddError Nothing (Just (getMessage "CostRequired" model.translations))) + Ok costNumber -> + LoggedInAction.ValidateAddPayment paymentId name costNumber frequency + ) + |> flip Task.onError (\err -> + case err of + BadResponse 400 jsonErr -> + case AddPaymentUpdate.addPaymentError model.translations jsonErr of + Just addPaymentAction -> Task.succeed (LoggedInAction.UpdateAdd addPaymentAction) + Nothing -> Task.succeed LoggedInAction.NoOp + _ -> + Task.succeed LoggedInAction.NoOp + ) + |> Effects.task + ) + + LoggedInAction.ValidateAddPayment paymentId name cost frequency -> + let newPayment = Payment paymentId (Date.fromTime model.currentTime) name cost loggedInModel.account.me + newAdd = AddPaymentModel.init frequency + in case frequency of + Punctual -> + ( { loggedInModel + | currentPage = 1 + , add = newAdd + , account = loggedInModel.account + , payments = newPayment :: loggedInModel.payments + , paymentsCount = loggedInModel.paymentsCount + 1 + } + , Effects.none + ) + Monthly -> + ( { loggedInModel + | add = newAdd + , monthly = MonthlyUpdate.update (MonthlyAction.AddPayment newPayment) loggedInModel.monthly + } + , Effects.none + ) + + LoggedInAction.ToggleEdit id -> + ( { loggedInModel | paymentEdition = if loggedInModel.paymentEdition == Just id then Nothing else Just id } + , Effects.none + ) + + LoggedInAction.DeletePayment payment frequency -> + ( loggedInModel + , Server.deletePayment payment frequency + |> Task.map (always (LoggedInAction.ValidateDeletePayment payment frequency)) + |> flip Task.onError (always <| Task.succeed LoggedInAction.NoOp) + |> Effects.task + ) + + LoggedInAction.ValidateDeletePayment payment frequency -> + case frequency of + Monthly -> + ( { loggedInModel + | monthly = MonthlyUpdate.update (MonthlyAction.DeletePayment payment) loggedInModel.monthly + } + , Effects.none + ) + Punctual -> + ( { loggedInModel + | account = loggedInModel.account + , payments = deletePayment payment.id loggedInModel.payments + , paymentsCount = loggedInModel.paymentsCount - 1 + } + , Effects.none + ) + + LoggedInAction.UpdatePage page -> + ( { loggedInModel | currentPage = page } + , Effects.none + ) + + LoggedInAction.UpdateMonthly monthlyAction -> + ( { loggedInModel | monthly = MonthlyUpdate.update monthlyAction loggedInModel.monthly } + , Effects.none + ) + + LoggedInAction.UpdateAccount accountAction -> + let (newAccount, accountEffects) = AccountUpdate.update accountAction loggedInModel.account + in ( { loggedInModel | account = newAccount } + , Effects.map LoggedInAction.UpdateAccount accountEffects + ) diff --git a/src/client/elm/LoggedIn/Home/View.elm b/src/client/elm/LoggedIn/Home/View.elm new file mode 100644 index 0000000..23da2c5 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View.elm @@ -0,0 +1,34 @@ +module LoggedIn.Home.View + ( view + ) where + +import Signal exposing (Address) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import LoggedIn.Home.Model as LoggedInModel +import LoggedIn.Home.Account.View as AccountView +import LoggedIn.Home.AddPayment.View as AddPaymentView +import LoggedIn.Home.Monthly.View as MonthlyView + +import Model exposing (Model) +import Model.Payment exposing (Payments) +import Action exposing (Action) + +import LoggedIn.Home.View.Table exposing (paymentsTable) +import LoggedIn.Home.View.Paging exposing (paymentsPaging) + +view : Address Action -> Model -> LoggedInModel.Model -> Html +view address model loggedInModel = + div + [ class "loggedIn" ] + [ AddPaymentView.view address model loggedInModel + , div + [ class "expandables" ] + [ AccountView.view address model loggedInModel + , MonthlyView.view address model loggedInModel + ] + , paymentsTable address model loggedInModel + , paymentsPaging address loggedInModel + ] diff --git a/src/client/elm/LoggedIn/Home/View/Date.elm b/src/client/elm/LoggedIn/Home/View/Date.elm new file mode 100644 index 0000000..2cc55fe --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Date.elm @@ -0,0 +1,59 @@ +module LoggedIn.Home.View.Date + ( renderShortDate + , renderLongDate + ) where + +import Date exposing (..) +import String + +import Model.Translations exposing (..) + +renderShortDate : Date -> Translations -> String +renderShortDate date translations = + let params = + [ String.pad 2 '0' (toString (Date.day date)) + , String.pad 2 '0' (toString (getMonthNumber (Date.month date))) + , toString (Date.year date) + ] + in getParamMessage params "ShortDate" translations + +renderLongDate : Date -> Translations -> String +renderLongDate date translations = + let params = + [ toString (Date.day date) + , (getMessage (getMonthKey (Date.month date)) translations) + , toString (Date.year date) + ] + in getParamMessage params "LongDate" translations + +getMonthNumber : Month -> Int +getMonthNumber month = + case month of + Jan -> 1 + Feb -> 2 + Mar -> 3 + Apr -> 4 + May -> 5 + Jun -> 6 + Jul -> 7 + Aug -> 8 + Sep -> 9 + Oct -> 10 + Nov -> 11 + Dec -> 12 + +getMonthKey : Month -> String +getMonthKey month = + case month of + Jan -> "January" + Feb -> "February" + Mar -> "March" + Apr -> "April" + May -> "May" + Jun -> "June" + Jul -> "July" + Aug -> "August" + Sep -> "September" + Oct -> "October" + Nov -> "November" + Dec -> "December" diff --git a/src/client/elm/LoggedIn/Home/View/Expand.elm b/src/client/elm/LoggedIn/Home/View/Expand.elm new file mode 100644 index 0000000..514bf93 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Expand.elm @@ -0,0 +1,25 @@ +module LoggedIn.Home.View.Expand + ( expand + , ExpandType(..) + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) + +import View.Icon exposing (renderIcon) + +type ExpandType = ExpandUp | ExpandDown + +expand : ExpandType -> Bool -> Html +expand expandType isExpanded = + div + [ class "expand" ] + [ renderIcon (chevronIcon expandType isExpanded) ] + +chevronIcon : ExpandType -> Bool -> String +chevronIcon expandType isExpanded = + case (expandType, isExpanded) of + (ExpandUp, True) -> "chevron-down" + (ExpandUp, False) -> "chevron-up" + (ExpandDown, True) -> "chevron-up" + (ExpandDown, False) -> "chevron-down" diff --git a/src/client/elm/LoggedIn/Home/View/Paging.elm b/src/client/elm/LoggedIn/Home/View/Paging.elm new file mode 100644 index 0000000..31aa032 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Paging.elm @@ -0,0 +1,102 @@ +module LoggedIn.Home.View.Paging + ( paymentsPaging + ) where + +import Signal exposing (Address) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel + +import Action exposing (..) +import Model.Payment exposing (perPage) + +import View.Icon exposing (renderIcon) + +showedPages : Int +showedPages = 5 + +paymentsPaging : Address Action -> HomeModel.Model -> Html +paymentsPaging address homeModel = + let maxPage = ceiling (toFloat homeModel.paymentsCount / toFloat perPage) + pages = truncatePages homeModel.currentPage [1..maxPage] + in if maxPage == 1 + then + text "" + else + div + [ class "pages" ] + ( ( if homeModel.currentPage > 1 + then [ firstPage address, previousPage address homeModel ] + else [] + ) + ++ ( List.map (paymentsPage address homeModel) pages) + ++ ( if homeModel.currentPage < maxPage + then [ nextPage address homeModel, lastPage address maxPage ] + else [] + ) + ) + +truncatePages : Int -> List Int -> List Int +truncatePages currentPage pages = + let totalPages = List.length pages + showedLeftPages = ceiling ((toFloat showedPages - 1) / 2) + showedRightPages = floor ((toFloat showedPages - 1) / 2) + truncatedPages = + if currentPage < showedLeftPages then + [1..showedPages] + else if currentPage > totalPages - showedRightPages then + [(totalPages - showedPages)..totalPages] + else + [(currentPage - showedLeftPages)..(currentPage + showedRightPages)] + in List.filter (flip List.member pages) truncatedPages + +firstPage : Address Action -> Html +firstPage address = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| 1) + ] + [ renderIcon "fast-backward" ] + +previousPage : Address Action -> HomeModel.Model -> Html +previousPage address homeModel = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage - 1) + ] + [ renderIcon "backward" ] + +nextPage : Address Action -> HomeModel.Model -> Html +nextPage address homeModel = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| homeModel.currentPage + 1) + ] + [ renderIcon "forward" ] + +lastPage : Address Action -> Int -> Html +lastPage address maxPage = + button + [ class "page" + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| maxPage) + ] + [ renderIcon "fast-forward" ] + +paymentsPage : Address Action -> HomeModel.Model -> Int -> Html +paymentsPage address homeModel page = + let onCurrentPage = page == homeModel.currentPage + in button + [ classList + [ ("page", True) + , ("current", onCurrentPage) + ] + , onClick address <| + if onCurrentPage then Action.NoOp else UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.UpdatePage <| page + ] + [ text (toString page) ] diff --git a/src/client/elm/LoggedIn/Home/View/Price.elm b/src/client/elm/LoggedIn/Home/View/Price.elm new file mode 100644 index 0000000..a3229a0 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Price.elm @@ -0,0 +1,38 @@ +module LoggedIn.Home.View.Price + ( price + ) where + +import String exposing (..) + +import Model exposing (Model) +import Model.Translations exposing (getMessage) + +price : Model -> Int -> String +price model amount = + ( formatInt amount + ++ " " + ++ model.conf.currency + ) + +formatInt : Int -> String +formatInt n = + abs n + |> toString + |> toList + |> List.reverse + |> group 3 + |> List.intersperse [' '] + |> List.concat + |> List.reverse + |> fromList + |> append (if n < 0 then "-" else "") + +group : Int -> List a -> List (List a) +group n xs = + if List.length xs <= n + then + [xs] + else + let take = List.take n xs + drop = List.drop n xs + in take :: (group n drop) diff --git a/src/client/elm/LoggedIn/Home/View/Table.elm b/src/client/elm/LoggedIn/Home/View/Table.elm new file mode 100644 index 0000000..e49fd05 --- /dev/null +++ b/src/client/elm/LoggedIn/Home/View/Table.elm @@ -0,0 +1,98 @@ +module LoggedIn.Home.View.Table + ( paymentsTable + ) where + +import Dict exposing (..) +import Date exposing (Date) +import Signal exposing (Address) +import String exposing (append) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedIn.Action as LoggedInAction + +import LoggedIn.Home.Action as HomeAction +import LoggedIn.Home.Model as HomeModel +import LoggedIn.Home.View.Date exposing (..) +import LoggedIn.Home.View.Price exposing (price) + +import Model exposing (Model) +import Model.User exposing (getUserName) +import Model.Payment exposing (..) +import Model.Translations exposing (getMessage) +import Action exposing (..) + +import View.Icon exposing (renderIcon) + +paymentsTable : Address Action -> Model -> HomeModel.Model -> Html +paymentsTable address model homeModel = + div + [ class "table" ] + ( headerLine model :: paymentLines address model homeModel) + +headerLine : Model -> Html +headerLine model = + div + [ class "header" ] + [ div [ class "cell category" ] [ renderIcon "shopping-cart" ] + , div [ class "cell cost" ] [ text model.conf.currency ] + , div [ class "cell user" ] [ renderIcon "user" ] + , div [ class "cell date" ] [ renderIcon "calendar" ] + , div [ class "cell" ] [] + ] + +paymentLines : Address Action -> Model -> HomeModel.Model -> List Html +paymentLines address model homeModel = + homeModel.payments + |> List.sortBy (Date.toTime << .creation) + |> List.reverse + |> List.drop ((homeModel.currentPage - 1) * perPage) + |> List.take perPage + |> List.map (paymentLine address model homeModel) + +paymentLine : Address Action -> Model -> HomeModel.Model -> Payment -> Html +paymentLine address model homeModel payment = + a + [ classList + [ ("row", True) + , ("edition", homeModel.paymentEdition == Just payment.id) + ] + , onClick address (UpdateLoggedIn << LoggedInAction.HomeAction << HomeAction.ToggleEdit <| payment.id) + ] + [ div [ class "cell category" ] [ text payment.name ] + , div + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (price model payment.cost) ] + , div + [ class "cell user" ] + [ payment.userId + |> getUserName homeModel.users + |> Maybe.withDefault "−" + |> text + ] + , div + [ class "cell date" ] + [ span + [ class "shortDate" ] + [ text (renderShortDate payment.creation model.translations) ] + , span + [ class "longDate" ] + [ text (renderLongDate payment.creation model.translations) ] + ] + , if homeModel.account.me == payment.userId + then + div + [ class "cell delete" ] + [ button + [ onClick address (UpdateLoggedIn <| LoggedInAction.HomeAction <| HomeAction.DeletePayment payment Punctual)] + [ renderIcon "times" ] + ] + else + div [ class "cell" ] [] + ] -- cgit v1.2.3