aboutsummaryrefslogtreecommitdiff
path: root/src/client
diff options
context:
space:
mode:
Diffstat (limited to 'src/client')
-rw-r--r--src/client/Main.elm35
-rw-r--r--src/client/Model.elm8
-rw-r--r--src/client/Model/Message.elm8
-rw-r--r--src/client/Model/View/PaymentView.elm10
-rw-r--r--src/client/Native/Reads.js27
-rw-r--r--src/client/Reads.elm10
-rw-r--r--src/client/ServerCommunication.elm17
-rw-r--r--src/client/Update.elm13
-rw-r--r--src/client/Update/Payment.elm20
-rw-r--r--src/client/View/Events.elm19
-rw-r--r--src/client/View/Payments/Add.elm20
-rw-r--r--src/client/View/SignIn.elm17
12 files changed, 155 insertions, 49 deletions
diff --git a/src/client/Main.elm b/src/client/Main.elm
index 678d20e..fd0cec7 100644
--- a/src/client/Main.elm
+++ b/src/client/Main.elm
@@ -10,9 +10,11 @@ import Html exposing (Html)
import Http
import Task exposing (..)
+import Time exposing (..)
import Model exposing (Model, initialModel)
import Model.Payment exposing (Payments, paymentsDecoder)
+import Model.Message exposing (messageDecoder)
import Update exposing (Action(..), actions, updateModel)
import Update.SignIn exposing (..)
@@ -27,34 +29,41 @@ main : Signal Html
main = Signal.map renderPage model
model : Signal Model
-model = Signal.foldp updateModel initialModel actions.signal
+model = Signal.foldp updateModel (initialModel initialTime) update
--------------------------
+update : Signal Action
+update = Signal.mergeMany
+ [ Signal.map UpdateTime (Time.every 30)
+ , actions.signal
+ ]
+
+---------------------------------------
port signInError : Maybe String
---------------------------------------
-port fetchPayments : Task Http.Error ()
-port fetchPayments =
+port initialTime : Time
+
+---------------------------------------
+
+port initView : Task Http.Error ()
+port initView =
case signInError of
Just msg ->
Signal.send actions.address (SignInError msg)
Nothing ->
- getPayments
- |> flip Task.andThen reportSuccess
- |> flip Task.onError reportError
-
-reportSuccess : Payments -> Task x ()
-reportSuccess payments = Signal.send actions.address (GoPaymentView payments)
+ Task.map2 GoPaymentView getUserName getPayments
+ |> flip Task.andThen (Signal.send actions.address)
+ |> flip Task.onError (\_ -> Signal.send actions.address GoSignInView)
-reportError : Http.Error -> Task x ()
-reportError error = Signal.send actions.address GoSignInView
+getUserName : Task Http.Error String
+getUserName = Http.get messageDecoder "/userName"
getPayments : Task Http.Error Payments
getPayments = Http.get paymentsDecoder "/payments"
----------------------------------------------------
+---------------------------------------
port serverCommunicationsPort : Signal (Task Http.RawError ())
port serverCommunicationsPort =
diff --git a/src/client/Model.elm b/src/client/Model.elm
index 8005429..45fdf87 100644
--- a/src/client/Model.elm
+++ b/src/client/Model.elm
@@ -3,13 +3,17 @@ module Model
, initialModel
) where
+import Time exposing (Time)
+
import Model.View exposing (..)
type alias Model =
{ view : View
+ , currentTime : Time
}
-initialModel : Model
-initialModel =
+initialModel : Time -> Model
+initialModel initialTime =
{ view = LoadingView
+ , currentTime = initialTime
}
diff --git a/src/client/Model/Message.elm b/src/client/Model/Message.elm
new file mode 100644
index 0000000..9f21fd3
--- /dev/null
+++ b/src/client/Model/Message.elm
@@ -0,0 +1,8 @@
+module Model.Message
+ ( messageDecoder
+ ) where
+
+import Json.Decode exposing (..)
+
+messageDecoder : Decoder String
+messageDecoder = ("message" := string)
diff --git a/src/client/Model/View/PaymentView.elm b/src/client/Model/View/PaymentView.elm
index cea7d2e..8de005d 100644
--- a/src/client/Model/View/PaymentView.elm
+++ b/src/client/Model/View/PaymentView.elm
@@ -6,14 +6,16 @@ module Model.View.PaymentView
import Model.Payment exposing (Payments)
type alias PaymentView =
- { name : String
+ { userName : String
+ , name : String
, cost : String
, payments : Payments
}
-initPaymentView : Payments -> PaymentView
-initPaymentView payments =
- { name = ""
+initPaymentView : String -> Payments -> PaymentView
+initPaymentView userName payments =
+ { userName = userName
+ , name = ""
, cost = ""
, payments = payments
}
diff --git a/src/client/Native/Reads.js b/src/client/Native/Reads.js
new file mode 100644
index 0000000..52590f9
--- /dev/null
+++ b/src/client/Native/Reads.js
@@ -0,0 +1,27 @@
+Elm.Native.Reads = {};
+Elm.Native.Reads.make = function(localRuntime) {
+
+ localRuntime.Native = localRuntime.Native || {};
+ localRuntime.Native.Reads = localRuntime.Native.Reads || {};
+ if(localRuntime.Native.Reads.values) {
+ return localRuntime.Native.Reads.values;
+ }
+
+ var Result = Elm.Result.make(localRuntime);
+
+ function div(a, b)
+ {
+ return (a/b)|0;
+ }
+
+ function readInt(str) {
+ var number = Number(str);
+ return isNaN(number)
+ ? Result.Err("unable to parse '" + str + "' as a number")
+ : Result.Ok(number);
+ }
+
+ return localRuntime.Native.Reads.values = {
+ readInt: readInt
+ };
+};
diff --git a/src/client/Reads.elm b/src/client/Reads.elm
new file mode 100644
index 0000000..7bc1bbc
--- /dev/null
+++ b/src/client/Reads.elm
@@ -0,0 +1,10 @@
+module Reads
+ ( readInt
+ ) where
+
+
+import Native.Reads
+import Result exposing (Result)
+
+readInt : String -> Result String Int
+readInt = Native.Reads.readInt
diff --git a/src/client/ServerCommunication.elm b/src/client/ServerCommunication.elm
index d763e29..ccf63f2 100644
--- a/src/client/ServerCommunication.elm
+++ b/src/client/ServerCommunication.elm
@@ -5,18 +5,21 @@ module ServerCommunication
) where
import Signal
-import Task
-import Task exposing (Task)
+import Task as Task exposing (Task)
import Http
import Json.Decode exposing (..)
+import Date
+
+import Model.Message exposing (messageDecoder)
import Update as U
import Update.SignIn exposing (..)
+import Update.Payment as UP
type Communication =
NoCommunication
| SignIn String
- | AddPayment String String
+ | AddPayment String Int
| SignOut
serverCommunications : Signal.Mailbox Communication
@@ -47,7 +50,7 @@ getRequest communication =
Just
{ verb = "post"
, headers = []
- , url = "/payment/add?name=" ++ name ++ "&cost=" ++ cost
+ , url = "/payment/add?name=" ++ name ++ "&cost=" ++ (toString cost)
, body = Http.empty
}
SignOut ->
@@ -67,8 +70,8 @@ communicationToAction communication response =
U.NoOp
SignIn login ->
U.UpdateSignIn (ValidLogin login)
- AddPayment _ _ ->
- U.NoOp
+ AddPayment name cost ->
+ U.UpdatePayment (UP.AddPayment name cost)
SignOut ->
U.GoSignInView
else
@@ -86,7 +89,7 @@ decodeResponse : Http.Response -> (String -> U.Action) -> U.Action
decodeResponse response responseToAction =
case response.value of
Http.Text text ->
- case decodeString ("message" := string) text of
+ case decodeString messageDecoder text of
Ok x ->
responseToAction x
Err _ ->
diff --git a/src/client/Update.elm b/src/client/Update.elm
index f88a3a2..be7538a 100644
--- a/src/client/Update.elm
+++ b/src/client/Update.elm
@@ -4,6 +4,8 @@ module Update
, updateModel
) where
+import Time exposing (Time)
+
import Model exposing (Model)
import Model.Payment exposing (Payments)
import Model.View as V
@@ -15,10 +17,11 @@ import Update.Payment exposing (..)
type Action =
NoOp
+ | UpdateTime Time
| GoSignInView
| SignInError String
| UpdateSignIn SignInAction
- | GoPaymentView Payments
+ | GoPaymentView String Payments
| UpdatePayment PaymentAction
actions : Signal.Mailbox Action
@@ -29,10 +32,12 @@ updateModel action model =
case action of
NoOp ->
model
+ UpdateTime time ->
+ { model | currentTime <- time }
GoSignInView ->
{ model | view <- V.SignInView initSignInView }
- GoPaymentView payments ->
- { model | view <- V.PaymentView (initPaymentView payments) }
+ GoPaymentView userName payments ->
+ { model | view <- V.PaymentView (initPaymentView userName payments) }
SignInError msg ->
let signInView = { initSignInView | result <- Just (Err msg) }
in { model | view <- V.SignInView signInView }
@@ -45,6 +50,6 @@ updateModel action model =
UpdatePayment paymentAction ->
case model.view of
V.PaymentView paymentView ->
- { model | view <- V.PaymentView (updatePayment paymentAction paymentView) }
+ { model | view <- V.PaymentView (updatePayment model paymentAction paymentView) }
_ ->
model
diff --git a/src/client/Update/Payment.elm b/src/client/Update/Payment.elm
index 129ccde..136f0f9 100644
--- a/src/client/Update/Payment.elm
+++ b/src/client/Update/Payment.elm
@@ -3,6 +3,9 @@ module Update.Payment
, updatePayment
) where
+import Date
+
+import Model exposing (Model)
import Model.View.PaymentView exposing (..)
import Model.Payment exposing (..)
@@ -10,9 +13,10 @@ type PaymentAction =
UpdateName String
| UpdateCost String
| UpdatePayments Payments
+ | AddPayment String Int
-updatePayment : PaymentAction -> PaymentView -> PaymentView
-updatePayment action paymentView =
+updatePayment : Model -> PaymentAction -> PaymentView -> PaymentView
+updatePayment model action paymentView =
case action of
UpdateName name ->
{ paymentView | name <- name }
@@ -20,3 +24,15 @@ updatePayment action paymentView =
{ paymentView | cost <- cost }
UpdatePayments payments ->
{ paymentView | payments <- payments }
+ AddPayment name cost ->
+ let payment =
+ { creation = Date.fromTime model.currentTime
+ , name = name
+ , cost = cost
+ , userName = paymentView.userName
+ }
+ in { paymentView
+ | payments <- payment :: paymentView.payments
+ , name <- ""
+ , cost <- ""
+ }
diff --git a/src/client/View/Events.elm b/src/client/View/Events.elm
new file mode 100644
index 0000000..1eb9027
--- /dev/null
+++ b/src/client/View/Events.elm
@@ -0,0 +1,19 @@
+module View.Events
+ ( onSubmitPrevDefault
+ ) where
+
+import Signal
+import Json.Decode as Json
+import Html exposing (..)
+import Html.Events exposing (..)
+import Html.Attributes exposing (..)
+
+onSubmitPrevDefault : Signal.Address a -> a -> Attribute
+onSubmitPrevDefault address value =
+ onWithOptions
+ "submit"
+ { defaultOptions | preventDefault <- True }
+ Json.value
+ (\_ ->
+ Signal.message address value
+ )
diff --git a/src/client/View/Payments/Add.elm b/src/client/View/Payments/Add.elm
index f2230be..32010ef 100644
--- a/src/client/View/Payments/Add.elm
+++ b/src/client/View/Payments/Add.elm
@@ -2,20 +2,28 @@ module View.Payments.Add
( addPayment
) where
-import Html exposing (..)
+import Html as H exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
+import Reads exposing (readInt)
+import Result exposing (..)
-import ServerCommunication as SC
-import ServerCommunication exposing (serverCommunications)
+import ServerCommunication as SC exposing (serverCommunications)
import Update exposing (..)
import Update.Payment exposing (..)
+import View.Events exposing (onSubmitPrevDefault)
+
addPayment : String -> String -> Html
addPayment name cost =
- div
- [ class "add" ]
+ H.form
+ [ class "add"
+ , onSubmitPrevDefault serverCommunications.address
+ <| case readInt cost of
+ Ok number -> SC.AddPayment name number
+ Err _ -> SC.NoCommunication
+ ]
[ text "Name"
, input
[ value name
@@ -29,6 +37,6 @@ addPayment name cost =
]
[]
, button
- [ onClick serverCommunications.address (SC.AddPayment name cost) ]
+ [ type' "submit" ]
[ text "Add" ]
]
diff --git a/src/client/View/SignIn.elm b/src/client/View/SignIn.elm
index 02ee1bd..a45adc7 100644
--- a/src/client/View/SignIn.elm
+++ b/src/client/View/SignIn.elm
@@ -2,7 +2,7 @@ module View.SignIn
( renderSignIn
) where
-import Html exposing (..)
+import Html as H exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
@@ -16,20 +16,21 @@ import ServerCommunication exposing (serverCommunications)
import Model.View.SignInView exposing (..)
+import View.Events exposing (onSubmitPrevDefault)
+
renderSignIn : SignInView -> Html
renderSignIn signInView =
div
[ class "signIn" ]
- [ div
- [ class "form" ]
+ [ H.form
+ [ onSubmitPrevDefault serverCommunications.address (SC.SignIn signInView.login) ]
[ 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
@@ -37,12 +38,6 @@ renderSignIn signInView =
[ 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
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-06 10:14:22 +0000