on develop help sign in
Some preliminary svg stuff
commite082a7a2ba4d6ec7cc286b1908e14539fc2a5b62 authorRyan Trinkle <ryan.trinkle@gmail.com> dateWed 2 Sep 2015, 04:50 (11 years ago) parent5dac8ae
1 file changed+37−18
src/Reflex/Dom/Widget/Basic.hs+37−18
src/Reflex/Dom/Widget/Basic.hs+37−18
@@ -21,7 +21,7 @@ import Control.Monad.Reader hiding (mapM, mapM_, forM, forM_, sequence, sequence
2121import Control.Monad.State hiding (state, mapM, mapM_, forM, forM_, sequence, sequence_)
2222import GHCJS.DOM.Node
2323import GHCJS.DOM.UIEvent
24−import GHCJS.DOM.EventM (event, EventM)
24+import GHCJS.DOM.EventM (event, EventM, stopPropagation)
2525import GHCJS.DOM.Document
2626import GHCJS.DOM.Element
2727import GHCJS.DOM.HTMLElement
@@ -39,7 +39,7 @@ import Data.IORef
3939type AttributeMap = Map String String
4040
4141data El t
42− = El { _el_element :: HTMLElement
42+ = El { _el_element :: Element
4343 , _el_events :: EventSelector t (WrapArg EventResult EventName)
4444 }
4545
@@ -59,22 +59,30 @@ instance MonadWidget t m => Attributes m (Dynamic t AttributeMap) where
5959 forM_ (Set.toList $ oldAttrs `Set.difference` Map.keysSet newAttrs) $ elementRemoveAttribute e
6060 imapM_ (elementSetAttribute e) newAttrs --TODO: avoid re-setting unchanged attributes; possibly do the compare using Align in haskell
6161
62−buildEmptyElement :: (MonadWidget t m, Attributes m attrs) => String -> attrs -> m HTMLElement
63−buildEmptyElement elementTag attrs = do
62+buildEmptyElementNS :: (MonadWidget t m, Attributes m attrs) => Maybe String -> String -> attrs -> m Element
63+buildEmptyElementNS mns elementTag attrs = do
6464 doc <- askDocument
6565 p <- askParent
66− Just e <- liftIO $ documentCreateElement doc elementTag
66+ Just e <- liftIO $ case mns of
67+ Nothing -> documentCreateElement doc elementTag
68+ Just ns -> documentCreateElementNS doc ns elementTag
6769 addAttributes attrs e
6870 _ <- liftIO $ nodeAppendChild p $ Just e
69− return $ castToHTMLElement e
71+ return $ castToElement e
72+
73+buildEmptyElement :: (MonadWidget t m, Attributes m attrs) => String -> attrs -> m Element
74+buildEmptyElement = buildEmptyElementNS Nothing
7075
7176-- We need to decide what type of attrs we've got statically, because it will often be a recursively defined value, in which case inspecting it will lead to a cycle
72−buildElement :: (MonadWidget t m, Attributes m attrs) => String -> attrs -> m a -> m (HTMLElement, a)
73−buildElement elementTag attrs child = do
74− e <- buildEmptyElement elementTag attrs
77+buildElementNS :: (MonadWidget t m, Attributes m attrs) => Maybe String -> String -> attrs -> m a -> m (Element, a)
78+buildElementNS mns elementTag attrs child = do
79+ e <- buildEmptyElementNS mns elementTag attrs
7580 result <- subWidget (toNode e) child
7681 return (e, result)
7782
83+buildElement :: (MonadWidget t m, Attributes m attrs) => String -> attrs -> m a -> m (Element, a)
84+buildElement = buildElementNS Nothing
85+
7886namedNodeMapGetNames :: IsNamedNodeMap self => self -> IO (Set String)
7987namedNodeMapGetNames self = do
8088 l <- namedNodeMapGetLength self
@@ -575,17 +583,26 @@ defaultDomEventHandler e evt = liftM (Just . EventResult) $ case evt of
575583 Blur -> return ()
576584 Change -> return ()
577585
578−wrapElement :: forall t h m. (Functor (Event t), MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => HTMLElement -> m (El t)
586+wrapElement :: forall t h m. (Functor (Event t), MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => Element -> m (El t)
579587wrapElement e = do
580588 es <- wrapDomEventsMaybe e $ defaultDomEventHandler e
581589 return $ El e es
582590
583−elDynAttr' :: forall t m a. MonadWidget t m => String -> Dynamic t (Map String String) -> m a -> m (El t, a)
584−elDynAttr' elementTag attrs child = do
585− (e, result) <- buildElement elementTag attrs child
591+elStopPropagationNS :: (MonadWidget t m, EventClass (EventType en)) => Maybe String -> String -> EventName en -> m a -> m a
592+elStopPropagationNS mns elementTag evt child = do
593+ (e, result) <- buildElementNS mns elementTag (Map.empty :: Map String String) child
594+ liftIO $ onEventName evt e stopPropagation
595+ return result
596+
597+elDynAttrNS' :: forall t m a. MonadWidget t m => Maybe String -> String -> Dynamic t (Map String String) -> m a -> m (El t, a)
598+elDynAttrNS' mns elementTag attrs child = do
599+ (e, result) <- buildElementNS mns elementTag attrs child
586600 e' <- wrapElement e
587601 return (e', result)
588602
603+elDynAttr' :: forall t m a. MonadWidget t m => String -> Dynamic t (Map String String) -> m a -> m (El t, a)
604+elDynAttr' = elDynAttrNS' Nothing
605+
589606{-# INLINABLE elAttr #-}
590607elAttr :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m a
591608elAttr elementTag attrs child = do
@@ -632,15 +649,17 @@ simpleList xs mkChild = mapDyn (map snd . Map.toList) =<< flip list mkChild =<<
632649elDynHtml' :: MonadWidget t m => String -> Dynamic t String -> m (El t)
633650elDynHtml' elementTag html = do
634651 e <- buildEmptyElement elementTag (Map.empty :: Map String String)
635− schedulePostBuild $ liftIO . htmlElementSetInnerHTML e =<< sample (current html)
636− addVoidAction $ fmap (liftIO . htmlElementSetInnerHTML e) $ updated html
652+ let h = castToHTMLElement e
653+ schedulePostBuild $ liftIO . htmlElementSetInnerHTML h =<< sample (current html)
654+ addVoidAction $ fmap (liftIO . htmlElementSetInnerHTML h) $ updated html
637655 wrapElement e
638656
639657elDynHtmlAttr' :: MonadWidget t m => String -> Map String String -> Dynamic t String -> m (El t)
640658elDynHtmlAttr' elementTag attrs html = do
641659 e <- buildEmptyElement elementTag attrs
642− schedulePostBuild $ liftIO . htmlElementSetInnerHTML e =<< sample (current html)
643− addVoidAction $ fmap (liftIO . htmlElementSetInnerHTML e) $ updated html
660+ let h = castToHTMLElement e
661+ schedulePostBuild $ liftIO . htmlElementSetInnerHTML h =<< sample (current html)
662+ addVoidAction $ fmap (liftIO . htmlElementSetInnerHTML h) $ updated html
644663 wrapElement e
645664
646665data Link t
@@ -738,7 +757,7 @@ tabDisplay ulClass activeClass tabItems = do
738757 return $ fmap (const k) (_link_clicked a)
739758
740759-- | Place an element into the DOM and wrap it with Reflex event handlers. Note: undefined behavior may result if the element is placed multiple times, removed from the DOM after being placed, or in other situations. Don't use this unless you understand the internals of MonadWidget.
741−unsafePlaceElement :: MonadWidget t m => HTMLElement -> m (El t)
760+unsafePlaceElement :: MonadWidget t m => Element -> m (El t)
742761unsafePlaceElement e = do
743762 p <- askParent
744763 _ <- liftIO $ nodeAppendChild p $ Just e