diff options
Diffstat (limited to 'src/client')
-rw-r--r-- | src/client/Main.elm | 101 | ||||
-rw-r--r-- | src/client/ServerCommunication.elm | 143 | ||||
-rw-r--r-- | src/client/elm/InitViewAction.elm | 25 | ||||
-rw-r--r-- | src/client/elm/Main.elm | 89 | ||||
-rw-r--r-- | src/client/elm/Model.elm (renamed from src/client/Model.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/Config.elm (renamed from src/client/Model/Config.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/Date.elm (renamed from src/client/Model/Date.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/Income.elm (renamed from src/client/Model/Income.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/Payer.elm (renamed from src/client/Model/Payer.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/Payment.elm (renamed from src/client/Model/Payment.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/Translations.elm (renamed from src/client/Model/Translations.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/User.elm (renamed from src/client/Model/User.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/View.elm (renamed from src/client/Model/View.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/View/LoggedIn/Account.elm (renamed from src/client/Model/View/LoggedIn/Account.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/View/LoggedIn/Add.elm (renamed from src/client/Model/View/LoggedIn/Add.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/View/LoggedIn/Edition.elm (renamed from src/client/Model/View/LoggedIn/Edition.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/View/LoggedIn/Monthly.elm (renamed from src/client/Model/View/LoggedIn/Monthly.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/View/LoggedInView.elm (renamed from src/client/Model/View/LoggedInView.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Model/View/SignInView.elm (renamed from src/client/Model/View/SignInView.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Native/Reads.js (renamed from src/client/Native/Reads.js) | 0 | ||||
-rw-r--r-- | src/client/elm/Persona.elm | 28 | ||||
-rw-r--r-- | src/client/elm/Reads.elm (renamed from src/client/Reads.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/ServerCommunication.elm | 95 | ||||
-rw-r--r-- | src/client/elm/Sign.elm | 43 | ||||
-rw-r--r-- | src/client/elm/SimpleHTTP.elm | 41 | ||||
-rw-r--r-- | src/client/elm/Update.elm (renamed from src/client/Update.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Update/LoggedIn.elm (renamed from src/client/Update/LoggedIn.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Update/LoggedIn/Account.elm (renamed from src/client/Update/LoggedIn/Account.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Update/LoggedIn/Add.elm (renamed from src/client/Update/LoggedIn/Add.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Update/LoggedIn/Monthly.elm (renamed from src/client/Update/LoggedIn/Monthly.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Update/SignIn.elm (renamed from src/client/Update/SignIn.elm) | 11 | ||||
-rw-r--r-- | src/client/elm/Utils/Dict.elm (renamed from src/client/Utils/Dict.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Utils/Either.elm (renamed from src/client/Utils/Either.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Utils/Maybe.elm (renamed from src/client/Utils/Maybe.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/Utils/Validation.elm (renamed from src/client/Utils/Validation.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/Date.elm (renamed from src/client/View/Date.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/Events.elm (renamed from src/client/View/Events.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/Expand.elm (renamed from src/client/View/Expand.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/Header.elm (renamed from src/client/View/Header.elm) | 15 | ||||
-rw-r--r-- | src/client/elm/View/Icon.elm (renamed from src/client/View/Icon.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/Loading.elm (renamed from src/client/View/Loading.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/LoggedIn.elm (renamed from src/client/View/LoggedIn.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/LoggedIn/Account.elm (renamed from src/client/View/LoggedIn/Account.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/LoggedIn/Add.elm (renamed from src/client/View/LoggedIn/Add.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/LoggedIn/Monthly.elm (renamed from src/client/View/LoggedIn/Monthly.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/LoggedIn/Paging.elm (renamed from src/client/View/LoggedIn/Paging.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/LoggedIn/Table.elm (renamed from src/client/View/LoggedIn/Table.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/Page.elm (renamed from src/client/View/Page.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/Price.elm (renamed from src/client/View/Price.elm) | 0 | ||||
-rw-r--r-- | src/client/elm/View/SignIn.elm (renamed from src/client/View/SignIn.elm) | 13 | ||||
-rw-r--r-- | src/client/js/main.js | 28 |
51 files changed, 360 insertions, 272 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm deleted file mode 100644 index 4f96675..0000000 --- a/src/client/Main.elm +++ /dev/null @@ -1,101 +0,0 @@ -module Main - ( main - ) where - -import Graphics.Element exposing (..) - -import Html exposing (Html) - -import Http -import Task exposing (..) -import Time exposing (..) -import Json.Decode as Json exposing ((:=)) -import Dict - -import Model exposing (Model, initialModel) -import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) -import Model.Payment exposing (Payments, paymentsDecoder, perPage) -import Model.Payer exposing (Payers, payersDecoder) -import Model.Translations exposing (..) -import Model.Config exposing (..) - -import Update exposing (Action(..), actions, updateModel) -import Update.SignIn exposing (..) - -import View.Page exposing (renderPage) - -import ServerCommunication exposing (serverCommunications, sendRequest) - -main : Signal Html -main = Signal.map renderPage model - -model : Signal Model -model = Signal.foldp updateModel (initialModel initialTime translations config) update - -update : Signal Action -update = Signal.mergeMany - [ Signal.map UpdateTime (Time.every 1000) - , actions.signal - ] - ---------------------------------------- - -port signInError : Maybe String - ---------------------------------------- - -port initialTime : Time - ---------------------------------------- - -port translations : String - ---------------------------------------- - -port config : String - ---------------------------------------- - -port initView : Task Http.Error () -port initView = - case signInError of - Just msg -> - Signal.send actions.address (SignInError msg) - Nothing -> - Task.onError goLoggedInView (\_ -> Signal.send actions.address GoSignInView) - -goLoggedInView : Task Http.Error () -goLoggedInView = - Task.andThen getUsers <| \users -> - Task.andThen whoAmI <| \me -> - Task.andThen getMonthlyPayments <| \monthlyPayments -> - Task.andThen getPayments <| \payments -> - Task.andThen getPaymentsCount <| \paymentsCount -> - Task.andThen getPayers <| \payers -> - Signal.send actions.address (GoLoggedInView users me monthlyPayments payments paymentsCount payers) - -getUsers : Task Http.Error Users -getUsers = Http.get usersDecoder "/users" - -whoAmI : Task Http.Error UserId -whoAmI = Http.get ("id" := userIdDecoder) "/whoAmI" - -getMonthlyPayments : Task Http.Error Payments -getMonthlyPayments = Http.get paymentsDecoder "/monthlyPayments" - -getPayments : Task Http.Error Payments -getPayments = Http.get paymentsDecoder ("/payments?page=1&perPage=" ++ toString perPage) - -getPaymentsCount : Task Http.Error Int -getPaymentsCount = Http.get ("number" := Json.int) "/payments/count" - -getPayers : Task Http.Error Payers -getPayers = Http.get payersDecoder "/payers" - ---------------------------------------- - -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/ServerCommunication.elm b/src/client/ServerCommunication.elm deleted file mode 100644 index 55bf947..0000000 --- a/src/client/ServerCommunication.elm +++ /dev/null @@ -1,143 +0,0 @@ -module ServerCommunication - ( Communication(..) - , sendRequest - , serverCommunications - ) where - -import Signal -import Task as Task exposing (Task) -import Http -import Json.Decode exposing (..) -import Date -import Time exposing (Time) - -import Model.User exposing (UserId) -import Model.Payment exposing (..) -import Model.View.LoggedIn.Add exposing (Frequency(..)) - -import Update as U -import Update.SignIn exposing (..) -import Update.LoggedIn as UL -import Update.LoggedIn.Monthly as UM -import Update.LoggedIn.Account as UA - -type Communication = - NoCommunication - | SignIn String - | AddPayment UserId String Int - | AddMonthlyPayment String Int - | SetIncome Time Int - | DeletePayment Payment Int - | DeleteMonthlyPayment PaymentId - | UpdatePage Int - | 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 - |> flip Task.andThen (serverResult communication) - -getRequest : Communication -> Maybe Http.Request -getRequest communication = - case communication of - NoCommunication -> Nothing - SignIn login -> Just (simple "post" ("/signIn?login=" ++ login)) - AddPayment userId name cost -> Just (addPaymentRequest name cost Punctual) - AddMonthlyPayment name cost -> Just (addPaymentRequest name cost Monthly) - SetIncome _ amount -> Just (simple "post" ("/income?amount=" ++ (toString amount))) - DeletePayment payment _ -> Just (deletePaymentRequest payment.id) - DeleteMonthlyPayment paymentId -> Just (deletePaymentRequest paymentId) - UpdatePage page -> Just (updatePageRequest page) - SignOut -> Just (simple "post" "/signOut") - -addPaymentRequest : String -> Int -> Frequency -> Http.Request -addPaymentRequest name cost frequency = - simple "post" ("/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency)) - -deletePaymentRequest : PaymentId -> Http.Request -deletePaymentRequest id = - simple "post" ("payment/delete?id=" ++ (toString id)) - -updatePageRequest : Int -> Http.Request -updatePageRequest page = - simple "get" ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage) - -simple : String -> String -> Http.Request -simple method url = - { verb = method - , headers = [] - , url = url - , body = Http.empty - } - -serverResult : Communication -> Http.Response -> Task Http.RawError U.Action -serverResult communication response = - case response.status of - 200 -> - case communication of - NoCommunication -> - Task.succeed U.NoOp - SignIn login -> - Task.succeed << U.UpdateSignIn <| ValidLogin login - AddPayment userId name cost -> - Http.send Http.defaultSettings (updatePageRequest 1) - |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments -> - Task.succeed <| U.UpdateLoggedIn (UL.AddPayment userId name cost payments) - )) - AddMonthlyPayment name cost -> - decodeResponse - ("id" := paymentIdDecoder) - (\id -> Task.succeed <| U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost)) - response - SetIncome currentTime amount -> - Task.succeed <| U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount)) - DeletePayment payment currentPage -> - Http.send Http.defaultSettings (updatePageRequest currentPage) - |> flip Task.andThen (decodeOkResponse paymentsDecoder (\payments -> - Task.succeed <| U.UpdateLoggedIn (UL.DeletePayment payment payments) - )) - DeleteMonthlyPayment id -> - Task.succeed <| U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id)) - UpdatePage page -> - decodeResponse - paymentsDecoder - (\payments -> Task.succeed <| U.UpdateLoggedIn (UL.UpdatePage page payments)) - response - SignOut -> - Task.succeed (U.GoSignInView) - errorStatus -> - case communication of - SignIn _ -> - decodeResponse - ("error" := string) - (\error -> - Task.succeed <| U.UpdateSignIn (ErrorLogin error) - ) - response - _ -> - Task.succeed <| U.NoOp - -decodeOkResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action -decodeOkResponse decoder responseToAction response = - if response.status == 200 - then decodeResponse decoder responseToAction response - else Task.succeed U.NoOp - -decodeResponse : Decoder a -> (a -> Task b U.Action) -> Http.Response -> Task b U.Action -decodeResponse decoder responseToAction response = - case response.value of - Http.Text text -> - case decodeString decoder text of - Ok x -> - responseToAction x - Err _ -> - Task.succeed U.NoOp - Http.Blob _ -> - Task.succeed U.NoOp diff --git a/src/client/elm/InitViewAction.elm b/src/client/elm/InitViewAction.elm new file mode 100644 index 0000000..7c353a7 --- /dev/null +++ b/src/client/elm/InitViewAction.elm @@ -0,0 +1,25 @@ +module InitViewAction + ( initViewAction + ) where + +import Task exposing (..) +import Http +import Json.Decode as Json exposing ((:=)) + +import Update exposing (Action(GoLoggedInView, GoSignInView)) + +import Model.Payment exposing (Payments, paymentsDecoder, perPage) +import Model.Payer exposing (Payers, payersDecoder) +import Model.User exposing (Users, usersDecoder, UserId, userIdDecoder) + +initViewAction : Task Http.Error Action +initViewAction = Task.onError loggedInView (always <| Task.succeed GoSignInView) + +loggedInView : Task Http.Error Action +loggedInView = + Task.map GoLoggedInView (Http.get usersDecoder "/users") + `Task.andMap` (Http.get ("id" := userIdDecoder) "/whoAmI") + `Task.andMap` (Http.get paymentsDecoder "/monthlyPayments") + `Task.andMap` (Http.get paymentsDecoder ("/payments?page=1&perPage=" ++ toString perPage)) + `Task.andMap` (Http.get ("number" := Json.int) "/payments/count") + `Task.andMap` (Http.get payersDecoder "/payers") diff --git a/src/client/elm/Main.elm b/src/client/elm/Main.elm new file mode 100644 index 0000000..f79d6a0 --- /dev/null +++ b/src/client/elm/Main.elm @@ -0,0 +1,89 @@ +module Main + ( main + ) where + +import Graphics.Element exposing (..) + +import Html exposing (Html) + +import Http +import Task exposing (..) +import Time exposing (..) +import Json.Decode as Json +import Dict +import String + +import Model exposing (Model, initialModel) +import Model.Translations exposing (..) +import Model.Config exposing (..) + +import Update exposing (Action(..), actions, updateModel) +import Update.SignIn exposing (..) + +import View.Page exposing (renderPage) + +import ServerCommunication as SC exposing (serverCommunications, sendRequest) + +import Persona as Persona exposing (operations) + +import InitViewAction exposing (initViewAction) + +import Sign + +main : Signal Html +main = Signal.map renderPage model + +model : Signal Model +model = Signal.foldp updateModel (initialModel initialTime translations config) update + +update : Signal Action +update = Signal.mergeMany + [ Signal.map UpdateTime (Time.every 1000) + , actions.signal + ] + +--------------------------------------- + +port initialTime : Time + +--------------------------------------- + +port translations : String + +--------------------------------------- + +port config : String + +--------------------------------------- + +port ready : Signal String +port ready = Signal.constant "ready" + +--------------------------------------- + +port initView : Task Http.Error () +port initView = initViewAction `Task.andThen` (Signal.send actions.address) + +--------------------------------------- + +port serverCommunicationsPort : Signal (Task Http.Error ()) +port serverCommunicationsPort = + Signal.map + (\comm -> + sendRequest comm + |> flip Task.andThen (\action -> Signal.send actions.address action) + ) + (Signal.merge signCommunication serverCommunications.signal) + +--------------------------------------- + +port persona : Signal String +port persona = Signal.map Persona.toString operations.signal + +--------------------------------------- + +port sign : Signal Json.Value + +signCommunication : Signal SC.Communication +signCommunication = + Signal.map (Sign.toServerCommunication << Sign.decodeOperation) sign diff --git a/src/client/Model.elm b/src/client/elm/Model.elm index 43a19c5..43a19c5 100644 --- a/src/client/Model.elm +++ b/src/client/elm/Model.elm diff --git a/src/client/Model/Config.elm b/src/client/elm/Model/Config.elm index e47b032..e47b032 100644 --- a/src/client/Model/Config.elm +++ b/src/client/elm/Model/Config.elm diff --git a/src/client/Model/Date.elm b/src/client/elm/Model/Date.elm index 1c56de4..1c56de4 100644 --- a/src/client/Model/Date.elm +++ b/src/client/elm/Model/Date.elm diff --git a/src/client/Model/Income.elm b/src/client/elm/Model/Income.elm index 97a5652..97a5652 100644 --- a/src/client/Model/Income.elm +++ b/src/client/elm/Model/Income.elm diff --git a/src/client/Model/Payer.elm b/src/client/elm/Model/Payer.elm index 9fd1bb5..9fd1bb5 100644 --- a/src/client/Model/Payer.elm +++ b/src/client/elm/Model/Payer.elm diff --git a/src/client/Model/Payment.elm b/src/client/elm/Model/Payment.elm index c4a8963..c4a8963 100644 --- a/src/client/Model/Payment.elm +++ b/src/client/elm/Model/Payment.elm diff --git a/src/client/Model/Translations.elm b/src/client/elm/Model/Translations.elm index bec8c9b..bec8c9b 100644 --- a/src/client/Model/Translations.elm +++ b/src/client/elm/Model/Translations.elm diff --git a/src/client/Model/User.elm b/src/client/elm/Model/User.elm index 1412913..1412913 100644 --- a/src/client/Model/User.elm +++ b/src/client/elm/Model/User.elm diff --git a/src/client/Model/View.elm b/src/client/elm/Model/View.elm index 90c0e53..90c0e53 100644 --- a/src/client/Model/View.elm +++ b/src/client/elm/Model/View.elm diff --git a/src/client/Model/View/LoggedIn/Account.elm b/src/client/elm/Model/View/LoggedIn/Account.elm index 2bb3ae7..2bb3ae7 100644 --- a/src/client/Model/View/LoggedIn/Account.elm +++ b/src/client/elm/Model/View/LoggedIn/Account.elm diff --git a/src/client/Model/View/LoggedIn/Add.elm b/src/client/elm/Model/View/LoggedIn/Add.elm index 5598084..5598084 100644 --- a/src/client/Model/View/LoggedIn/Add.elm +++ b/src/client/elm/Model/View/LoggedIn/Add.elm diff --git a/src/client/Model/View/LoggedIn/Edition.elm b/src/client/elm/Model/View/LoggedIn/Edition.elm index da6d7b0..da6d7b0 100644 --- a/src/client/Model/View/LoggedIn/Edition.elm +++ b/src/client/elm/Model/View/LoggedIn/Edition.elm diff --git a/src/client/Model/View/LoggedIn/Monthly.elm b/src/client/elm/Model/View/LoggedIn/Monthly.elm index 3c6f66a..3c6f66a 100644 --- a/src/client/Model/View/LoggedIn/Monthly.elm +++ b/src/client/elm/Model/View/LoggedIn/Monthly.elm diff --git a/src/client/Model/View/LoggedInView.elm b/src/client/elm/Model/View/LoggedInView.elm index 122c4be..122c4be 100644 --- a/src/client/Model/View/LoggedInView.elm +++ b/src/client/elm/Model/View/LoggedInView.elm diff --git a/src/client/Model/View/SignInView.elm b/src/client/elm/Model/View/SignInView.elm index 0fbce39..0fbce39 100644 --- a/src/client/Model/View/SignInView.elm +++ b/src/client/elm/Model/View/SignInView.elm diff --git a/src/client/Native/Reads.js b/src/client/elm/Native/Reads.js index 5785aed..5785aed 100644 --- a/src/client/Native/Reads.js +++ b/src/client/elm/Native/Reads.js diff --git a/src/client/elm/Persona.elm b/src/client/elm/Persona.elm new file mode 100644 index 0000000..51b5fc6 --- /dev/null +++ b/src/client/elm/Persona.elm @@ -0,0 +1,28 @@ +module Persona + ( Operation(..) + , operations + , fromString + , toString + ) where + +type Operation = + NoOp + | SignIn + | SignOut + +operations : Signal.Mailbox Operation +operations = Signal.mailbox NoOp + +fromString : String -> Operation +fromString str = + case str of + "SignIn" -> SignIn + "SignOut" -> SignOut + _ -> NoOp + +toString : Operation -> String +toString operation = + case operation of + SignIn -> "SignIn" + SignOut -> "SignOut" + _ -> "NoOp" diff --git a/src/client/Reads.elm b/src/client/elm/Reads.elm index f855802..f855802 100644 --- a/src/client/Reads.elm +++ b/src/client/elm/Reads.elm diff --git a/src/client/elm/ServerCommunication.elm b/src/client/elm/ServerCommunication.elm new file mode 100644 index 0000000..70612cb --- /dev/null +++ b/src/client/elm/ServerCommunication.elm @@ -0,0 +1,95 @@ +module ServerCommunication + ( Communication(..) + , sendRequest + , serverCommunications + ) where + +import Signal +import Task as Task exposing (Task) +import Http +import Json.Decode exposing (..) +import Date +import Time exposing (Time) +import Debug + +import SimpleHTTP exposing (..) + +import Model.User exposing (UserId) +import Model.Payment exposing (..) +import Model.View.LoggedIn.Add exposing (Frequency(..)) + +import Update as U +import Update.SignIn exposing (..) +import Update.LoggedIn as UL +import Update.LoggedIn.Monthly as UM +import Update.LoggedIn.Account as UA + +import InitViewAction exposing (initViewAction) + +type Communication = + NoCommunication + | SignIn String + | AddPayment UserId String Int + | AddMonthlyPayment String Int + | SetIncome Time Int + | DeletePayment Payment Int + | DeleteMonthlyPayment PaymentId + | UpdatePage Int + | SignOut + +serverCommunications : Signal.Mailbox Communication +serverCommunications = Signal.mailbox NoCommunication + +sendRequest : Communication -> Task Http.Error U.Action +sendRequest communication = + case communication of + + NoCommunication -> + Task.succeed U.NoOp + + SignIn assertion -> + post ("/signIn?assertion=" ++ assertion) + |> flip Task.andThen (always initViewAction) + + AddPayment userId name cost -> + post (addPaymentURL name cost Punctual) + |> flip Task.andThen (always (getPaymentsAtPage 1)) + |> Task.map (\payments -> U.UpdateLoggedIn (UL.AddPayment userId name cost payments)) + + AddMonthlyPayment name cost -> + post (addPaymentURL name cost Monthly) + |> flip Task.andThen (decodeHttpValue <| "id" := paymentIdDecoder) + |> Task.map (\id -> U.UpdateLoggedIn (UL.AddMonthlyPayment id name cost)) + + DeletePayment payment currentPage -> + post (deletePaymentURL payment.id) + |> flip Task.andThen (always (getPaymentsAtPage currentPage)) + |> Task.map (\payments -> U.UpdateLoggedIn (UL.DeletePayment payment payments)) + + DeleteMonthlyPayment id -> + post (deletePaymentURL id) + |> Task.map (always (U.UpdateLoggedIn (UL.UpdateMonthly (UM.DeletePayment id)))) + + UpdatePage page -> + getPaymentsAtPage page + |> flip Task.andThen (Task.succeed << U.UpdateLoggedIn << UL.UpdatePage page) + + SetIncome currentTime amount -> + post ("/income?amount=" ++ (toString amount)) + |> Task.map (always (U.UpdateLoggedIn (UL.UpdateAccount (UA.UpdateIncome currentTime amount)))) + + SignOut -> + post "/signOut" + |> Task.map (always U.GoSignInView) + +getPaymentsAtPage : Int -> Task Http.Error Payments +getPaymentsAtPage page = + Http.get paymentsDecoder ("payments?page=" ++ toString page ++ "&perPage=" ++ toString perPage) + +addPaymentURL : String -> Int -> Frequency -> String +addPaymentURL name cost frequency = + "/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost) ++ "&frequency=" ++ (toString frequency) + +deletePaymentURL : PaymentId -> String +deletePaymentURL id = + "payment/delete?id=" ++ (toString id) diff --git a/src/client/elm/Sign.elm b/src/client/elm/Sign.elm new file mode 100644 index 0000000..44f23b8 --- /dev/null +++ b/src/client/elm/Sign.elm @@ -0,0 +1,43 @@ +module Sign + ( Operation(..) + , decodeOperation + , toServerCommunication + ) where + +import Json.Decode as Json +import Json.Decode exposing (Value, Decoder, (:=)) +import Maybe + +import ServerCommunication as SC + +type Operation = + NoOp + | SignIn String + | SignOut + +decodeOperation : Value -> Operation +decodeOperation value = + Json.decodeValue operationDecoder value + |> Result.toMaybe + |> Maybe.withDefault NoOp + +toServerCommunication : Operation -> SC.Communication +toServerCommunication operation = + case operation of + NoOp -> SC.NoCommunication + SignIn assertion -> SC.SignIn assertion + SignOut -> SC.SignOut + +operationDecoder : Decoder Operation +operationDecoder = + ("operation" := Json.string) `Json.andThen` operationDecoderWithTag + +operationDecoderWithTag : String -> Decoder Operation +operationDecoderWithTag operation = + case operation of + "SignIn" -> + Json.map SignIn ("assertion" := Json.string) + "SignOut" -> + Json.succeed SignOut + _ -> + Json.succeed NoOp diff --git a/src/client/elm/SimpleHTTP.elm b/src/client/elm/SimpleHTTP.elm new file mode 100644 index 0000000..99a7056 --- /dev/null +++ b/src/client/elm/SimpleHTTP.elm @@ -0,0 +1,41 @@ +module SimpleHTTP + ( post + , decodeHttpValue + ) where + +import Http exposing (..) +import Task exposing (..) +import Json.Decode as Json exposing (Decoder) + +post : String -> Task Error Value +post url = + { verb = "POST" + , headers = [] + , url = url + , body = empty + } + |> Http.send defaultSettings + |> mapError promoteError + |> flip Task.andThen handleResponse + +handleResponse : Response -> Task Error Value +handleResponse response = + if 200 <= response.status && response.status < 300 + then Task.succeed response.value + else fail (BadResponse response.status response.statusText) + +promoteError : RawError -> Error +promoteError rawError = + case rawError of + RawTimeout -> Timeout + RawNetworkError -> NetworkError + +decodeHttpValue : Decoder a -> Value -> Task Error a +decodeHttpValue decoder value = + case value of + Text str -> + case Json.decodeString decoder str of + Ok v -> succeed v + Err msg -> fail (UnexpectedPayload msg) + _ -> + fail (UnexpectedPayload "Response body is a blob, expecting a string.") diff --git a/src/client/Update.elm b/src/client/elm/Update.elm index 3c4614a..3c4614a 100644 --- a/src/client/Update.elm +++ b/src/client/elm/Update.elm diff --git a/src/client/Update/LoggedIn.elm b/src/client/elm/Update/LoggedIn.elm index e477094..e477094 100644 --- a/src/client/Update/LoggedIn.elm +++ b/src/client/elm/Update/LoggedIn.elm diff --git a/src/client/Update/LoggedIn/Account.elm b/src/client/elm/Update/LoggedIn/Account.elm index cf4c834..cf4c834 100644 --- a/src/client/Update/LoggedIn/Account.elm +++ b/src/client/elm/Update/LoggedIn/Account.elm diff --git a/src/client/Update/LoggedIn/Add.elm b/src/client/elm/Update/LoggedIn/Add.elm index 1f28997..1f28997 100644 --- a/src/client/Update/LoggedIn/Add.elm +++ b/src/client/elm/Update/LoggedIn/Add.elm diff --git a/src/client/Update/LoggedIn/Monthly.elm b/src/client/elm/Update/LoggedIn/Monthly.elm index 1379323..1379323 100644 --- a/src/client/Update/LoggedIn/Monthly.elm +++ b/src/client/elm/Update/LoggedIn/Monthly.elm diff --git a/src/client/Update/SignIn.elm b/src/client/elm/Update/SignIn.elm index 0aa7c84..cabe4cb 100644 --- a/src/client/Update/SignIn.elm +++ b/src/client/elm/Update/SignIn.elm @@ -6,19 +6,10 @@ module Update.SignIn import Model.View.SignInView exposing (..) type SignInAction = - UpdateLogin String - | ValidLogin String - | ErrorLogin String + ErrorLogin String updateSignIn : SignInAction -> SignInView -> SignInView updateSignIn action signInView = case action of - UpdateLogin login -> - { signInView | login <- login } - ValidLogin message -> - { signInView - | login <- "" - , result <- Just (Ok message) - } ErrorLogin message -> { signInView | result <- Just (Err message) } diff --git a/src/client/Utils/Dict.elm b/src/client/elm/Utils/Dict.elm index dc01b17..dc01b17 100644 --- a/src/client/Utils/Dict.elm +++ b/src/client/elm/Utils/Dict.elm diff --git a/src/client/Utils/Either.elm b/src/client/elm/Utils/Either.elm index 10c40e3..10c40e3 100644 --- a/src/client/Utils/Either.elm +++ b/src/client/elm/Utils/Either.elm diff --git a/src/client/Utils/Maybe.elm b/src/client/elm/Utils/Maybe.elm index d954ae0..d954ae0 100644 --- a/src/client/Utils/Maybe.elm +++ b/src/client/elm/Utils/Maybe.elm diff --git a/src/client/Utils/Validation.elm b/src/client/elm/Utils/Validation.elm index b9bccb3..b9bccb3 100644 --- a/src/client/Utils/Validation.elm +++ b/src/client/elm/Utils/Validation.elm diff --git a/src/client/View/Date.elm b/src/client/elm/View/Date.elm index 81c5112..81c5112 100644 --- a/src/client/View/Date.elm +++ b/src/client/elm/View/Date.elm diff --git a/src/client/View/Events.elm b/src/client/elm/View/Events.elm index 1eb9027..1eb9027 100644 --- a/src/client/View/Events.elm +++ b/src/client/elm/View/Events.elm diff --git a/src/client/View/Expand.elm b/src/client/elm/View/Expand.elm index 53b4fe5..53b4fe5 100644 --- a/src/client/View/Expand.elm +++ b/src/client/elm/View/Expand.elm diff --git a/src/client/View/Header.elm b/src/client/elm/View/Header.elm index 9d31183..3a6241b 100644 --- a/src/client/View/Header.elm +++ b/src/client/elm/View/Header.elm @@ -6,8 +6,7 @@ import Html exposing (..) import Html.Attributes exposing (..) import Html.Events exposing (..) -import ServerCommunication as SC -import ServerCommunication exposing (serverCommunications) +import Persona exposing (operations) import Model exposing (Model) import Model.View exposing (..) @@ -26,11 +25,15 @@ renderHeader model = LoadingView -> text "" SignInView _ -> - text "" + button + [ class "icon" + , onClick operations.address Persona.SignIn + ] + [ renderIcon "sign-in" ] LoggedInView _ -> button - [ class "signOut" - , onClick serverCommunications.address SC.SignOut + [ class "icon" + , onClick operations.address Persona.SignOut ] - [ renderIcon "power-off" ] + [ renderIcon "sign-out" ] ] diff --git a/src/client/View/Icon.elm b/src/client/elm/View/Icon.elm index f22c1a2..f22c1a2 100644 --- a/src/client/View/Icon.elm +++ b/src/client/elm/View/Icon.elm diff --git a/src/client/View/Loading.elm b/src/client/elm/View/Loading.elm index f8c6cd6..f8c6cd6 100644 --- a/src/client/View/Loading.elm +++ b/src/client/elm/View/Loading.elm diff --git a/src/client/View/LoggedIn.elm b/src/client/elm/View/LoggedIn.elm index 96916e0..96916e0 100644 --- a/src/client/View/LoggedIn.elm +++ b/src/client/elm/View/LoggedIn.elm diff --git a/src/client/View/LoggedIn/Account.elm b/src/client/elm/View/LoggedIn/Account.elm index 706f7cc..706f7cc 100644 --- a/src/client/View/LoggedIn/Account.elm +++ b/src/client/elm/View/LoggedIn/Account.elm diff --git a/src/client/View/LoggedIn/Add.elm b/src/client/elm/View/LoggedIn/Add.elm index 572bdf6..572bdf6 100644 --- a/src/client/View/LoggedIn/Add.elm +++ b/src/client/elm/View/LoggedIn/Add.elm diff --git a/src/client/View/LoggedIn/Monthly.elm b/src/client/elm/View/LoggedIn/Monthly.elm index a274015..a274015 100644 --- a/src/client/View/LoggedIn/Monthly.elm +++ b/src/client/elm/View/LoggedIn/Monthly.elm diff --git a/src/client/View/LoggedIn/Paging.elm b/src/client/elm/View/LoggedIn/Paging.elm index 93d7f1d..93d7f1d 100644 --- a/src/client/View/LoggedIn/Paging.elm +++ b/src/client/elm/View/LoggedIn/Paging.elm diff --git a/src/client/View/LoggedIn/Table.elm b/src/client/elm/View/LoggedIn/Table.elm index f5a08b5..f5a08b5 100644 --- a/src/client/View/LoggedIn/Table.elm +++ b/src/client/elm/View/LoggedIn/Table.elm diff --git a/src/client/View/Page.elm b/src/client/elm/View/Page.elm index 763734d..763734d 100644 --- a/src/client/View/Page.elm +++ b/src/client/elm/View/Page.elm diff --git a/src/client/View/Price.elm b/src/client/elm/View/Price.elm index 286bcaa..286bcaa 100644 --- a/src/client/View/Price.elm +++ b/src/client/elm/View/Price.elm diff --git a/src/client/View/SignIn.elm b/src/client/elm/View/SignIn.elm index 2a6cbca..8fcac16 100644 --- a/src/client/View/SignIn.elm +++ b/src/client/elm/View/SignIn.elm @@ -24,18 +24,7 @@ renderSignIn : Model -> SignInView -> Html renderSignIn model signInView = div [ class "signIn" ] - [ H.form - [ onSubmitPrevDefault serverCommunications.address (SC.SignIn signInView.login) ] - [ input - [ value signInView.login - , on "input" targetValue (Signal.message actions.address << UpdateSignIn << UpdateLogin) - ] - [] - , button - [] - [ text (getMessage "SignIn" model.translations)] - ] - , div + [ div [ class "result" ] [ signInResult model signInView ] ] diff --git a/src/client/js/main.js b/src/client/js/main.js new file mode 100644 index 0000000..12593e6 --- /dev/null +++ b/src/client/js/main.js @@ -0,0 +1,28 @@ +var app = Elm.fullscreen(Elm.Main, { + initialTime: new Date().getTime(), + translations: document.getElementById('messages').innerHTML, + config: document.getElementById('config').innerHTML, + sign: null +}); + +navigator.id.watch({ + loggedInUser: null, + onlogin: function(assertion) { + app.ports.sign.send({ + operation: 'SignIn', + assertion: assertion + }); + }, + onlogout: function() {} +}); + +app.ports.persona.subscribe(function(communication) { + if(communication === 'SignIn') { + navigator.id.request(); + } else if(communication === 'SignOut') { + navigator.id.logout(); + app.ports.sign.send({ + operation: 'SignOut' + }); + } +}); |