-
Notifications
You must be signed in to change notification settings - Fork 0
/
Pux.purs
209 lines (180 loc) · 5.91 KB
/
Pux.purs
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
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
module Study.Pux where
import Batteries hiding ((#))
import Data.Array as Arr
import Data.List (List(Nil), (:))
import Data.List.Zipper (Zipper(Zipper), up, down)
import Pux (renderToDOM, fromSimple, start)
import Pux.Html (Html)
import Pux.Html as H
import Pux.Html ((#), (##), (!))
import Pux.Html.Attributes as A
import Pux.Html.Events as E
import Signal.Channel (CHANNEL)
import Global as G
import Grade
type State = Zipper Grade
data Action
= Child Int Action
| UpdateWeight Int Number
| UpdateScore (Score Number)
| AddGrade
| Undo
| Redo
infixr 9 compose as ..
view :: State -> H.Html Action
view s@(Zipper _ g _) = H.div # do
H.text (show s)
viewGrade g
H.button ! E.onClick (const Undo) # H.text "Undo"
H.button ! E.onClick (const Redo) # H.text "Redo"
H.span # changeType g
where
bind = H.bind
viewGrade :: Grade -> Html Action
viewGrade g@(OutOf a b) = H.div # do
H.span # changeType g
H.label # do
H.text "Points: "
H.input
[ A.value (show a)
, A.type_ "number"
, E.onChange (UpdateScore .. (_ `OutOf` b) .. eventNumber)
] []
H.label # do
H.text "Out of: "
H.input
[ A.value (show b)
, A.type_ "number"
, E.onChange (UpdateScore .. OutOf a .. eventNumber)
] []
where
bind = H.bind
viewGrade g@(Percent n) = H.div # do
H.span # changeType g
H.label # do
H.text "Percent: "
H.input
[ A.value (show n)
, E.onChange (UpdateScore .. Percent .. eventNumber)
] []
where
bind = H.bind
viewGrade g@(Weighted grades) = H.div # do
H.span # changeType g
H.p # H.text "Weighted Grade Set:"
H.ul # do
H.li # H.text ("This score: " <> show (getScore g))
H.button ! E.onClick (const AddGrade) # H.text "Add Grade"
H.ul ##
forEachIndexed grades \i (Tuple w g) ->
H.li # do
H.label # do
H.text "Weight: "
H.input
[ A.value (show w)
, E.onChange (UpdateWeight i .. eventNumber)
] []
H.forwardTo (Child i) (viewGrade g)
where
bind = H.bind
viewGrade g@(Average grades) = H.div # do
H.p # H.text "Grade Set:"
H.ul # do
H.li # H.text ("This score: " <> show (getScore g))
H.li # do
H.div # renderScore grades
where
bind = H.bind
emptyScore :: String -> Score Number
emptyScore string
| string == "Percent" = Percent 100.0
| string == "OutOf" = OutOf 10.0 10.0
| string == "Average" = Average []
| string == "Weighted" = Weighted []
| otherwise = Average []
renderScore :: Array (Score Number) -> Html Action
renderScore gs = H.div # do
H.button ! E.onClick (const AddGrade) # H.text "Add Grade"
H.ul ##
forEachIndexed gs \i g ->
H.li # (H.forwardTo (Child i) (viewGrade g))
where
bind = H.bind
scoreToLabel :: forall a. Score a -> String
scoreToLabel s =
case s of
OutOf _ _ -> "OutOf"
Percent _ -> "Percent"
Average _ -> "Average"
Weighted _ -> "Weighted"
changeType :: Grade -> Html Action
changeType grade = H.label # do
H.text "Change Type: "
H.select
! A.value (scoreToLabel grade)
! E.onChange (\o -> UpdateScore (emptyScore o.target.value))
## forEach ["OutOf", "Percent", "Average", "Weighted"] \label ->
H.option ! A.value label # H.text label
where
bind = H.bind
single :: forall a. a -> Zipper a
single a = Zipper Nil a Nil
eventNumber :: forall r t. { target :: { value :: String | r } | t } -> Number
eventNumber o = G.readFloat o.target.value
pushPast :: forall a. a -> Zipper a -> Zipper a
pushPast a (Zipper p c f) = Zipper (c:p) a f
editToPast :: forall a. (a -> a) -> Zipper a -> Zipper a
editToPast g (Zipper p a f) = Zipper (a : p) (g a) f
editFocus :: forall a. (a -> a) -> Zipper a -> Zipper a
editFocus g (Zipper p a f) = Zipper p (g a) f
update :: Action -> State -> State
update Redo state = fromMaybe state $ down state
update Undo state = fromMaybe state $ up state
update (UpdateWeight i n) state =
case state of
Zipper _ (Weighted gs) _ ->
pushPast (Weighted (modMaybe i (\(Tuple w s) -> Tuple n s) gs)) state
_ ->
state
update (Child i a) state =
case state of
Zipper _ (Average gs) _ ->
pushPast
(Average (map extract .. modMaybe i (update a) .. map single $ gs))
state
Zipper _ (Weighted gs) _ ->
pushPast
(Weighted (map (map extract)
.. modMaybe i (map (update a))
.. map (map single)
$ gs))
state
g ->
state
update (UpdateScore s) state =
pushPast s state
update AddGrade state =
case state of
Zipper _ (Average gs) _ ->
pushPast (Average (gs `Arr.snoc` Percent 1.0)) state
Zipper _ (Weighted gs) _ ->
pushPast (Weighted (gs `Arr.snoc` Tuple 1.0 (Percent 1.0))) state
_ ->
state
modMaybe :: forall a. Int -> (a -> a) -> Array a -> Array a
modMaybe i f xs = fromMaybe xs (Arr.modifyAt i f xs)
mapIndexed :: forall a b. (Int -> a -> b) -> Array a -> Array b
mapIndexed f xs = map (uncurry f) (Arr.zip (Arr.range 0 (Arr.length xs)) xs)
forEachIndexed :: forall a b. Array b -> (Int -> b -> a) -> Array a
forEachIndexed = flip mapIndexed
forEach :: forall f a b. (Functor f) => f a -> (a -> b) -> f b
forEach = flip map
ui :: forall e. Eff ( err :: EXCEPTION , channel :: CHANNEL | e ) Unit
ui = do
app <- start
{ initialState: Zipper Nil ex Nil
, update: fromSimple update
, inputs: []
, view: view
}
renderToDOM "#app" app.html