@@ -14,18 +14,16 @@ import qualified Data.Set as Set
1414import Data.Dependent.Sum (DSum (..))
1515import Control.Monad.Trans
1616import Control.Monad.Reader
17−import Control.Monad.State
18−import Control.Monad.Ref
17+import Control.Monad.State hiding (state)
1918import GHCJS.DOM.Node
2019import GHCJS.DOM.UIEvent
21−import GHCJS.DOM.EventM (event, Signal, EventM)
20+import GHCJS.DOM.EventM (event, EventM)
2221import GHCJS.DOM.Document
2322import GHCJS.DOM.Element
2423import GHCJS.DOM.HTMLElement
2524import GHCJS.DOM.Types hiding (Widget (..), unWidget, Event)
2625import GHCJS.DOM.NamedNodeMap
27−import Control.Lens
28−import Data.Monoid
26+import Control.Lens hiding (element, children)
2927import Data.These
3028import Data.Align
3129
@@ -121,7 +119,7 @@ dyn child = do
121119 runFrameWithTriggerRef newChildBuiltTriggerRef (result, voidActions)
122120 postBuild
123121 Just p <- liftIO $ nodeGetParentNode endPlaceholder
124− liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
122+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
125123 return ()
126124 schedulePostBuild $ do
127125 c <- sample $ current child
@@ -151,7 +149,7 @@ widgetHold child0 newChild = do
151149 case mp of
152150 Nothing -> return () --TODO: Is this right?
153151 Just p -> do
154− liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
152+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
155153 return ()
156154 return ()
157155 addVoidAction $ ffor newChild $ \c -> do
@@ -163,7 +161,6 @@ widgetHold child0 newChild = do
163161listWithKey :: (Ord k, MonadWidget t m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
164162listWithKey vals mkChild = do
165163 doc <- askDocument
166− startPlaceholder <- text' ""
167164 endPlaceholder <- text' ""
168165 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef
169166 performEvent_ $ fmap (const $ return ()) newChildren --TODO: Get rid of this hack
@@ -182,9 +179,9 @@ listWithKey vals mkChild = do
182179 (result, postBuild, voidAction) <- buildChild df k v
183180 return ((result, voidAction), postBuild)
184181 runFrameWithTriggerRef newChildrenTriggerRef $ fmap fst initialState --TODO: Do all these in a single runFrame
185− sequence $ fmap snd initialState
182+ sequence_ $ fmap snd initialState
186183 Just p <- liftIO $ nodeGetParentNode endPlaceholder
187− liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
184+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
188185 return ()
189186 addVoidAction $ flip fmap (updated vals) $ \newVals -> do
190187 curState <- sample children
@@ -202,7 +199,7 @@ listWithKey vals mkChild = do
202199 Nothing -> endPlaceholder
203200 Just (_, ((_, (start, _)), _)) -> start
204201 Just p <- liftIO $ nodeGetParentNode placeholder
205− liftIO $ nodeInsertBefore p (Just df) (Just placeholder)
202+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just placeholder)
206203 return $ Just s
207204 These state _ -> do
208205 return $ Just state
@@ -213,7 +210,6 @@ listWithKey vals mkChild = do
213210listWithKey' :: forall t m k v a. (Ord k, MonadWidget t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))
214211listWithKey' initialVals valsChanged mkChild = do
215212 doc <- askDocument
216− startPlaceholder <- text' ""
217213 endPlaceholder <- text' ""
218214 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef
219215-- performEvent_ $ fmap (const $ return ()) newChildren --TODO: Get rid of this hack
@@ -226,12 +222,12 @@ listWithKey' initialVals valsChanged mkChild = do
226222 result <- mkChild k v $ select childValChangedSelector $ Const2 k
227223 childEnd <- text' ""
228224 return (result, (childStart, childEnd))
229− Just df <- liftIO $ documentCreateDocumentFragment doc
230− initialState <- iforM initialVals $ \k v -> subWidgetWithVoidActions (toNode df) $ wrapChild k v --Note: we have to use subWidgetWithVoidActions rather than runWidget here, because running post-build actions during build can cause not-yet-constructed values to be read
225+ Just dfOrig <- liftIO $ documentCreateDocumentFragment doc
226+ initialState <- iforM initialVals $ \k v -> subWidgetWithVoidActions (toNode dfOrig) $ wrapChild k v --Note: we have to use subWidgetWithVoidActions rather than runWidget here, because running post-build actions during build can cause not-yet-constructed values to be read
231227 children <- holdDyn initialState newChildren
232228 addVoidAction $ switch $ fmap (mergeWith (>>) . map snd . Map.elems) $ current children
233− Just p <- liftIO $ nodeGetParentNode endPlaceholder
234− liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
229+ Just pOrig <- liftIO $ nodeGetParentNode endPlaceholder
230+ _ <- liftIO $ nodeInsertBefore pOrig (Just dfOrig) (Just endPlaceholder)
235231 addVoidAction $ flip fmap valsChanged $ \newVals -> do
236232 curState <- sample $ current children
237233 --TODO: Should we remove the parent from the DOM first to avoid reflows?
@@ -246,7 +242,7 @@ listWithKey' initialVals valsChanged mkChild = do
246242 let s = (childResult, childVoidAction)
247243 modify (>>childPostBuild)
248244 Just p <- liftIO $ nodeGetParentNode end
249− liftIO $ nodeInsertBefore p (Just df) (Just end)
245+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just end)
250246 return $ Just s
251247 That Nothing -> return Nothing -- Deleting non-existent child
252248 That (Just v) -> do -- Creating new child
@@ -258,7 +254,7 @@ listWithKey' initialVals valsChanged mkChild = do
258254 Nothing -> endPlaceholder
259255 Just (_, ((_, (start, _)), _)) -> start
260256 Just p <- liftIO $ nodeGetParentNode placeholder
261− liftIO $ nodeInsertBefore p (Just df) (Just placeholder)
257+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just placeholder)
262258 return $ Just s
263259 This state -> do -- No change
264260 return $ Just state
@@ -273,7 +269,6 @@ listViewWithKey vals mkChild = liftM (switch . fmap mergeMap) $ listViewWithKey'
273269listViewWithKey' :: (Ord k, MonadWidget t m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m a) -> m (Behavior t (Map k a))
274270listViewWithKey' vals mkChild = do
275271 doc <- askDocument
276− startPlaceholder <- text' ""
277272 endPlaceholder <- text' ""
278273 (newChildren, newChildrenTriggerRef) <- newEventWithTriggerRef
279274 performEvent_ $ fmap (const $ return ()) newChildren --TODO: Get rid of this hack
@@ -292,9 +287,9 @@ listViewWithKey' vals mkChild = do
292287 (result, postBuild, voidAction) <- buildChild df k v
293288 return ((result, voidAction), postBuild)
294289 runFrameWithTriggerRef newChildrenTriggerRef $ fmap fst initialState --TODO: Do all these in a single runFrame
295− sequence $ fmap snd initialState
290+ sequence_ $ fmap snd initialState
296291 Just p <- liftIO $ nodeGetParentNode endPlaceholder
297− liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
292+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just endPlaceholder)
298293 return ()
299294 addVoidAction $ flip fmap (updated vals) $ \newVals -> do
300295 curState <- sample children
@@ -312,7 +307,7 @@ listViewWithKey' vals mkChild = do
312307 Nothing -> endPlaceholder
313308 Just (_, ((_, (start, _)), _)) -> start
314309 Just p <- liftIO $ nodeGetParentNode placeholder
315− liftIO $ nodeInsertBefore p (Just df) (Just placeholder)
310+ _ <- liftIO $ nodeInsertBefore p (Just df) (Just placeholder)
316311 return $ Just s
317312 These state _ -> do
318313 return $ Just state
@@ -336,6 +331,7 @@ selectViewListWithKey_ selection vals mkChild = do
336331--------------------------------------------------------------------------------
337332
338333-- | s and e must both be children of the same node and s must precede e
334+deleteBetweenExclusive :: (IsNode start, IsNode end) => start -> end -> IO ()
339335deleteBetweenExclusive s e = do
340336 mCurrentParent <- nodeGetParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment
341337 case mCurrentParent of
@@ -344,19 +340,21 @@ deleteBetweenExclusive s e = do
344340 let go = do
345341 Just x <- nodeGetPreviousSibling e -- This can't be Nothing because we should hit 's' first
346342 when (unNode (toNode s) /= unNode (toNode x)) $ do
347− nodeRemoveChild currentParent $ Just x
343+ _ <- nodeRemoveChild currentParent $ Just x
348344 go
349345 go
350346
351347-- | s and e must both be children of the same node and s must precede e
348+deleteBetweenInclusive :: (IsNode start, IsNode end) => start -> end -> IO ()
352349deleteBetweenInclusive s e = do
353350 Just currentParent <- nodeGetParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment
354351 let go = do
355352 Just x <- nodeGetPreviousSibling e -- This can't be Nothing because we should hit 's' first
356− nodeRemoveChild currentParent $ Just x
353+ _ <- nodeRemoveChild currentParent $ Just x
357354 when (unNode (toNode s) /= unNode (toNode x)) go
358355 go
359− nodeRemoveChild currentParent $ Just e
356+ _ <- nodeRemoveChild currentParent $ Just e
357+ return ()
360358
361359--------------------------------------------------------------------------------
362360-- Adapters
@@ -398,7 +396,7 @@ elAttr elementTag attrs child = do
398396
399397{-# INLINABLE el' #-}
400398el' :: forall t m a. MonadWidget t m => String -> m a -> m (El t, a)
401−el' tag child = elAttr' tag (Map.empty :: AttributeMap) child
399+el' elementTag child = elAttr' elementTag (Map.empty :: AttributeMap) child
402400
403401{-# INLINABLE elAttr' #-}
404402elAttr' :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m (El t, a)
@@ -415,15 +413,16 @@ elDynAttr elementTag attrs child = do
415413
416414{-# INLINABLE el #-}
417415el :: forall t m a. MonadWidget t m => String -> m a -> m a
418−el tag child = elAttr tag Map.empty child
416+el elementTag child = elAttr elementTag Map.empty child
419417
420418elClass :: forall t m a. MonadWidget t m => String -> String -> m a -> m a
421−elClass tag c child = elAttr tag ("class" =: c) child
419+elClass elementTag c child = elAttr elementTag ("class" =: c) child
422420
423421--------------------------------------------------------------------------------
424422-- Copied and pasted from Reflex.Widget.Class
425423--------------------------------------------------------------------------------
426424
425+list :: (MonadWidget t m, Ord k) => Dynamic t (Map k v) -> (Dynamic t v -> m a) -> m (Dynamic t (Map k a))
427426list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)
428427
429428elDynHtml' :: MonadWidget t m => String -> Dynamic t String -> m (El t)
@@ -492,7 +491,7 @@ tableDynAttr :: forall t m r k v. (MonadWidget t m, Show k, Ord k) => String ->
492491tableDynAttr klass cols dRows rowAttrs = elAttr "div" (Map.singleton "style" "zoom: 1; overflow: auto; background: white;") $ do
493492 elAttr "table" (Map.singleton "class" klass) $ do
494493 el "thead" $ el "tr" $ do
495− mapM (\(h, _) -> el "th" $ text h) cols
494+ mapM_ (\(h, _) -> el "th" $ text h) cols
496495 el "tbody" $ do
497496 listWithKey dRows (\k r -> do
498497 dAttrs <- rowAttrs k
@@ -508,7 +507,7 @@ tabDisplay ulClass activeClass tabItems = do
508507 holdDyn Nothing $ fmap Just eTabClicks :: m (Dynamic t (Maybe k))
509508 divClass "" $ do
510509 let dTabs :: Dynamic t (Map k (String, m ())) = constDyn tabItems
511− listWithKey dTabs (\k dTab -> do
510+ _ <- listWithKey dTabs (\k dTab -> do
512511 dAttrs <- mapDyn (\sel -> do
513512 let t1 = listToMaybe $ Map.keys tabItems
514513 if sel == Just k || (sel == Nothing && t1 == Just k) then Map.empty else Map.singleton "style" "display:none;") dCurrentTab
@@ -526,5 +525,5 @@ tabDisplay ulClass activeClass tabItems = do
526525unsafePlaceElement :: MonadWidget t m => HTMLElement -> m (El t)
527526unsafePlaceElement e = do
528527 p <- askParent
529− liftIO $ nodeAppendChild p $ Just e
528+ _ <- liftIO $ nodeAppendChild p $ Just e
530529 wrapElement e