From a6727f104f808e533052f2bd83bc89cd6bfa0522 Mon Sep 17 00:00:00 2001 From: Joris Guyonvarch Date: Sun, 19 Jul 2015 00:45:42 +0200 Subject: Adding UI to sign in and sign out --- src/client/Main.elm | 14 ++++++- src/client/Model.elm | 10 ++--- src/client/Model/View.elm | 10 +++++ src/client/ServerCommunication.elm | 63 +++++++++++++++++++++++++++++ src/client/Update.elm | 12 ++++-- src/client/View/Icon.elm | 12 ++++++ src/client/View/Page.elm | 82 ++++++++++++++++++++++++++------------ 7 files changed, 165 insertions(+), 38 deletions(-) create mode 100644 src/client/Model/View.elm create mode 100644 src/client/ServerCommunication.elm create mode 100644 src/client/View/Icon.elm (limited to 'src/client') diff --git a/src/client/Main.elm b/src/client/Main.elm index bff5f23..e79fe2b 100644 --- a/src/client/Main.elm +++ b/src/client/Main.elm @@ -18,6 +18,8 @@ import Update exposing (Action(..), actions, updateModel) import View.Page exposing (renderPage) +import ServerCommunication exposing (serverCommunications, sendRequest) + {-| main -} main : Signal Html @@ -26,6 +28,8 @@ main = Signal.map renderPage model model : Signal Model model = Signal.foldp updateModel initialModel actions.signal +--------------------------------------- + port fetchPayments : Task Http.Error () port fetchPayments = getPayments @@ -36,7 +40,15 @@ reportSuccess : Payments -> Task x () reportSuccess payments = Signal.send actions.address (UpdatePayments payments) reportError : Http.Error -> Task x () -reportError error = Signal.send actions.address Forbidden +reportError error = Signal.send actions.address SignIn getPayments : Task Http.Error Payments getPayments = Http.get paymentsDecoder "/payments" + +--------------------------------------------------- + +port serverCommunicationsPort : Signal (Task Http.RawError ()) +port serverCommunicationsPort = + Signal.map + (\comm -> sendRequest comm `Task.andThen` (Signal.send actions.address)) + serverCommunications.signal diff --git a/src/client/Model.elm b/src/client/Model.elm index 6888676..8005429 100644 --- a/src/client/Model.elm +++ b/src/client/Model.elm @@ -3,17 +3,13 @@ module Model , initialModel ) where -import List - -import Model.Payment exposing (Payments) +import Model.View exposing (..) type alias Model = - { payments : Maybe Payments - , forbiddenAccess : Bool + { view : View } initialModel : Model initialModel = - { payments = Nothing - , forbiddenAccess = False + { view = LoadingView } diff --git a/src/client/Model/View.elm b/src/client/Model/View.elm new file mode 100644 index 0000000..ca819e3 --- /dev/null +++ b/src/client/Model/View.elm @@ -0,0 +1,10 @@ +module Model.View + ( View(..) + ) where + +import Model.Payment exposing (Payments) + +type View = + LoadingView + | PaymentView Payments + | SignInView String diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm new file mode 100644 index 0000000..e29b084 --- /dev/null +++ b/src/client/ServerCommunication.elm @@ -0,0 +1,63 @@ +module ServerCommunication + ( Communication(..) + , sendRequest + , serverCommunications + ) where + +import Signal +import Task +import Task exposing (Task) +import Http + +import Update as U + +type Communication = + NoCommunication + | SignIn String + | SignOut + +serverCommunications : Signal.Mailbox Communication +serverCommunications = Signal.mailbox NoCommunication + +sendRequest : Communication -> Task Http.RawError U.Action +sendRequest communication = + case getRequest communication of + Nothing -> + Task.succeed U.NoOp + Just request -> + Http.send Http.defaultSettings request + |> Task.map (communicationToAction communication) + +getRequest : Communication -> Maybe Http.Request +getRequest communication = + case communication of + NoCommunication -> + Nothing + SignIn login -> + Just + { verb = "post" + , headers = [] + , url = "/signIn?login=" ++ login + , body = Http.empty + } + SignOut -> + Just + { verb = "post" + , headers = [] + , url = "/signOut" + , body = Http.empty + } + +communicationToAction : Communication -> Http.Response -> U.Action +communicationToAction communication response = + if response.status == 200 + then + case communication of + NoCommunication -> + U.NoOp + SignIn _ -> + U.NoOp + SignOut -> + U.SignIn + else + U.NoOp diff --git a/src/client/Update.elm b/src/client/Update.elm index b96d899..3937888 100644 --- a/src/client/Update.elm +++ b/src/client/Update.elm @@ -6,10 +6,12 @@ module Update import Model exposing (Model) import Model.Payment exposing (Payments) +import Model.View exposing (..) type Action = NoOp - | Forbidden + | SignIn + | UpdateLogin String | UpdatePayments Payments actions : Signal.Mailbox Action @@ -20,7 +22,9 @@ updateModel action model = case action of NoOp -> model - Forbidden -> - { model | forbiddenAccess <- True } + SignIn -> + { model | view <- SignInView "" } + UpdateLogin login -> + { model | view <- SignInView login } UpdatePayments payments -> - { model | payments <- Just payments } + { model | view <- PaymentView payments } diff --git a/src/client/View/Icon.elm b/src/client/View/Icon.elm new file mode 100644 index 0000000..f22c1a2 --- /dev/null +++ b/src/client/View/Icon.elm @@ -0,0 +1,12 @@ +module View.Icon + ( renderIcon + ) where + +import Html exposing (..) +import Html.Attributes exposing (..) + +renderIcon : String -> Html +renderIcon iconClass = + i + [ class <| "fa fa-fw fa-" ++ iconClass ] + [] diff --git a/src/client/View/Page.elm b/src/client/View/Page.elm index 777655c..1683cf3 100644 --- a/src/client/View/Page.elm +++ b/src/client/View/Page.elm @@ -15,50 +15,80 @@ import String exposing (append) import Model exposing (Model) import Model.Payment exposing (Payments, Payment) +import Model.View exposing (..) + +import Update exposing (..) + +import ServerCommunication as SC +import ServerCommunication exposing (serverCommunications) + +import View.Icon exposing (renderIcon) renderPage : Model -> Html renderPage model = div [] - [ renderHeader + [ renderHeader model , renderMain model ] -renderHeader : Html -renderHeader = +renderHeader : Model -> Html +renderHeader model = header [] [ h1 [] [ text "Payments" ] + , 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 = - if model.forbiddenAccess - then - forbiddenAccess - else - model.payments - |> Maybe.map paymentTable - |> Maybe.withDefault loadingTable - -forbiddenAccess : Html -forbiddenAccess = text "Forbidden access" - -loadingTable : Html -loadingTable = text "" - -paymentTable : Payments -> Html -paymentTable payments = + case model.view of + LoadingView -> + loadingView + SignInView login -> + signInView login + PaymentView payments -> + paymentsView payments + +loadingView : Html +loadingView = text "" + +signInView : String -> Html +signInView login = + H.form + [ class "signIn" ] + [ input + [ value login + , on "input" targetValue (Signal.message actions.address << UpdateLogin) + ] + [] + , button + [ onClick serverCommunications.address (SC.SignIn login) ] + [ renderIcon "sign-in" ] + ] + +paymentsView : Payments -> Html +paymentsView payments = table [] ([ tr [] - [ th [] [ text "Utilisateur" ] - , th [] [ text "Nom" ] - , th [] [ text "Prix" ] - , th [] [ text "Date" ] + [ th [] [ renderIcon "user" ] + , th [] [ renderIcon "shopping-cart" ] + , th [] [ renderIcon "euro" ] + , th [] [ renderIcon "calendar" ] ] ] ++ (paymentLines payments)) @@ -73,9 +103,9 @@ paymentLine : Payment -> Html paymentLine payment = tr [] - [ td [] [ text payment.name ] - , td [] [ text payment.userName ] - , td [] [ text (toString payment.cost) ] + [ td [] [ text payment.userName ] + , td [] [ text payment.name ] + , td [] [ text ((toString payment.cost) ++ " €") ] , td [] [ text (renderDate payment.creation) ] ] -- cgit v1.2.3