blob: 8c9935f8477abf2fcf5adb6e79fb862d8925bd42 (
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
|
module Form.Internal
( Form (..),
mapValues,
runForm,
)
where
import Miso
data Form i o = Form
{ view :: i -> [View i],
fill :: i -> Either String o
}
instance Functor (Form i) where
fmap f (Form {view, fill}) =
Form
{ fill = fmap f . fill,
..
}
instance Applicative (Form i) where
pure x =
Form
{ view = const [],
fill = const (Right x)
}
f <*> x =
Form
{ view = liftA2 (<>) f.view x.view,
fill = \i -> ($) <$> f.fill i <*> x.fill i
}
instance Monad (Form i) where
form >>= mkForm =
Form
{ view = \i ->
form.view i
<> case form.fill i of
Right x -> (mkForm x).view i
Left _ -> [],
fill = \i -> case form.fill i of
Right x -> (mkForm x).fill i
Left e -> Left e
}
mapValues :: (i' -> i) -> (i -> i' -> i') -> Form i o -> Form i' o
mapValues get set (Form {view, fill}) =
Form
{ view = \i -> fmap (flip set i) <$> view (get i),
fill = fill . get
}
runForm :: Form i o -> i -> View (Either i o)
runForm form i =
form_ [onSubmit (either (\_ -> Left i) (Right) (form.fill i))] $
(fmap Left <$> form.view i)
<> [button_ [type_ "submit"] [text "submit"]]
|
