aboutsummaryrefslogtreecommitdiff
path: root/src/client/elm/View/LoggedIn
diff options
context:
space:
mode:
Diffstat (limited to 'src/client/elm/View/LoggedIn')
-rw-r--r--src/client/elm/View/LoggedIn/Account.elm130
-rw-r--r--src/client/elm/View/LoggedIn/Add.elm122
-rw-r--r--src/client/elm/View/LoggedIn/Monthly.elm89
-rw-r--r--src/client/elm/View/LoggedIn/Paging.elm100
-rw-r--r--src/client/elm/View/LoggedIn/Table.elm97
5 files changed, 538 insertions, 0 deletions
diff --git a/src/client/elm/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm
new file mode 100644
index 0000000..706f7cc
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Account.elm
@@ -0,0 +1,130 @@
+module View.LoggedIn.Account
+ ( account
+ ) where
+
+import Html exposing (..)
+import Html as H exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import List
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+import Update.LoggedIn.Account exposing (..)
+
+import Model exposing (Model)
+import Model.User exposing (getUserName)
+import Model.Payer exposing (..)
+import Model.View.LoggedInView exposing (LoggedInView)
+import Model.Translations exposing (getParamMessage, getMessage)
+import Model.View.LoggedIn.Account exposing (..)
+
+import View.Expand exposing (..)
+import View.Price exposing (price)
+import View.Events exposing (onSubmitPrevDefault)
+
+import Utils.Either exposing (toMaybeError)
+
+account : Model -> LoggedInView -> Html
+account model loggedInView =
+ let account = loggedInView.account
+ in div
+ [ classList
+ [ ("account", True)
+ , ("detail", account.visibleDetail)
+ ]
+ ]
+ [ exceedingPayers model loggedInView
+ , if account.visibleDetail
+ then income model account
+ else text ""
+ ]
+
+exceedingPayers : Model -> LoggedInView -> Html
+exceedingPayers model loggedInView =
+ button
+ [ class "header"
+ , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleDetail)
+ ]
+ ( (List.map (exceedingPayer model loggedInView) (getOrderedExceedingPayers model.currentTime loggedInView.account.payers))
+ ++ [ expand ExpandDown loggedInView.account.visibleDetail ]
+ )
+
+exceedingPayer : Model -> LoggedInView -> ExceedingPayer -> Html
+exceedingPayer model loggedInView payer =
+ div
+ [ class "exceedingPayer" ]
+ [ span
+ [ class "userName" ]
+ [ payer.userId
+ |> getUserName loggedInView.users
+ |> Maybe.withDefault "−"
+ |> text
+ ]
+ , span
+ [ class "amount" ]
+ [ text ("+ " ++ (price model payer.amount)) ]
+ ]
+
+income : Model -> Account -> Html
+income model account =
+ case account.incomeEdition of
+ Just edition ->
+ incomeEdition model account edition
+ Nothing ->
+ incomeRead model account
+
+incomeRead : Model -> Account -> Html
+incomeRead model account =
+ div
+ [ class "income" ]
+ [ ( case getCurrentIncome account of
+ Nothing ->
+ text (getMessage "NoIncome" model.translations)
+ Just income ->
+ text (getParamMessage [price model income] "Income" model.translations)
+ )
+ , toggleIncomeEdition "editIncomeEdition" (getMessage "Edit" model.translations)
+ ]
+
+incomeEdition : Model -> Account -> IncomeEdition -> Html
+incomeEdition model account edition =
+ H.form
+ [ case validateIncome edition.income model.translations of
+ Ok validatedAmount ->
+ onSubmitPrevDefault serverCommunications.address (SC.SetIncome model.currentTime validatedAmount)
+ Err error ->
+ onSubmitPrevDefault actions.address (UpdateLoggedIn << UpdateAccount << UpdateEditionError <| error)
+ , class "income"
+ ]
+ [ label
+ [ for "incomeInput" ]
+ [ text (getMessage "NewIncome" model.translations) ]
+ , input
+ [ id "incomeInput"
+ , value edition.income
+ , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAccount << UpdateIncomeEdition)
+ , maxlength 10
+ ]
+ []
+ , button
+ [ type' "submit"
+ , class "validateIncomeEdition"
+ ]
+ [ text (getMessage "Validate" model.translations) ]
+ , toggleIncomeEdition "undoIncomeEdition" (getMessage "Undo" model.translations)
+ , case edition.error of
+ Just error -> div [ class "error" ] [ text error ]
+ Nothing -> text ""
+ ]
+
+toggleIncomeEdition : String -> String -> Html
+toggleIncomeEdition className name =
+ button
+ [ type' "button"
+ , class className
+ , onClick actions.address (UpdateLoggedIn << UpdateAccount <| ToggleIncomeEdition)
+ ]
+ [ text name ]
diff --git a/src/client/elm/View/LoggedIn/Add.elm b/src/client/elm/View/LoggedIn/Add.elm
new file mode 100644
index 0000000..572bdf6
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Add.elm
@@ -0,0 +1,122 @@
+module View.LoggedIn.Add
+ ( addPayment
+ ) where
+
+import Html as H exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Reads exposing (readInt)
+import Result exposing (..)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+import Update.LoggedIn.Add exposing (..)
+
+import Model exposing (Model)
+import Model.View.LoggedIn.Add exposing (..)
+import Model.Translations exposing (getMessage)
+import Model.View.LoggedInView exposing (LoggedInView)
+
+import View.Events exposing (onSubmitPrevDefault)
+import View.Icon exposing (renderIcon)
+
+import Utils.Maybe exposing (isJust)
+import Utils.Either exposing (toMaybeError)
+
+addPayment : Model -> LoggedInView -> Html
+addPayment model loggedInView =
+ H.form
+ [ case (validateName loggedInView.add.name model.translations, validateCost loggedInView.add.cost model.translations) of
+ (Ok name, Ok cost) ->
+ let action =
+ case loggedInView.add.frequency of
+ Punctual -> SC.AddPayment loggedInView.account.me name cost
+ Monthly -> SC.AddMonthlyPayment name cost
+ in onSubmitPrevDefault serverCommunications.address action
+ (resName, resCost) ->
+ onSubmitPrevDefault actions.address (UpdateLoggedIn <| UpdateAdd <| AddError (toMaybeError resName) (toMaybeError resCost))
+ , class "addPayment"
+ ]
+ [ addPaymentName loggedInView.add
+ , addPaymentCost model loggedInView.add
+ , paymentFrequency model loggedInView.add
+ , button
+ [ type' "submit"
+ , class "add" ]
+ [ text (getMessage "Add" model.translations)]
+ ]
+
+addPaymentName : AddPayment -> Html
+addPaymentName addPayment =
+ div
+ [ classList
+ [ ("name", True)
+ , ("error", isJust addPayment.nameError)
+ ]
+ ]
+ [ input
+ [ id "nameInput"
+ , value addPayment.name
+ , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAdd << UpdateName)
+ , maxlength 20
+ ]
+ []
+ , label
+ [ for "nameInput" ]
+ [ renderIcon "shopping-cart" ]
+ , case addPayment.nameError of
+ Just error ->
+ div [ class "errorMessage" ] [ text error ]
+ Nothing ->
+ text ""
+ ]
+
+addPaymentCost : Model -> AddPayment -> Html
+addPaymentCost model addPayment =
+ div
+ [ classList
+ [ ("cost", True)
+ , ("error", isJust addPayment.costError)
+ ]
+ ]
+ [ input
+ [ id "costInput"
+ , value addPayment.cost
+ , on "input" targetValue (Signal.message actions.address << UpdateLoggedIn << UpdateAdd << UpdateCost)
+ , maxlength 7
+ ]
+ []
+ , label
+ [ for "costInput" ]
+ [ text model.config.currency ]
+ , case addPayment.costError of
+ Just error ->
+ div [ class "errorMessage" ] [ text error ]
+ Nothing ->
+ text ""
+ ]
+
+paymentFrequency : Model -> AddPayment -> Html
+paymentFrequency model addPayment =
+ button
+ [ type' "button"
+ , class "frequency"
+ , onClick actions.address (UpdateLoggedIn << UpdateAdd <| 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/View/LoggedIn/Monthly.elm b/src/client/elm/View/LoggedIn/Monthly.elm
new file mode 100644
index 0000000..a274015
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Monthly.elm
@@ -0,0 +1,89 @@
+module View.LoggedIn.Monthly
+ ( monthlyPayments
+ ) where
+
+import String
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+import Update.LoggedIn.Monthly exposing (..)
+
+import Model exposing (Model)
+import Model.View.LoggedIn.Monthly exposing (Monthly)
+import Model.Payment exposing (Payments, Payment)
+import Model.View.LoggedInView exposing (LoggedInView)
+import Model.Translations exposing (getMessage, getParamMessage)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import View.Icon exposing (renderIcon)
+import View.Expand exposing (..)
+import View.Price exposing (price)
+
+monthlyPayments : Model -> LoggedInView -> Html
+monthlyPayments model loggedInView =
+ let monthly = loggedInView.monthly
+ in if List.length monthly.payments == 0
+ then
+ text ""
+ else
+ div
+ [ classList
+ [ ("monthlyPayments", True)
+ , ("detail", monthly.visibleDetail)
+ ]
+ ]
+ [ monthlyCount model monthly
+ , if monthly.visibleDetail then paymentsTable model loggedInView monthly else text ""
+ ]
+
+monthlyCount : Model -> Monthly -> Html
+monthlyCount 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 actions.address (UpdateLoggedIn << UpdateMonthly <| ToggleDetail)
+ ]
+ [ text (getParamMessage [toString count, price model total] key model.translations)
+ , expand ExpandDown monthly.visibleDetail
+ ]
+
+paymentsTable : Model -> LoggedInView -> Monthly -> Html
+paymentsTable model loggedInView monthly =
+ div
+ [ class "table" ]
+ ( monthly.payments
+ |> List.sortBy (String.toLower << .name)
+ |> List.map (paymentLine model loggedInView)
+ )
+
+paymentLine : Model -> LoggedInView -> Payment -> Html
+paymentLine model loggedInView payment =
+ a
+ [ classList
+ [ ("row", True)
+ , ("edition", loggedInView.paymentEdition == Just payment.id)
+ ]
+ , onClick actions.address (UpdateLoggedIn (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 serverCommunications.address (SC.DeleteMonthlyPayment payment.id)
+ ]
+ [ button [] [ renderIcon "times" ]
+ ]
+ ]
diff --git a/src/client/elm/View/LoggedIn/Paging.elm b/src/client/elm/View/LoggedIn/Paging.elm
new file mode 100644
index 0000000..93d7f1d
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Paging.elm
@@ -0,0 +1,100 @@
+module View.LoggedIn.Paging
+ ( paymentsPaging
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+
+import Model.View.LoggedInView exposing (..)
+import Model.Payment exposing (perPage)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+
+import View.Icon exposing (renderIcon)
+
+showedPages : Int
+showedPages = 5
+
+paymentsPaging : LoggedInView -> Html
+paymentsPaging loggedInView =
+ let maxPage = ceiling (toFloat loggedInView.paymentsCount / toFloat perPage)
+ pages = truncatePages loggedInView.currentPage [1..maxPage]
+ in if maxPage == 1
+ then
+ text ""
+ else
+ div
+ [ class "pages" ]
+ ( ( if loggedInView.currentPage > 1
+ then [ firstPage, previousPage loggedInView ]
+ else []
+ )
+ ++ ( List.map (paymentsPage loggedInView) pages)
+ ++ ( if loggedInView.currentPage < maxPage
+ then [ nextPage loggedInView, lastPage 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 ->
+ [1..showedPages]
+ | currentPage > totalPages - showedRightPages ->
+ [(totalPages - showedPages)..totalPages]
+ | otherwise ->
+ [(currentPage - showedLeftPages)..(currentPage + showedRightPages)]
+ in List.filter (flip List.member pages) truncatedPages
+
+firstPage : Html
+firstPage =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage 1)
+ ]
+ [ renderIcon "fast-backward" ]
+
+previousPage : LoggedInView -> Html
+previousPage loggedInView =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage (loggedInView.currentPage - 1))
+ ]
+ [ renderIcon "backward" ]
+
+nextPage : LoggedInView -> Html
+nextPage loggedInView =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage (loggedInView.currentPage + 1))
+ ]
+ [ renderIcon "forward" ]
+
+lastPage : Int -> Html
+lastPage maxPage =
+ button
+ [ class "page"
+ , onClick serverCommunications.address (SC.UpdatePage maxPage)
+ ]
+ [ renderIcon "fast-forward" ]
+
+paymentsPage : LoggedInView -> Int -> Html
+paymentsPage loggedInView page =
+ let onCurrentPage = page == loggedInView.currentPage
+ in button
+ [ classList
+ [ ("page", True)
+ , ("current", onCurrentPage)
+ ]
+ , onClick serverCommunications.address <|
+ if onCurrentPage then SC.NoCommunication else SC.UpdatePage page
+ ]
+ [ text (toString page) ]
diff --git a/src/client/elm/View/LoggedIn/Table.elm b/src/client/elm/View/LoggedIn/Table.elm
new file mode 100644
index 0000000..f5a08b5
--- /dev/null
+++ b/src/client/elm/View/LoggedIn/Table.elm
@@ -0,0 +1,97 @@
+module View.LoggedIn.Table
+ ( paymentsTable
+ ) where
+
+import Html exposing (..)
+import Html.Attributes exposing (..)
+import Html.Events exposing (..)
+import Dict exposing (..)
+
+import Date
+import Date exposing (Date)
+
+import String exposing (append)
+
+import Model exposing (Model)
+import Model.User exposing (getUserName)
+import Model.Payment exposing (..)
+import Model.View.LoggedInView exposing (LoggedInView)
+import Model.Translations exposing (getMessage)
+
+import ServerCommunication as SC exposing (serverCommunications)
+
+import Update exposing (..)
+import Update.LoggedIn exposing (..)
+
+import View.Icon exposing (renderIcon)
+import View.Date exposing (..)
+import View.Price exposing (price)
+
+paymentsTable : Model -> LoggedInView -> Html
+paymentsTable model loggedInView =
+ div
+ [ class "table" ]
+ ( headerLine model :: paymentLines model loggedInView)
+
+headerLine : Model -> Html
+headerLine model =
+ div
+ [ class "header" ]
+ [ div [ class "cell category" ] [ renderIcon "shopping-cart" ]
+ , div [ class "cell cost" ] [ text model.config.currency ]
+ , div [ class "cell user" ] [ renderIcon "user" ]
+ , div [ class "cell date" ] [ renderIcon "calendar" ]
+ , div [ class "cell" ] []
+ ]
+
+paymentLines : Model -> LoggedInView -> List Html
+paymentLines model loggedInView =
+ loggedInView.payments
+ |> List.sortBy (Date.toTime << .creation)
+ |> List.reverse
+ |> List.map (paymentLine model loggedInView)
+
+paymentLine : Model -> LoggedInView -> Payment -> Html
+paymentLine model loggedInView payment =
+ a
+ [ classList
+ [ ("row", True)
+ , ("edition", loggedInView.paymentEdition == Just payment.id)
+ ]
+ , onClick actions.address (UpdateLoggedIn (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 loggedInView.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 loggedInView.account.me == payment.userId
+ then
+ div
+ [ class "cell delete" ]
+ [ button
+ [ onClick serverCommunications.address (SC.DeletePayment payment loggedInView.currentPage) ]
+ [ renderIcon "times" ]
+ ]
+ else
+ div [ class "cell" ] []
+ ]