aboutsummaryrefslogtreecommitdiff
path: root/src/client
diff options
context:
space:
mode:
Diffstat (limited to 'src/client')
-rw-r--r--src/client/Main.elm101
-rw-r--r--src/client/ServerCommunication.elm143
-rw-r--r--src/client/elm/InitViewAction.elm25
-rw-r--r--src/client/elm/Main.elm89
-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.elm28
-rw-r--r--src/client/elm/Reads.elm (renamed from src/client/Reads.elm)0
-rw-r--r--src/client/elm/ServerCommunication.elm95
-rw-r--r--src/client/elm/Sign.elm43
-rw-r--r--src/client/elm/SimpleHTTP.elm41
-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.js28
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'
+ });
+ }
+});