@@ -35,9 +35,22 @@ import Data.GADT.Compare.TH
3535import Data.Bitraversable
3636import GHCJS.DOM.MouseEvent
3737import Data.IORef
38+import Data.Default
3839
3940type AttributeMap = Map String String
4041
42+data ElConfig attrs
43+ = ElConfig { _elConfig_namespace :: Maybe String
44+ , _elConfig_attributes :: attrs
45+ }
46+
47+makeLenses ''ElConfig
48+
49+instance (attrs ~ Map String String) => Default (ElConfig attrs) where
50+ def = ElConfig { _elConfig_namespace = Nothing
51+ , _elConfig_attributes = Map.empty
52+ }
53+
4154data El t
4255 = El { _el_element :: Element
4356 , _el_events :: EventSelector t (WrapArg EventResult EventName)
@@ -588,50 +601,69 @@ wrapElement e = do
588601 es <- wrapDomEventsMaybe e $ defaultDomEventHandler e
589602 return $ El e es
590603
604+{-# INLINABLE elStopPropagationNS #-}
591605elStopPropagationNS :: (MonadWidget t m, IsEvent (EventType en)) => Maybe String -> String -> EventName en -> m a -> m a
592606elStopPropagationNS mns elementTag evt child = do
593607 (e, result) <- buildElementNS mns elementTag (Map.empty :: Map String String) child
594608 liftIO $ onEventName evt e stopPropagation
595609 return result
596610
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
611+{-# INLINABLE elWith #-}
612+elWith :: (MonadWidget t m, Attributes m attrs) => String -> ElConfig attrs -> m a -> m a
613+elWith elementTag cfg child = do
614+ (_, result) <- buildElementNS (cfg ^. namespace) elementTag (cfg ^. attributes) child
615+ return result
616+
617+{-# INLINABLE elWith' #-}
618+elWith' :: (MonadWidget t m, Attributes m attrs) => String -> ElConfig attrs -> m a -> m (El t, a)
619+elWith' elementTag cfg child = do
620+ (e, result) <- buildElementNS (cfg ^. namespace) elementTag (cfg ^. attributes) child
600621 e' <- wrapElement e
601622 return (e', result)
602623
624+{-# INLINABLE emptyElWith #-}
625+emptyElWith :: (MonadWidget t m, Attributes m attrs) => String -> ElConfig attrs -> m ()
626+emptyElWith elementTag cfg = do
627+ _ <- buildEmptyElementNS (cfg ^. namespace) elementTag (cfg ^. attributes)
628+ return ()
629+
630+{-# INLINABLE emptyElWith' #-}
631+emptyElWith' :: (MonadWidget t m, Attributes m attrs) => String -> ElConfig attrs -> m (El t)
632+emptyElWith' elementTag cfg = do
633+ wrapElement =<< buildEmptyElementNS (cfg ^. namespace) elementTag (cfg ^. attributes)
634+
635+{-# INLINABLE elDynAttrNS' #-}
636+elDynAttrNS' :: forall t m a. MonadWidget t m => Maybe String -> String -> Dynamic t (Map String String) -> m a -> m (El t, a)
637+elDynAttrNS' mns elementTag attrs = elWith' elementTag $
638+ def & namespace .~ mns
639+ & elConfig_attributes .~ attrs
640+
641+{-# INLINABLE elDynAttr' #-}
603642elDynAttr' :: forall t m a. MonadWidget t m => String -> Dynamic t (Map String String) -> m a -> m (El t, a)
604−elDynAttr' = elDynAttrNS' Nothing
643+elDynAttr' elementTag attrs = elWith' elementTag $ def & elConfig_attributes .~ attrs
605644
606645{-# INLINABLE elAttr #-}
607646elAttr :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m a
608−elAttr elementTag attrs child = do
609− (_, result) <- buildElement elementTag attrs child
610− return result
647+elAttr elementTag attrs = elWith elementTag $ def & attributes .~ attrs
611648
612649{-# INLINABLE el' #-}
613650el' :: forall t m a. MonadWidget t m => String -> m a -> m (El t, a)
614−el' elementTag child = elAttr' elementTag (Map.empty :: AttributeMap) child
651+el' elementTag = elWith' elementTag def
615652
616653{-# INLINABLE elAttr' #-}
617654elAttr' :: forall t m a. MonadWidget t m => String -> Map String String -> m a -> m (El t, a)
618−elAttr' elementTag attrs child = do
619− (e, result) <- buildElement elementTag attrs child
620− e' <- wrapElement e
621− return (e', result)
655+elAttr' elementTag attrs = elWith' elementTag $ def & attributes .~ attrs
622656
623657{-# INLINABLE elDynAttr #-}
624658elDynAttr :: forall t m a. MonadWidget t m => String -> Dynamic t (Map String String) -> m a -> m a
625−elDynAttr elementTag attrs child = do
626− (_, result) <- buildElement elementTag attrs child
627− return result
659+elDynAttr elementTag attrs = elWith elementTag $ def & elConfig_attributes .~ attrs
628660
629661{-# INLINABLE el #-}
630662el :: forall t m a. MonadWidget t m => String -> m a -> m a
631−el elementTag child = elAttr elementTag Map.empty child
663+el elementTag = elWith elementTag def
632664
633665elClass :: forall t m a. MonadWidget t m => String -> String -> m a -> m a
634−elClass elementTag c child = elAttr elementTag ("class" =: c) child
666+elClass elementTag c = elWith elementTag $ def & attributes .~ "class" =: c
635667
636668--------------------------------------------------------------------------------
637669-- Copied and pasted from Reflex.Widget.Class
@@ -666,6 +698,20 @@ data Link t
666698 = Link { _link_clicked :: Event t ()
667699 }
668700
701+class HasAttributes a where
702+ type Attrs a :: *
703+ attributes :: Lens' a (Attrs a)
704+
705+instance HasAttributes (ElConfig attrs) where
706+ type Attrs (ElConfig attrs) = attrs
707+ attributes = elConfig_attributes
708+
709+class HasNamespace a where
710+ namespace :: Lens' a (Maybe String)
711+
712+instance HasNamespace (ElConfig attrs) where
713+ namespace = elConfig_namespace
714+
669715class HasDomEvent t a where
670716 domEvent :: EventName en -> a -> Event t (EventResultType en)
671717