@@ -30,6 +30,7 @@ api = Proxy
31main :: IO ()
31main :: IO ()
32main = mainWidget $ do
32main = mainWidget $ do
33+ el "h1" $ text "Wowzers!"
33 divClass "example-base" run
34 divClass "example-base" run
34 divClass "example-multi" runMulti
35 divClass "example-multi" runMulti
@@ -64,9 +65,9 @@ runMulti = do
64 grts <- fmap (fmap T.words . value) $ divClass "" $ do
65 grts <- fmap (fmap T.words . value) $ divClass "" $ do
65 text "Greetings"
66 text "Greetings"
66 textInput def
67 textInput def
67− gust <- fmap (value) $ divClass "gusto-input" $ checkbox False def
68+ gust <- fmap value $ divClass "gusto-input" $ checkbox False def
68 b <- button "Go"
69 b <- button "Go"
69− r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) $ grts) (constDyn [True, False]) (1 <$ b)
70+ r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) grts) (constDyn [True, False]) (1 <$ b)
71 dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes . fmap reqSuccess <$> r')
72 dynText =<< holdDyn "Waiting" (T.pack . show . catMaybes . fmap reqSuccess <$> r')
@@ -103,11 +104,11 @@ run = mdo
103 unitResponse <- getUnit $ tag (current reqCount) unitBtn
104 unitResponse <- getUnit $ tag (current reqCount) unitBtn
104 intResponse :: Event t (ReqResult Int Int) <- getInt $ tag (current reqCount) intBtn
105 intResponse :: Event t (ReqResult Int Int) <- getInt $ tag (current reqCount) intBtn
106− score <- foldDyn (+) 0 (fmapMaybe reqSuccess (intResponse))
107+ score <- foldDyn (+) 0 (fmapMaybe reqSuccess intResponse)
108− r <- holdDyn "Waiting" $ fmap showXhrResponse $
109+ r <- holdDyn "Waiting" $ showXhrResponse <$>
109− leftmost [fmapMaybe response (unitResponse)
110+ leftmost [fmapMaybe response unitResponse
110− ,fmapMaybe response (intResponse)
111+ ,fmapMaybe response intResponse
112 divClass "unit-int-response" $ el "p" $ dynText r >> el "br" (return ()) >> text "Total: " >> display score
113 divClass "unit-int-response" $ el "p" $ dynText r >> el "br" (return ()) >> text "Total: " >> display score
113 return (unitBtn, intBtn)
114 return (unitBtn, intBtn)
@@ -116,14 +117,14 @@ run = mdo
117 text "Name"
118 text "Name"
118 el "br" $ return ()
119 el "br" $ return ()
119− inp :: Dynamic t Text <- fmap value $ divClass "name-input" $ (textInput def)
120+ inp :: Dynamic t Text <- fmap value $ divClass "name-input" $ textInput def
120 let checkedName = fmap (\i -> bool (QParamSome i) (QParamInvalid "Need a name") (T.null i)) inp
121 let checkedName = fmap (\i -> bool (QParamSome i) (QParamInvalid "Need a name") (T.null i)) inp
121 el "br" $ return ()
122 el "br" $ return ()
123 text "Greetings (space-separated)"
124 text "Greetings (space-separated)"
124 el "br" $ return ()
125 el "br" $ return ()
125 greetings <- fmap (fmap T.words . value) $
126 greetings <- fmap (fmap T.words . value) $
126− divClass "greetings-input" $ (textInput def)
127+ divClass "greetings-input" $ textInput def
128 el "br" $ return ()
129 el "br" $ return ()
@@ -135,23 +136,23 @@ run = mdo
136 resp <- sayhi checkedName greetings gusto (tag (current reqCount) triggers)
137 resp <- sayhi checkedName greetings gusto (tag (current reqCount) triggers)
137 divClass "greeting-response" $ dynText =<<
138 divClass "greeting-response" $ dynText =<<
138− holdDyn "No hi yet" (leftmost [ fmapMaybe reqSuccess (resp)
139+ holdDyn "No hi yet" (leftmost [ fmapMaybe reqSuccess resp
139− , fmapMaybe reqFailure (resp)])
140+ , fmapMaybe reqFailure resp])
140 return sayHiClicks
141 return sayHiClicks
142 dblBtn <- elClass "div" "demo-group" $ do
143 dblBtn <- elClass "div" "demo-group" $ do
143 text "A Double to double"
144 text "A Double to double"
144 el "br" $ return ()
145 el "br" $ return ()
145 dblinp <- fmap value $ divClass "double-input" $ textInput def
146 dblinp <- fmap value $ divClass "double-input" $ textInput def
146− (dblBtn) <- divClass "double-button" $ button "Double it"
147+ dblBtn <- divClass "double-button" $ button "Double it"
147− dblResp <- dbl (fmap (note "read failure" . readMaybe . T.unpack) $
148+ dblResp <- dbl ((note "read failure" . readMaybe . T.unpack) <$>
148 dblinp) (tag (current reqCount) dblBtn)
149 dblinp) (tag (current reqCount) dblBtn)
149 divClass "double-errors" $ dynText =<<
150 divClass "double-errors" $ dynText =<<
150− holdDyn "(no errors)" (fmapMaybe reqFailure (dblResp))
151+ holdDyn "(no errors)" (fmapMaybe reqFailure dblResp)
151 el "br" (return ())
152 el "br" (return ())
152 divClass "double-result" $ el "p" $ dynText =<<
153 divClass "double-result" $ el "p" $ dynText =<<
153− holdDyn "No number yet" (fmap tShow $
154+ holdDyn "No number yet" (tShow <$>
154− fmapMaybe reqSuccess (dblResp))
155+ fmapMaybe reqSuccess dblResp)
155 return dblBtn
156 return dblBtn
157 mpGo <- elClass "div" "demo-group" $ do
158 mpGo <- elClass "div" "demo-group" $ do
@@ -159,9 +160,9 @@ run = mdo
159 b <- value <$> checkbox False def
160 b <- value <$> checkbox False def
160 mpGo <- button "Test"
161 mpGo <- button "Test"
161 multiResp <- multi b (tag (current reqCount) mpGo)
162 multiResp <- multi b (tag (current reqCount) mpGo)
162− dynText =<< holdDyn "No res yet" (fmap tShow $
163+ dynText =<< holdDyn "No res yet" (tShow <$>
163− fmapMaybe reqSuccess $
164+ fmapMaybe reqSuccess
164− (multiResp))
165+ multiResp)
165 return mpGo
166 return mpGo
167 return ()
168 return ()
@@ -171,7 +172,7 @@ run = mdo
171 elClass "div" "demo-group" $ do
172 elClass "div" "demo-group" $ do
172 text "JSON Unicode encoding test"
173 text "JSON Unicode encoding test"
173 txt <- value <$> textInput def
174 txt <- value <$> textInput def
174− ev <- fmap (1 <$) $ button "Question"
175+ ev <- (1 <$) <$> button "Question"
175 let dQ = Right . Question <$> traceDyn "will send: " txt
176 let dQ = Right . Question <$> traceDyn "will send: " txt
176 rr <- qna dQ ev
177 rr <- qna dQ ev