From 1e47a7754ca38bd1a6c74765d8378caf68ce4619 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 26 Mar 2017 21:10:42 +0200 Subject: Separate client and server watch --- src/client/LoggedIn/Home/Header/View.elm | 104 ++++++++++++++ src/client/LoggedIn/Home/Model.elm | 40 ++++++ src/client/LoggedIn/Home/Msg.elm | 12 ++ src/client/LoggedIn/Home/Update.elm | 35 +++++ src/client/LoggedIn/Home/View.elm | 38 +++++ src/client/LoggedIn/Home/View/ExceedingPayers.elm | 45 ++++++ src/client/LoggedIn/Home/View/Paging.elm | 109 ++++++++++++++ src/client/LoggedIn/Home/View/Table.elm | 166 ++++++++++++++++++++++ 8 files changed, 549 insertions(+) create mode 100644 src/client/LoggedIn/Home/Header/View.elm create mode 100644 src/client/LoggedIn/Home/Model.elm create mode 100644 src/client/LoggedIn/Home/Msg.elm create mode 100644 src/client/LoggedIn/Home/Update.elm create mode 100644 src/client/LoggedIn/Home/View.elm create mode 100644 src/client/LoggedIn/Home/View/ExceedingPayers.elm create mode 100644 src/client/LoggedIn/Home/View/Paging.elm create mode 100644 src/client/LoggedIn/Home/View/Table.elm (limited to 'src/client/LoggedIn/Home') diff --git a/src/client/LoggedIn/Home/Header/View.elm b/src/client/LoggedIn/Home/Header/View.elm new file mode 100644 index 0000000..3f8a320 --- /dev/null +++ b/src/client/LoggedIn/Home/Header/View.elm @@ -0,0 +1,104 @@ +module LoggedIn.Home.Header.View exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) +import String +import Dict +import Date + +import Form exposing (Form) +import View.Form as Form +import View.Events exposing (onSubmitPrevDefault) + +import Msg exposing (Msg) +import LoggedIn.Msg as LoggedInMsg +import LoggedIn.Home.Msg as HomeMsg + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Model as Home +import Model.Translations exposing (getParamMessage) +import Model.Conf exposing (Conf) +import Model.Payment as Payment exposing (Payments, Frequency(..)) +import Model.Translations exposing (getMessage) + +import Dialog.AddPayment.Model as AddPayment +import Dialog.AddPayment.View as AddPayment + +import LoggedIn.Home.View.ExceedingPayers as ExceedingPayers +import LoggedIn.View.Format as Format +import View.Plural exposing (plural) + +view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg +view loggedData { search } payments frequency = + let currentDate = Date.fromTime loggedData.currentTime + in Html.div + [ class "header" ] + [ div + [ class "payerAndAdd" ] + [ ExceedingPayers.view loggedData + , AddPayment.button + loggedData + (AddPayment.initialAdd loggedData.translations currentDate frequency) + "AddPayment" + (text (getMessage loggedData.translations "AddPayment")) + Nothing + ] + , Html.div + [ class "searchLine" ] + [ searchForm loggedData search ] + , infos loggedData payments + ] + +searchForm : LoggedData -> Form String Home.Search -> Html Msg +searchForm loggedData search = + Html.map (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.SearchMsg) <| + Html.form + [ onSubmitPrevDefault Form.NoOp ] + [ Form.textInput loggedData.translations search "search" "name" + , if List.isEmpty (Payment.monthly loggedData.payments) + then text "" + else Form.radioInputs loggedData.translations search "search" "frequency" [ toString Punctual, toString Monthly ] + ] + +infos : LoggedData -> Payments -> Html Msg +infos loggedData payments = + let paymentsCount = List.length payments + in if paymentsCount == 0 + then text "" + else + let count = plural loggedData.translations (List.length payments) "Payment" "Payments" + sum = paymentsSum loggedData.conf payments + in div + [ class "infos" ] + [ span + [ class "total" ] + [ text <| getParamMessage [ count, sum ] loggedData.translations "Worth" ] + , span + [ class "partition" ] + [ text <| paymentsPartition loggedData payments ] + ] + +paymentsPartition : LoggedData -> Payments -> String +paymentsPartition loggedData payments = + String.join + ", " + ( loggedData.users + |> Dict.toList + |> List.map (Tuple.mapFirst (\userId -> Payment.totalPayments (always True) userId payments)) + |> List.filter (\(sum, _) -> sum > 0) + |> List.sortBy Tuple.first + |> List.reverse + |> List.map (\(sum, user) -> + getParamMessage [ user.name, Format.price loggedData.conf sum ] loggedData.translations "By" + ) + ) + +paymentsSum : Conf -> Payments -> String +paymentsSum conf payments = + payments + |> List.map .cost + |> List.sum + |> Format.price conf diff --git a/src/client/LoggedIn/Home/Model.elm b/src/client/LoggedIn/Home/Model.elm new file mode 100644 index 0000000..ace1593 --- /dev/null +++ b/src/client/LoggedIn/Home/Model.elm @@ -0,0 +1,40 @@ +module LoggedIn.Home.Model exposing + ( Model + , Search + , init + , searchInitial + , validation + ) + +import Form exposing (Form) +import Form.Validate as Validate exposing (Validation) +import Form.Field as Field exposing (Field) + +import Model.User exposing (Users, UserId) +import Model.Payment as Payment exposing (PaymentId, Payments, Frequency(..)) +import Model.Payer exposing (Payers) + +type alias Model = + { currentPage : Int + , search : Form String Search + } + +type alias Search = + { name : Maybe String + , frequency : Frequency + } + +init : Model +init = + { currentPage = 1 + , search = Form.initial (searchInitial Punctual) validation + } + +searchInitial : Frequency -> List (String, Field) +searchInitial frequency = [ ("frequency", Field.string (toString frequency)) ] + +validation : Validation String Search +validation = + Validate.map2 Search + (Validate.field "name" (Validate.maybe Validate.string)) + (Validate.field "frequency" Payment.validateFrequency) diff --git a/src/client/LoggedIn/Home/Msg.elm b/src/client/LoggedIn/Home/Msg.elm new file mode 100644 index 0000000..b5f2566 --- /dev/null +++ b/src/client/LoggedIn/Home/Msg.elm @@ -0,0 +1,12 @@ +module LoggedIn.Home.Msg exposing + ( Msg(..) + ) + +import Form exposing (Form) + +import Model.Payment exposing (PaymentId) + +type Msg = + NoOp + | UpdatePage Int + | SearchMsg Form.Msg diff --git a/src/client/LoggedIn/Home/Update.elm b/src/client/LoggedIn/Home/Update.elm new file mode 100644 index 0000000..b0ce256 --- /dev/null +++ b/src/client/LoggedIn/Home/Update.elm @@ -0,0 +1,35 @@ +module LoggedIn.Home.Update exposing + ( update + ) + +import Form exposing (Form) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Home.Msg as Home +import LoggedIn.Home.Model as Home + +update : LoggedData -> Home.Msg -> Home.Model -> (Home.Model, Cmd Home.Msg) +update loggedData msg model = + case msg of + + Home.NoOp -> + ( model + , Cmd.none + ) + + Home.UpdatePage page -> + ( { model | currentPage = page } + , Cmd.none + ) + + Home.SearchMsg formMsg -> + ( { model + | search = Form.update Home.validation formMsg model.search + , currentPage = + case formMsg of + Form.Input "name" _ _ -> 1 + _ -> model.currentPage + } + , Cmd.none + ) diff --git a/src/client/LoggedIn/Home/View.elm b/src/client/LoggedIn/Home/View.elm new file mode 100644 index 0000000..0b90e67 --- /dev/null +++ b/src/client/LoggedIn/Home/View.elm @@ -0,0 +1,38 @@ +module LoggedIn.Home.View exposing + ( view + ) + +import Date +import Html exposing (..) +import Html.Attributes exposing (..) + +import Form +import Utils.Form as Form + +import LoggedData exposing (LoggedData) +import LoggedIn.Home.Header.View as Header +import LoggedIn.Home.Model as Home +import LoggedIn.Home.Msg as HomeMsg +import LoggedIn.Home.View.Paging as Paging +import LoggedIn.Home.View.Table as Table +import LoggedIn.Msg as LoggedInMsg +import Model.Payment as Payment exposing (Frequency(..)) +import Msg exposing (Msg) + +view : LoggedData -> Home.Model -> Html Msg +view loggedData home = + let (name, frequency) = + case Form.getOutput home.search of + Just data -> (Maybe.withDefault "" data.name, data.frequency) + Nothing -> ("", Punctual) + payments = Payment.search name frequency loggedData.payments + in div + [ class "home" ] + [ Header.view loggedData home payments frequency + , Table.view loggedData home payments frequency + , Paging.view + home.currentPage + (List.length payments) + Msg.NoOp + (Msg.UpdateLoggedIn << LoggedInMsg.HomeMsg << HomeMsg.UpdatePage) + ] diff --git a/src/client/LoggedIn/Home/View/ExceedingPayers.elm b/src/client/LoggedIn/Home/View/ExceedingPayers.elm new file mode 100644 index 0000000..6f2439c --- /dev/null +++ b/src/client/LoggedIn/Home/View/ExceedingPayers.elm @@ -0,0 +1,45 @@ +module LoggedIn.Home.View.ExceedingPayers exposing + ( view + ) + +import Html exposing (..) +import Html.Attributes exposing (..) + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import LoggedIn.View.Format as Format + +import Model exposing (Model) +import Model.User exposing (getUserName) +import Model.Payment as Payment +import Model.Payer exposing (..) +import Model.Translations exposing (getMessage) + +view : LoggedData -> Html Msg +view loggedData = + let payments = Payment.punctual loggedData.payments + exceedingPayers = getOrderedExceedingPayers loggedData.currentTime loggedData.users loggedData.incomes payments + in div + [ class "exceedingPayers" ] + ( if List.isEmpty exceedingPayers + then [ text <| getMessage loggedData.translations "PaymentsAreBalanced" ] + else (List.map (exceedingPayer loggedData) exceedingPayers) + ) + +exceedingPayer : LoggedData -> ExceedingPayer -> Html Msg +exceedingPayer loggedData payer = + span + [ class "exceedingPayer" ] + [ span + [ class "userName" ] + [ payer.userId + |> getUserName loggedData.users + |> Maybe.withDefault "−" + |> text + ] + , span + [ class "amount" ] + [ text ("+ " ++ (Format.price loggedData.conf payer.amount)) ] + ] diff --git a/src/client/LoggedIn/Home/View/Paging.elm b/src/client/LoggedIn/Home/View/Paging.elm new file mode 100644 index 0000000..dffe061 --- /dev/null +++ b/src/client/LoggedIn/Home/View/Paging.elm @@ -0,0 +1,109 @@ +module LoggedIn.Home.View.Paging exposing + ( view + ) + +import Color exposing (Color) + +import FontAwesome + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import LoggedData exposing (LoggedData) +import Model.Payment as Payment exposing (Payments, perPage) + +showedPages : Int +showedPages = 5 + +view : Int -> Int -> msg -> (Int -> msg) -> Html msg +view currentPage payments noOp pageMsg = + let maxPage = ceiling (toFloat payments / toFloat perPage) + pages = truncatePages currentPage (List.range 1 maxPage) + in if maxPage <= 1 + then + text "" + else + div + [ class "pages" ] + ( [ firstPage currentPage pageMsg + , previousPage currentPage noOp pageMsg + ] + ++ ( List.map (paymentsPage currentPage noOp pageMsg) pages) + ++ [ nextPage currentPage maxPage noOp pageMsg + , lastPage currentPage maxPage pageMsg + ] + ) + +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 + (List.range 1 showedPages) + else if currentPage > totalPages - showedRightPages then + (List.range (totalPages - showedPages + 1) totalPages) + else + (List.range (currentPage - showedLeftPages) (currentPage + showedRightPages)) + in List.filter (flip List.member pages) truncatedPages + +firstPage : Int -> (Int -> msg) -> Html msg +firstPage currentPage pageMsg = + button + [ classList + [ ("page", True) + , ("disable", currentPage <= 1) + ] + , onClick (pageMsg 1) + ] + [ FontAwesome.fast_backward grey 13 ] + +previousPage : Int -> msg -> (Int -> msg) -> Html msg +previousPage currentPage noOp pageMsg = + button + [ class "page" + , onClick <| + if currentPage > 1 + then (pageMsg <| currentPage - 1) + else noOp + ] + [ FontAwesome.backward grey 13 ] + +nextPage : Int -> Int -> msg -> (Int -> msg) -> Html msg +nextPage currentPage maxPage noOp pageMsg = + button + [ class "page" + , onClick <| + if currentPage < maxPage + then (pageMsg <| currentPage + 1) + else noOp + ] + [ FontAwesome.forward grey 13 ] + +lastPage : Int -> Int -> (Int -> msg) -> Html msg +lastPage currentPage maxPage pageMsg = + button + [ class "page" + , onClick (pageMsg maxPage) + ] + [ FontAwesome.fast_forward grey 13 ] + +paymentsPage : Int -> msg -> (Int -> msg) -> Int -> Html msg +paymentsPage currentPage noOp pageMsg page = + let onCurrentPage = page == currentPage + in button + [ classList + [ ("page", True) + , ("current", onCurrentPage) + ] + , onClick <| + if onCurrentPage + then noOp + else pageMsg page + ] + [ text (toString page) ] + +grey : Color +grey = Color.greyscale 0.35 diff --git a/src/client/LoggedIn/Home/View/Table.elm b/src/client/LoggedIn/Home/View/Table.elm new file mode 100644 index 0000000..8828488 --- /dev/null +++ b/src/client/LoggedIn/Home/View/Table.elm @@ -0,0 +1,166 @@ +module LoggedIn.Home.View.Table exposing + ( view + ) + +import Date exposing (Date) +import Dict exposing (..) +import String exposing (append) + +import FontAwesome +import View.Color as Color + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Dialog +import Dialog.AddPayment.Model as AddPayment +import Dialog.AddPayment.View as AddPayment + +import Tooltip + +import Msg exposing (Msg) + +import LoggedData exposing (LoggedData) + +import LoggedIn.Msg as LoggedInMsg + +import LoggedIn.Home.Model as Home +import LoggedIn.View.Format as Format +import View.Date as Date + +import Model.Payment as Payment exposing (..) +import Model.PaymentCategory as PaymentCategory +import Model.Translations exposing (getMessage) +import Model.User exposing (getUserName) + +view : LoggedData -> Home.Model -> Payments -> Frequency -> Html Msg +view loggedData homeModel payments frequency = + let visiblePayments = + payments + |> List.drop ((homeModel.currentPage - 1) * perPage) + |> List.take perPage + in div + [ class "table" ] + [ div + [ class "lines" ] + ( headerLine loggedData frequency :: List.map (paymentLine loggedData homeModel frequency) visiblePayments ) + , if List.isEmpty visiblePayments + then + div + [ class "emptyTableMsg" ] + [ text <| getMessage loggedData.translations "NoPayment" ] + else + text "" + ] + +headerLine : LoggedData -> Frequency -> Html Msg +headerLine loggedData frequency = + div + [ class "header" ] + [ div [ class "cell category" ] [ text <| getMessage loggedData.translations "Name" ] + , div [ class "cell cost" ] [ text <| getMessage loggedData.translations "Cost" ] + , div [ class "cell user" ] [ text <| getMessage loggedData.translations "Payer" ] + , div [ class "cell user" ] [ text <| getMessage loggedData.translations "PaymentCategory" ] + , case frequency of + Punctual -> div [ class "cell date" ] [ text <| getMessage loggedData.translations "Date" ] + Monthly -> text "" + , div [ class "cell" ] [] + , div [ class "cell" ] [] + , div [ class "cell" ] [] + ] + +paymentLine : LoggedData -> Home.Model -> Frequency -> Payment -> Html Msg +paymentLine loggedData homeModel frequency payment = + div + [ class "row" ] + [ div [ class "cell name" ] [ text payment.name ] + , div + [ classList + [ ("cell cost", True) + , ("refund", payment.cost < 0) + ] + ] + [ text (Format.price loggedData.conf payment.cost) ] + , div + [ class "cell user" ] + [ payment.userId + |> getUserName loggedData.users + |> Maybe.withDefault "−" + |> text + ] + , div + [ class "cell category" ] + ( let mbCategory = + PaymentCategory.search payment.name loggedData.paymentCategories + |> Maybe.andThen (\category -> Dict.get category loggedData.categories) + in case mbCategory of + Just category -> + [ span + [ class "tag" + , style [("background-color", category.color)] + ] + [ text category.name ] + ] + Nothing -> + [] + ) + , case frequency of + Punctual -> + div + [ class "cell date" ] + [ span + [ class "shortDate" ] + [ text (Date.shortView payment.date loggedData.translations) ] + , span + [ class "longDate" ] + [ text (Date.longView payment.date loggedData.translations) ] + ] + Monthly -> + text "" + , div + [ class "cell button" ] + [ let currentDate = Date.fromTime loggedData.currentTime + category = PaymentCategory.search payment.name loggedData.paymentCategories + in AddPayment.button + loggedData + (AddPayment.initialClone loggedData.translations currentDate category payment) + "ClonePayment" + (FontAwesome.clone Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Clone")) + ] + , div + [ class "cell button" ] + [ if loggedData.me /= payment.userId + then + text "" + else + let category = PaymentCategory.search payment.name loggedData.paymentCategories + in AddPayment.button + loggedData + (AddPayment.initialEdit loggedData.translations category payment) + "EditPayment" + (FontAwesome.pencil Color.chestnutRose 18) + (Just (getMessage loggedData.translations "Edit")) + ] + , div + [ class "cell button" ] + [ if loggedData.me /= payment.userId + then + text "" + else + let dialogConfig = + { className = "deletePaymentDialog" + , title = getMessage loggedData.translations "ConfirmPaymentDelete" + , body = always <| text "" + , confirm = getMessage loggedData.translations "Confirm" + , confirmMsg = always <| Msg.Dialog <| Dialog.UpdateAndClose <| Msg.DeletePayment payment.id + , undo = getMessage loggedData.translations "Undo" + } + in button + ( Tooltip.show Msg.Tooltip (getMessage loggedData.translations "Delete") + ++ [ onClick (Msg.Dialog <| Dialog.Open dialogConfig) ] + ) + [ FontAwesome.trash Color.chestnutRose 18 ] + ] + ] -- cgit v1.2.3