blob: 55bf94739cb4500f94a1b23f62f2c775fdafea5c (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
|
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
|
