From a271d6034bc4cc631a64476d25d21c83a701fa39 Mon Sep 17 00:00:00 2001 From: Joris Guyonvarch Date: Mon, 20 Jul 2015 21:55:52 +0200 Subject: Add a payment from the UI, it needs polishing however --- src/client/View/Header.elm | 35 ++++++++++ src/client/View/Loading.elm | 8 +++ src/client/View/Page.elm | 136 +++---------------------------------- src/client/View/Payments.elm | 20 ++++++ src/client/View/Payments/Add.elm | 34 ++++++++++ src/client/View/Payments/Table.elm | 51 ++++++++++++++ src/client/View/SignIn.elm | 60 ++++++++++++++++ 7 files changed, 217 insertions(+), 127 deletions(-) create mode 100644 src/client/View/Header.elm create mode 100644 src/client/View/Loading.elm create mode 100644 src/client/View/Payments.elm create mode 100644 src/client/View/Payments/Add.elm create mode 100644 src/client/View/Payments/Table.elm create mode 100644 src/client/View/SignIn.elm (limited to 'src/client/View') diff --git a/src/client/View/Header.elm b/src/client/View/Header.elm new file mode 100644 index 0000000..788a473 --- /dev/null +++ b/src/client/View/Header.elm @@ -0,0 +1,35 @@ +module View.Header + ( renderHeader + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import ServerCommunication as SC +import ServerCommunication exposing (serverCommunications) + +import Model exposing (Model) +import Model.View exposing (..) + +import View.Icon exposing (renderIcon) + +renderHeader : Model -> Html +renderHeader model = + header + [] + [ h1 + [] + [ text "Shared Cost" ] + , case model.view of + LoadingView -> + text "" + SignInView _ -> + text "" + PaymentView _ -> + button + [ class "signOut" + , onClick serverCommunications.address SC.SignOut + ] + [ renderIcon "power-off" ] + ] diff --git a/src/client/View/Loading.elm b/src/client/View/Loading.elm new file mode 100644 index 0000000..f8c6cd6 --- /dev/null +++ b/src/client/View/Loading.elm @@ -0,0 +1,8 @@ +module View.Loading + ( renderLoading + ) where + +import Html exposing (..) + +renderLoading : Html +renderLoading = text "" diff --git a/src/client/View/Page.elm b/src/client/View/Page.elm index bf61dc1..59c21a2 100644 --- a/src/client/View/Page.elm +++ b/src/client/View/Page.elm @@ -3,30 +3,14 @@ module View.Page ) where import Html exposing (..) -import Html as H -import Html.Attributes exposing (..) -import Html.Attributes as A -import Html.Events exposing (..) - -import Date -import Date exposing (Date) - -import String exposing (append) - -import Json.Decode as Json import Model exposing (Model) -import Model.Payment exposing (Payments, Payment) import Model.View exposing (..) -import Model.View.SignIn exposing (..) -import Update exposing (..) -import Update.SignIn exposing (..) - -import ServerCommunication as SC -import ServerCommunication exposing (serverCommunications) - -import View.Icon exposing (renderIcon) +import View.Header exposing (renderHeader) +import View.Loading exposing (renderLoading) +import View.SignIn exposing (renderSignIn) +import View.Payments exposing (renderPayments) renderPage : Model -> Html renderPage model = @@ -36,114 +20,12 @@ renderPage model = , renderMain model ] -renderHeader : Model -> Html -renderHeader model = - header - [] - [ h1 - [] - [ text "Shared Cost" ] - , case model.view of - LoadingView -> - text "" - SignInView _ -> - text "" - PaymentView _ -> - button - [ class "signOut" - , onClick serverCommunications.address SC.SignOut - ] - [ renderIcon "power-off" ] - ] - renderMain : Model -> Html renderMain model = case model.view of LoadingView -> - loadingView - SignInView signIn -> - signInView signIn - PaymentView payments -> - paymentsView payments - -loadingView : Html -loadingView = text "" - -signInView : SignIn -> Html -signInView signIn = - div - [ class "signIn" ] - [ div - [ class "form" ] - [ input - [ value signIn.login - , on "input" targetValue (Signal.message actions.address << UpdateSignIn << UpdateLogin) - , onEnter serverCommunications.address (SC.SignIn signIn.login) - ] - [] - , button - [ onClick serverCommunications.address (SC.SignIn signIn.login) ] - [ text "Sign in" ] - ] - , div - [ class "result" ] - [ signInResult signIn ] - ] - -onEnter : Signal.Address a -> a -> Attribute -onEnter address value = - on "keydown" - (Json.customDecoder keyCode (\code -> if code == 13 then Ok () else Err "")) - (\_ -> Signal.message address value) - -signInResult : SignIn -> Html -signInResult signIn = - case signIn.result of - Just result -> - case result of - Ok login -> - div - [ class "success" ] - [ text ("We send you an email, please click to the provided link in order to sign in.") ] - Err error -> - div - [ class "error" ] - [ text error ] - Nothing -> - text "" - -paymentsView : Payments -> Html -paymentsView payments = - table - [] - ([ tr - [] - [ th [] [ renderIcon "user" ] - , th [] [ renderIcon "shopping-cart" ] - , th [] [ renderIcon "euro" ] - , th [] [ renderIcon "calendar" ] - ] - ] ++ (paymentLines payments)) - -paymentLines : Payments -> List Html -paymentLines payments = - payments - |> List.sortBy (Date.toTime << .creation) - |> List.reverse - |> List.map paymentLine - -paymentLine : Payment -> Html -paymentLine payment = - tr - [] - [ td [] [ text payment.userName ] - , td [] [ text payment.name ] - , td [] [ text ((toString payment.cost) ++ " €") ] - , td [] [ text (renderDate payment.creation) ] - ] - -renderDate : Date -> String -renderDate date = - toString (Date.day date) - |> flip append (" " ++ (toString (Date.month date)) ++ ".") - |> flip append (" " ++ (toString (Date.year date))) + renderLoading + SignInView signInView -> + renderSignIn signInView + PaymentView paymentsView -> + renderPayments paymentsView diff --git a/src/client/View/Payments.elm b/src/client/View/Payments.elm new file mode 100644 index 0000000..dfc0905 --- /dev/null +++ b/src/client/View/Payments.elm @@ -0,0 +1,20 @@ +module View.Payments + ( renderPayments + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) + +import Model.Payment exposing (Payments) +import Model.View.PaymentView exposing (PaymentView) + +import View.Payments.Add exposing (addPayment) +import View.Payments.Table exposing (paymentsTable) + +renderPayments : PaymentView -> Html +renderPayments paymentView = + div + [ class "payments" ] + [ addPayment paymentView.name paymentView.cost + , paymentsTable paymentView.payments + ] diff --git a/src/client/View/Payments/Add.elm b/src/client/View/Payments/Add.elm new file mode 100644 index 0000000..f2230be --- /dev/null +++ b/src/client/View/Payments/Add.elm @@ -0,0 +1,34 @@ +module View.Payments.Add + ( addPayment + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import ServerCommunication as SC +import ServerCommunication exposing (serverCommunications) + +import Update exposing (..) +import Update.Payment exposing (..) + +addPayment : String -> String -> Html +addPayment name cost = + div + [ class "add" ] + [ text "Name" + , input + [ value name + , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateName) + ] + [] + , text "Cost" + , input + [ value cost + , on "input" targetValue (Signal.message actions.address << UpdatePayment << UpdateCost) + ] + [] + , button + [ onClick serverCommunications.address (SC.AddPayment name cost) ] + [ text "Add" ] + ] diff --git a/src/client/View/Payments/Table.elm b/src/client/View/Payments/Table.elm new file mode 100644 index 0000000..34dc058 --- /dev/null +++ b/src/client/View/Payments/Table.elm @@ -0,0 +1,51 @@ +module View.Payments.Table + ( paymentsTable + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) + +import Date +import Date exposing (Date) + +import String exposing (append) + +import Model.Payment exposing (Payments, Payment) + +import View.Icon exposing (renderIcon) + +paymentsTable : Payments -> Html +paymentsTable payments = + table + [] + ([ tr + [] + [ th [] [ renderIcon "user" ] + , th [] [ renderIcon "shopping-cart" ] + , th [] [ renderIcon "euro" ] + , th [] [ renderIcon "calendar" ] + ] + ] ++ (paymentLines payments)) + +paymentLines : Payments -> List Html +paymentLines payments = + payments + |> List.sortBy (Date.toTime << .creation) + |> List.reverse + |> List.map paymentLine + +paymentLine : Payment -> Html +paymentLine payment = + tr + [] + [ td [] [ text payment.userName ] + , td [] [ text payment.name ] + , td [] [ text ((toString payment.cost) ++ " €") ] + , td [] [ text (renderDate payment.creation) ] + ] + +renderDate : Date -> String +renderDate date = + toString (Date.day date) + |> flip append (" " ++ (toString (Date.month date)) ++ ".") + |> flip append (" " ++ (toString (Date.year date))) diff --git a/src/client/View/SignIn.elm b/src/client/View/SignIn.elm new file mode 100644 index 0000000..02ee1bd --- /dev/null +++ b/src/client/View/SignIn.elm @@ -0,0 +1,60 @@ +module View.SignIn + ( renderSignIn + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) +import Html.Events exposing (..) + +import Json.Decode as Json + +import Update exposing (..) +import Update.SignIn exposing (..) + +import ServerCommunication as SC +import ServerCommunication exposing (serverCommunications) + +import Model.View.SignInView exposing (..) + +renderSignIn : SignInView -> Html +renderSignIn signInView = + div + [ class "signIn" ] + [ div + [ class "form" ] + [ input + [ value signInView.login + , on "input" targetValue (Signal.message actions.address << UpdateSignIn << UpdateLogin) + , onEnter serverCommunications.address (SC.SignIn signInView.login) + ] + [] + , button + [ onClick serverCommunications.address (SC.SignIn signInView.login) ] + [ text "Sign in" ] + ] + , div + [ class "result" ] + [ signInResult signInView ] + ] + +onEnter : Signal.Address a -> a -> Attribute +onEnter address value = + on "keydown" + (Json.customDecoder keyCode (\code -> if code == 13 then Ok () else Err "")) + (\_ -> Signal.message address value) + +signInResult : SignInView -> Html +signInResult signInView = + case signInView.result of + Just result -> + case result of + Ok login -> + div + [ class "success" ] + [ text ("We send you an email, please click to the provided link in order to sign in.") ] + Err error -> + div + [ class "error" ] + [ text error ] + Nothing -> + text "" -- cgit v1.2.3