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
|
module Form.Input
( inputText,
inputNumber,
inputUnion,
TypeName(..),
Type(..)
)
where
import Control.Applicative
import Control.Arrow (first, second)
import Data.Map qualified as M
import Form.Internal
import Miso
import Miso.String (MisoString, fromMisoString, null, strip, toMisoString)
data TypeName = StringType | NumberType
deriving (Eq, Ord)
data Type = IsNumber Double | IsString MisoString
inputUnion :: MisoString -> [TypeName] -> Form (TypeName, M.Map TypeName MisoString) (Maybe Type)
inputUnion label types =
foldl1 (<|>)
<$> mapM
( \case
StringType ->
mapValues
( \(selectedType, typeInputs) ->
( selectedType == StringType,
M.findWithDefault "" StringType typeInputs
)
)
( \(checked, inputString) (selectedType, typeInputs) ->
( if checked then StringType else selectedType,
M.insert StringType inputString typeInputs
)
)
$ fmap (fmap IsString)
$ withRadio
$ inputText label
NumberType ->
mapValues
( \(selectedType, typeInputs) ->
( selectedType == NumberType,
M.findWithDefault "" NumberType typeInputs
)
)
( \(checked, inputString) (selectedType, typeInputs) ->
( if checked then NumberType else selectedType,
M.insert NumberType inputString typeInputs
)
)
$ fmap (fmap IsNumber)
$ withRadio
$ inputNumber label
)
types
radio :: Form Bool Bool
radio =
Form
{ view = \checked ->
[ div_ [] $
[ input_
[ type_ "radio",
checked_ checked,
onClick (not checked)
]
]
],
fill = Right
}
withRadio :: Form i o -> Form (Bool, i) (Maybe o)
withRadio form =
(\(checked, x) -> if checked then Just x else Nothing)
<$> liftA2
(,)
(mapValues fst (first . const) radio)
(mapValues snd (second . const) form)
inputNumber :: MisoString -> Form MisoString Double
inputNumber label =
let parse :: MisoString -> Either MisoString Double
parse i =
let i' = strip i
in if Miso.String.null i' then Left "required" else Right (read (fromMisoString i'))
in Form
{ view = \i ->
[ div_ [] $
[ label_ [] $
[ text label,
div_ [] $
[ input_
[ type_ "number",
value_ (toMisoString (show i)),
onInput id
],
div_ [] $
[either text (\_ -> text "") (parse i)]
]
]
]
],
fill = parse
}
inputText :: MisoString -> Form MisoString MisoString
inputText label =
let parse :: MisoString -> Either MisoString MisoString
parse i =
let i' = strip i
in if Miso.String.null i' then Left "required" else Right i'
in Form
{ view = \i ->
[ div_ [] $
[ label_ [] $
[ text label,
div_ [] $
[ input_
[ type_ "text",
value_ i,
onInput id
],
div_ [] $
[either text (\_ -> text "") (parse i)]
]
]
]
],
fill = parse
}
|
