reflex-dom 0.1.1 → 0.2

raw patch · 10 files changed

+348/−51 lines, 10 filesdep +bifunctorsdep +dependent-sum-templatedep +directorydep ~lensdep ~reflexdep ~thesePVP ok

version bump matches the API change (PVP)

Dependencies added: bifunctors, dependent-sum-template, directory, exception-transformers

Dependency ranges changed: lens, reflex, these

API changes (from Hackage documentation)

Files

• reflex-dom.cabal +14/−7
• src-ghc/Reflex/Dom/Internal/Foreign.hs +18/−4
• src-ghc/Reflex/Dom/Xhr/Foreign.hs +8/−11
• src/Reflex/Dom/Class.hs +3/−2
• src/Reflex/Dom/Internal.hs +16/−8
• src/Reflex/Dom/Time.hs +2/−1
• src/Reflex/Dom/Widget/Basic.hs +273/−12
• src/Reflex/Dom/Widget/Input.hs +8/−4
• src/Reflex/Dom/Widget/Lazy.hs +2/−2
• src/Reflex/Dom/Xhr.hs +4/−0

@@ -1,15 +1,16 @@ Name: reflex-dom-Version: 0.1.1-Synopsis: Glitch-free Functional Reactive Web Apps+Version: 0.2+Synopsis: Functional Reactive Web Apps with Reflex Description: Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine License: BSD3 License-file: LICENSE Author: Ryan Trinkle Maintainer: ryan.trinkle@gmail.com Stability: Experimental-Category: FRP+Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface Build-type: Simple Cabal-version: >=1.9.2+-- Deal with https://github.com/haskell/cabal/issues/2544 / https://github.com/haskell/cabal/issues/367 extra-source-files: src-ghc/Reflex/Dom/Internal/Foreign.hs                     src-ghc/Reflex/Dom/Xhr/Foreign.hs                     src-ghcjs/Reflex/Dom/Internal/Foreign.hs@@ -19,7 +20,7 @@   hs-source-dirs: src   build-depends:     base >= 4.7 && < 4.9,-    reflex == 0.2.*,+    reflex == 0.3.*,     dependent-sum == 0.2.*,     dependent-map == 0.1.*,     semigroups == 0.16.*,@@ -35,7 +36,11 @@     bytestring == 0.10.*,     data-default == 0.5.*,     aeson == 0.8.*,-    time == 1.5.*+    time == 1.5.*,+    exception-transformers == 0.4.*,+    directory == 1.2.*,+    dependent-sum-template >= 0.0.0.4 && < 0.1,+    bifunctors == 4.2.*    if impl(ghcjs)     hs-source-dirs: src-ghcjs@@ -49,7 +54,6 @@       gtk3 == 0.13.*,       webkitgtk3 == 0.13.*,       webkitgtk3-javascriptcore == 0.13.*-  -- Deal with https://github.com/haskell/cabal/issues/2544 / https://github.com/haskell/cabal/issues/367    exposed-modules:     Reflex.Dom@@ -66,5 +70,8 @@     Reflex.Dom.Xhr.Foreign    other-extensions: TemplateHaskell-  ghc-prof-options: -fprof-auto   ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2++source-repository head+  type: git+  location: https://github.com/ryantrinkle/reflex

@@ -1,3 +1,4 @@+{-# LANGUAGE ForeignFunctionInterface #-} module Reflex.Dom.Internal.Foreign where  import GHCJS.DOM hiding (runWebGUI)@@ -10,7 +11,10 @@ import Graphics.UI.Gtk.WebKit.Types hiding (Event, Widget, unWidget) import Graphics.UI.Gtk.WebKit.WebSettings import Graphics.UI.Gtk.WebKit.WebFrame+import Graphics.UI.Gtk.WebKit.WebInspector import Data.List+import Data.String+import System.Directory  makeDefaultWebView :: String -> (WebView -> IO ()) -> IO () makeDefaultWebView userAgentKey main = do@@ -25,6 +29,7 @@   userAgent <- settings `get` webSettingsUserAgent   settings `set` [ webSettingsUserAgent := userAgent ++ " " ++ userAgentKey                  , webSettingsEnableUniversalAccessFromFileUris := True+                 , webSettingsEnableDeveloperExtras := True                  ]   webViewSetWebSettings webView settings   window `containerAdd` scrollWin@@ -32,10 +37,20 @@   _ <- on window objectDestroy . liftIO $ mainQuit   widgetShowAll window   _ <- webView `on` loadFinished $ \_ -> do-    main webView+    main webView --TODO: Should probably only do this once+  inspector <- webViewGetInspector webView+  _ <- inspector `on` inspectWebView $ \wv -> do+    inspectorWindow <- windowNew+    windowSetDefaultSize inspectorWindow 900 600+    inspectorScrollWin <- scrolledWindowNew Nothing Nothing+    inspectorWebView <- webViewNew+    inspectorWindow `containerAdd` inspectorScrollWin+    inspectorScrollWin `containerAdd` inspectorWebView+    widgetShowAll inspectorWindow+    return inspectorWebView   wf <- webViewGetMainFrame webView-  webFrameLoadString wf "" Nothing "file:///"-  main webView+  pwd <- getCurrentDirectory+  webFrameLoadString wf "" Nothing $ "file://" ++ pwd ++ "/"   mainGUI  runWebGUI :: (WebView -> IO ()) -> IO ()@@ -53,4 +68,3 @@       unless ((" " ++ userAgentKey) `isSuffixOf` agent) $ main (castToWebView window)     Nothing -> do       makeDefaultWebView userAgentKey main-

@@ -12,13 +12,11 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame -data XMLHttpRequest = XMLHttpRequest JSValueRef JSContextRef deriving (Eq, Ord)--xhrContext :: XMLHttpRequest -> JSContextRef-xhrContext (XMLHttpRequest _ c) = c--xhrValue :: XMLHttpRequest -> JSValueRef-xhrValue (XMLHttpRequest v _) = v+data XMLHttpRequest+   = XMLHttpRequest { xhrValue :: JSValueRef+                    , xhrContext :: JSContextRef+                    }+   deriving (Eq, Ord)  toJSObject :: JSContextRef -> [Ptr OpaqueJSValue] -> IO JSObjectRef toJSObject ctx args = do@@ -28,18 +26,17 @@     jsobjectsetproperty ctx o prop a 1 nullPtr   return o -toResponseType :: a -> a-toResponseType = id- responseTextToText :: Maybe String -> Maybe Text responseTextToText = fmap T.pack  stringToJSValue :: JSContextRef -> String -> IO JSValueRef stringToJSValue ctx s = jsvaluemakestring ctx =<< jsstringcreatewithutf8cstring s +toResponseType :: a -> a+toResponseType = id+ xmlHttpRequestNew :: WebView -> IO XMLHttpRequest xmlHttpRequestNew wv = do-  --wv <- readIORef globalWebViewRef   wf <- webViewGetMainFrame wv   jsContext <- webFrameGetGlobalContext wf   xhrScript <- jsstringcreatewithutf8cstring "new XMLHttpRequest()"

@@ -16,6 +16,7 @@ import Data.Dependent.Sum (DSum (..)) import GHCJS.DOM.Types hiding (Event) import GHCJS.DOM (WebView)+import Control.Monad.Exception  -- | Alias for Data.Map.singleton (=:) :: k -> a -> Map k a@@ -27,9 +28,9 @@ keycodeEscape :: Int keycodeEscape = 27 -class ( Reflex t, MonadHold t m, MonadIO m, Functor m, MonadReflexCreateTrigger t m+class ( Reflex t, MonadHold t m, MonadIO m, MonadAsyncException m, Functor m, MonadReflexCreateTrigger t m       , HasDocument m, HasWebView m, HasWebView (WidgetHost m), HasWebView (GuiAction m)-      , MonadIO (WidgetHost m), MonadIO (GuiAction m), Functor (WidgetHost m), MonadSample t (WidgetHost m)+      , MonadIO (WidgetHost m), MonadAsyncException (WidgetHost m), MonadIO (GuiAction m), MonadAsyncException (GuiAction m), Functor (WidgetHost m), MonadSample t (WidgetHost m)       , HasPostGui t (GuiAction m) (WidgetHost m), HasPostGui t (GuiAction m) m, HasPostGui t (GuiAction m) (GuiAction m)       , MonadRef m, MonadRef (WidgetHost m)       , Ref m ~ Ref IO, Ref (WidgetHost m) ~ Ref IO --TODO: Eliminate this reliance on IO

@@ -19,6 +19,7 @@ import Control.Monad.Reader hiding (mapM, mapM_, forM, forM_, sequence, sequence_) import Control.Monad.Ref import Control.Monad.State.Strict hiding (mapM, mapM_, forM, forM_, sequence, sequence_, get)+import Control.Monad.Exception import Control.Concurrent import Control.Applicative import Data.ByteString (ByteString)@@ -37,7 +38,7 @@             }  --TODO: Poorly named-newtype Gui t h m a = Gui { unGui :: ReaderT (GuiEnv t h) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix)+newtype Gui t h m a = Gui { unGui :: ReaderT (GuiEnv t h) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException)  runGui :: Gui t h m a -> GuiEnv t h -> m a runGui (Gui g) env = runReaderT g env@@ -61,7 +62,8 @@   hold a0 e = lift $ hold a0 e  instance (Reflex t, MonadReflexCreateTrigger t m) => MonadReflexCreateTrigger t (Gui t h m) where-  newEventWithTrigger initializer = lift $ newEventWithTrigger initializer+  newEventWithTrigger = lift . newEventWithTrigger+  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f  data WidgetEnv    = WidgetEnv { _widgetEnvParent :: !Node@@ -108,7 +110,7 @@ instance MonadTrans (Widget t) where   lift = Widget . lift . lift -newtype Widget t m a = Widget { unWidget :: WidgetInternal t m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO)+newtype Widget t m a = Widget { unWidget :: WidgetInternal t m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)  instance MonadSample t m => MonadSample t (Widget t m) where   sample b = lift $ sample b@@ -131,9 +133,10 @@  instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (Widget t m) where   newEventWithTrigger = lift . newEventWithTrigger+  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f  instance ( MonadRef m, Ref m ~ Ref IO, MonadRef h, Ref h ~ Ref IO --TODO: Shouldn't need to be IO-         , MonadIO m, MonadIO h, Functor m+         , MonadIO m, MonadAsyncException m, MonadIO h, MonadAsyncException h, Functor m          , ReflexHost t, MonadReflexCreateTrigger t m, MonadSample t m, MonadHold t m          , MonadFix m, HasWebView h, HasPostGui t h h          ) => MonadWidget t (Widget t (Gui t h m)) where@@ -195,7 +198,7 @@   Just body <- documentGetBody doc   attachWidget body webView w -newtype WithWebView m a = WithWebView { unWithWebView :: ReaderT WebView m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix)+newtype WithWebView m a = WithWebView { unWithWebView :: ReaderT WebView m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException)  instance (Monad m) => HasWebView (WithWebView m) where   askWebView = WithWebView ask@@ -225,11 +228,16 @@ instance MonadAtomicRef m => MonadAtomicRef (WithWebView m) where   atomicModifyRef r = lift . atomicModifyRef r -deriving instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithWebView m)+instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithWebView m) where+  newEventWithTrigger = lift . newEventWithTrigger+  newFanEventWithTrigger f = lift $ newFanEventWithTrigger f++instance MonadSubscribeEvent t m => MonadSubscribeEvent t (WithWebView m) where+  subscribeEvent = lift . subscribeEvent+ instance MonadReflexHost t m => MonadReflexHost t (WithWebView m) where+  type ReadPhase (WithWebView m) = ReadPhase m   fireEventsAndRead dm a = lift $ fireEventsAndRead dm a-  subscribeEvent = lift . subscribeEvent-  runFrame = lift . runFrame   runHostFrame = lift . runHostFrame  runWithWebView :: WithWebView m a -> WebView -> m a

@@ -8,6 +8,7 @@ import Control.Monad.IO.Class import Data.Fixed import Data.Time.Clock+import Data.Typeable  data TickInfo   = TickInfo { _tickInfo_lastUTC :: UTCTime@@ -17,7 +18,7 @@              , _tickInfo_alreadyElapsed :: NominalDiffTime              -- ^ Amount of time already elapsed in the current tick period.              }-  deriving (Eq)+  deriving (Eq, Ord, Typeable)  -- | Special case of tickLossyFrom that uses the post-build event to start the --   tick thread.

@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, LambdaCase, ConstraintKinds, TypeFamilies, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, RecursiveDo #-}+{-# LANGUAGE ScopedTypeVariables, LambdaCase, ConstraintKinds, TypeFamilies, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, RecursiveDo, GADTs, DataKinds, RankNTypes, TemplateHaskell #-}  module Reflex.Dom.Widget.Basic where @@ -30,16 +30,16 @@ import Control.Lens hiding (element, children) import Data.These import Data.Align- import Data.Maybe+import Data.GADT.Compare.TH+import Data.Bitraversable+import GHCJS.DOM.MouseEvent  type AttributeMap = Map String String  data El t   = El { _el_element :: HTMLElement-       , _el_clicked :: Event t ()-       , _el_keypress :: Event t Int-       , _el_scrolled :: Event t Int+       , _el_events :: EventSelector t (WrapArg EventResult EventName)        }  class Attributes m a where@@ -382,6 +382,226 @@           {-# SCC "e" #-} unsubscribe   return $! {-# SCC "f" #-} e +data EventTag+   = AbortTag+   | BlurTag+   | ChangeTag+   | ClickTag+   | ContextmenuTag+   | DblclickTag+   | DragTag+   | DragendTag+   | DragenterTag+   | DragleaveTag+   | DragoverTag+   | DragstartTag+   | DropTag+   | ErrorTag+   | FocusTag+   | InputTag+   | InvalidTag+   | KeydownTag+   | KeypressTag+   | KeyupTag+   | LoadTag+   | MousedownTag+   | MouseenterTag+   | MouseleaveTag+   | MousemoveTag+   | MouseoutTag+   | MouseoverTag+   | MouseupTag+--   | MousewheelTag -- webkitgtk only provides elementOnmousewheel (not elementOnwheel), but firefox does not support the mousewheel event; we should provide wheel (the equivalent, standard event), but we will need to make sure webkitgtk supports it first+   | ScrollTag+   | SelectTag+   | SubmitTag+--   | WheelTag -- See MousewheelTag+   | BeforecutTag+   | CutTag+   | BeforecopyTag+   | CopyTag+   | BeforepasteTag+   | PasteTag+   | ResetTag+   | SearchTag+   | SelectstartTag+   | TouchstartTag+   | TouchmoveTag+   | TouchendTag+   | TouchcancelTag++data EventName :: EventTag -> * where+  Abort :: EventName 'AbortTag+  Blur :: EventName 'BlurTag+  Change :: EventName 'ChangeTag+  Click :: EventName 'ClickTag+  Contextmenu :: EventName 'ContextmenuTag+  Dblclick :: EventName 'DblclickTag+  Drag :: EventName 'DragTag+  Dragend :: EventName 'DragendTag+  Dragenter :: EventName 'DragenterTag+  Dragleave :: EventName 'DragleaveTag+  Dragover :: EventName 'DragoverTag+  Dragstart :: EventName 'DragstartTag+  Drop :: EventName 'DropTag+  Error :: EventName 'ErrorTag+  Focus :: EventName 'FocusTag+  Input :: EventName 'InputTag+  Invalid :: EventName 'InvalidTag+  Keydown :: EventName 'KeydownTag+  Keypress :: EventName 'KeypressTag+  Keyup :: EventName 'KeyupTag+  Load :: EventName 'LoadTag+  Mousedown :: EventName 'MousedownTag+  Mouseenter :: EventName 'MouseenterTag+  Mouseleave :: EventName 'MouseleaveTag+  Mousemove :: EventName 'MousemoveTag+  Mouseout :: EventName 'MouseoutTag+  Mouseover :: EventName 'MouseoverTag+  Mouseup :: EventName 'MouseupTag+  --Mousewheel :: EventName 'MousewheelTag+  Scroll :: EventName 'ScrollTag+  Select :: EventName 'SelectTag+  Submit :: EventName 'SubmitTag+  --Wheel :: EventName 'WheelTag+  Beforecut :: EventName 'BeforecutTag+  Cut :: EventName 'CutTag+  Beforecopy :: EventName 'BeforecopyTag+  Copy :: EventName 'CopyTag+  Beforepaste :: EventName 'BeforepasteTag+  Paste :: EventName 'PasteTag+  Reset :: EventName 'ResetTag+  Search :: EventName 'SearchTag+  Selectstart :: EventName 'SelectstartTag+  Touchstart :: EventName 'TouchstartTag+  Touchmove :: EventName 'TouchmoveTag+  Touchend :: EventName 'TouchendTag+  Touchcancel :: EventName 'TouchcancelTag++type family EventType en where+  EventType 'AbortTag = UIEvent+  EventType 'BlurTag = UIEvent+  EventType 'ChangeTag = UIEvent+  EventType 'ClickTag = MouseEvent+  EventType 'ContextmenuTag = MouseEvent+  EventType 'DblclickTag = MouseEvent+  EventType 'DragTag = MouseEvent+  EventType 'DragendTag = MouseEvent+  EventType 'DragenterTag = MouseEvent+  EventType 'DragleaveTag = MouseEvent+  EventType 'DragoverTag = MouseEvent+  EventType 'DragstartTag = MouseEvent+  EventType 'DropTag = MouseEvent+  EventType 'ErrorTag = UIEvent+  EventType 'FocusTag = UIEvent+  EventType 'InputTag = UIEvent+  EventType 'InvalidTag = UIEvent+  EventType 'KeydownTag = UIEvent+  EventType 'KeypressTag = UIEvent+  EventType 'KeyupTag = UIEvent+  EventType 'LoadTag = UIEvent+  EventType 'MousedownTag = MouseEvent+  EventType 'MouseenterTag = UIEvent+  EventType 'MouseleaveTag = UIEvent+  EventType 'MousemoveTag = MouseEvent+  EventType 'MouseoutTag = MouseEvent+  EventType 'MouseoverTag = MouseEvent+  EventType 'MouseupTag = MouseEvent+  --EventType 'MousewheelTag = MouseEvent+  EventType 'ScrollTag = UIEvent+  EventType 'SelectTag = UIEvent+  EventType 'SubmitTag = UIEvent+  --EventType 'WheelTag = UIEvent+  EventType 'BeforecutTag = UIEvent+  EventType 'CutTag = UIEvent+  EventType 'BeforecopyTag = UIEvent+  EventType 'CopyTag = UIEvent+  EventType 'BeforepasteTag = UIEvent+  EventType 'PasteTag = UIEvent+  EventType 'ResetTag = UIEvent+  EventType 'SearchTag = UIEvent+  EventType 'SelectstartTag = UIEvent+  EventType 'TouchstartTag = UIEvent+  EventType 'TouchmoveTag = UIEvent+  EventType 'TouchendTag = UIEvent+  EventType 'TouchcancelTag = UIEvent++onEventName :: IsElement e => EventName en -> e -> EventM (EventType en) e () -> IO (IO ())+onEventName en = case en of+  Abort -> elementOnabort+  Blur -> elementOnblur+  Change -> elementOnchange+  Click -> elementOnclick+  Contextmenu -> elementOncontextmenu+  Dblclick -> elementOndblclick+  Drag -> elementOndrag+  Dragend -> elementOndragend+  Dragenter -> elementOndragenter+  Dragleave -> elementOndragleave+  Dragover -> elementOndragover+  Dragstart -> elementOndragstart+  Drop -> elementOndrop+  Error -> elementOnerror+  Focus -> elementOnfocus+  Input -> elementOninput+  Invalid -> elementOninvalid+  Keydown -> elementOnkeydown+  Keypress -> elementOnkeypress+  Keyup -> elementOnkeyup+  Load -> elementOnload+  Mousedown -> elementOnmousedown+  Mouseenter -> elementOnmouseenter+  Mouseleave -> elementOnmouseleave+  Mousemove -> elementOnmousemove+  Mouseout -> elementOnmouseout+  Mouseover -> elementOnmouseover+  Mouseup -> elementOnmouseup+  --Mousewheel -> elementOnmousewheel+  Scroll -> elementOnscroll+  Select -> elementOnselect+  Submit -> elementOnsubmit+  --Wheel -> elementOnwheel+  Beforecut -> elementOnbeforecut+  Cut -> elementOncut+  Beforecopy -> elementOnbeforecopy+  Copy -> elementOncopy+  Beforepaste -> elementOnbeforepaste+  Paste -> elementOnpaste+  Reset -> elementOnreset+  Search -> elementOnsearch+  Selectstart -> elementOnselectstart+  Touchstart -> elementOntouchstart+  Touchmove -> elementOntouchmove+  Touchend -> elementOntouchend+  Touchcancel -> elementOntouchcancel++newtype EventResult en = EventResult { unEventResult :: EventResultType en }++type family EventResultType (en :: EventTag) :: * where+  EventResultType 'ClickTag = ()+  EventResultType 'DblclickTag = ()+  EventResultType 'KeypressTag = Int+  EventResultType 'ScrollTag = Int+  EventResultType 'MousemoveTag = (Int, Int)+  EventResultType 'MousedownTag = (Int, Int)+  EventResultType 'MouseupTag = (Int, Int)+  EventResultType 'MouseenterTag = ()+  EventResultType 'MouseleaveTag = ()+  EventResultType 'FocusTag = ()+  EventResultType 'BlurTag = ()++wrapDomEventsMaybe :: (Functor (Event t), IsElement e, MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => e -> (forall en. EventName en -> EventM (EventType en) e (Maybe (f en))) -> m (EventSelector t (WrapArg f EventName))+wrapDomEventsMaybe element handlers = do+  postGui <- askPostGui+  runWithActions <- askRunWithActions+  e <- newFanEventWithTrigger $ \(WrapArg en) et -> do+        unsubscribe <- liftIO $ (onEventName en) element $ do+          mv <- handlers en+          forM_ mv $ \v -> liftIO $ postGui $ runWithActions [et :=> v]+        return $ liftIO $ do+          unsubscribe+  return $! e+ getKeyEvent :: EventM UIEvent e Int getKeyEvent = do   e <- event@@ -392,12 +612,29 @@       if charCode /= 0 then return charCode else         uiEventGetKeyCode e -wrapElement :: (Functor (Event t), MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => HTMLElement -> m (El t)+getMouseEventCoords :: EventM MouseEvent e (Int, Int)+getMouseEventCoords = do+  e <- event+  liftIO $ bisequence (mouseEventGetX e, mouseEventGetY e)++defaultDomEventHandler :: IsElement e => e -> EventName en -> EventM (EventType en) e (Maybe (EventResult en))+defaultDomEventHandler e evt = liftM (Just . EventResult) $ case evt of+  Click -> return ()+  Dblclick -> return ()+  Keypress -> getKeyEvent+  Scroll -> liftIO $ elementGetScrollTop e+  Mousemove -> getMouseEventCoords+  Mouseup -> getMouseEventCoords+  Mousedown -> getMouseEventCoords+  Mouseenter -> return ()+  Mouseleave -> return ()+  Focus -> return ()+  Blur -> return ()++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) wrapElement e = do-  clicked <- wrapDomEvent e elementOnclick (return ())-  keypress <- wrapDomEvent e elementOnkeypress getKeyEvent-  scrolled <- wrapDomEvent e elementOnscroll $ liftIO $ elementGetScrollTop e-  return $ El e clicked keypress scrolled+  es <- wrapDomEventsMaybe e $ defaultDomEventHandler e+  return $ El e es  elDynAttr' :: forall t m a. MonadWidget t m => String -> Dynamic t (Map String String) -> m a -> m (El t, a) elDynAttr' elementTag attrs child = do@@ -479,10 +716,16 @@   = Link { _link_clicked :: Event t ()          } +class HasDomEvent t a where+  domEvent :: EventName en -> a -> Event t (EventResultType en)++instance Reflex t => HasDomEvent t (El t) where+  domEvent en el = fmap unEventResult $ select (_el_events el) (WrapArg en)+ linkClass :: MonadWidget t m => String -> String -> m (Link t) linkClass s c = do   (l,_) <- elAttr' "a" ("class" =: c) $ text s-  return $ Link $ _el_clicked l+  return $ Link $ domEvent Click l  link :: MonadWidget t m => String -> m (Link t) link s = linkClass s ""@@ -490,7 +733,7 @@ button :: MonadWidget t m => String -> m (Event t ()) button s = do   (e, _) <- el' "button" $ text s-  return $ _el_clicked e+  return $ domEvent Click e  newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) } @@ -556,3 +799,21 @@   p <- askParent   _ <- liftIO $ nodeAppendChild p $ Just e   wrapElement e++deriveGEq ''EventName+deriveGCompare ''EventName++--------------------------------------------------------------------------------+-- Deprecated functions++{-# DEPRECATED _el_clicked "Use `domEvent Click` instead" #-}+_el_clicked :: Reflex t => El t -> Event t ()+_el_clicked = domEvent Click++{-# DEPRECATED _el_keypress "Use `domEvent Keypress` instead" #-}+_el_keypress :: Reflex t => El t -> Event t Int+_el_keypress = domEvent Keypress++{-# DEPRECATED _el_scrolled "Use `domEvent Scroll` instead" #-}+_el_scrolled :: Reflex t => El t -> Event t Int+_el_scrolled = domEvent Scroll

@@ -26,6 +26,7 @@  data TextInput t    = TextInput { _textInput_value :: Dynamic t String+               , _textInput_input :: Event t String                , _textInput_keypress :: Event t Int                , _textInput_keydown :: Event t Int                , _textInput_keyup :: Event t Int@@ -66,7 +67,7 @@   eKeydown <- wrapDomEvent e elementOnkeydown getKeyEvent   eKeyup <- wrapDomEvent e elementOnkeyup getKeyEvent   dValue <- holdDyn initial $ leftmost [eSetValue, eChange]-  return $ TextInput dValue eKeypress eKeydown eKeyup dFocus e+  return $ TextInput dValue eChange eKeypress eKeydown eKeyup dFocus e  textInputGetEnter :: Reflex t => TextInput t -> Event t () textInputGetEnter i = fmapMaybe (\n -> if n == keycodeEnter then Just () else Nothing) $ _textInput_keypress i@@ -85,6 +86,7 @@  data TextArea t    = TextArea { _textArea_value :: Dynamic t String+              , _textArea_input :: Event t String               , _textArea_element :: HTMLTextAreaElement               , _textArea_hasFocus :: Dynamic t Bool               , _textArea_keypress :: Event t Int@@ -107,7 +109,7 @@   ev <- wrapDomEvent e elementOninput $ liftIO $ htmlTextAreaElementGetValue e   v <- holdDyn initial $ leftmost [eSet, ev]   eKeypress <- wrapDomEvent e elementOnkeypress getKeyEvent-  return $ TextArea v e f eKeypress+  return $ TextArea v ev e f eKeypress  data CheckboxConfig t     = CheckboxConfig { _checkboxConfig_setValue :: Event t Bool@@ -121,6 +123,7 @@  data Checkbox t    = Checkbox { _checkbox_value :: Dynamic t Bool+              , _checkbox_change :: Event t Bool               }  --TODO: Make attributes possibly dynamic@@ -133,7 +136,7 @@   eClick <- wrapDomEvent e elementOnclick $ liftIO $ htmlInputElementGetChecked e   performEvent_ $ fmap (\v -> liftIO $ htmlInputElementSetChecked e $! v) $ _checkboxConfig_setValue config   dValue <- holdDyn checked $ leftmost [_checkboxConfig_setValue config, eClick]-  return $ Checkbox dValue+  return $ Checkbox dValue eClick  checkboxView :: MonadWidget t m => Dynamic t (Map String String) -> Dynamic t Bool -> m (Event t Bool) checkboxView dAttrs dValue = do@@ -149,6 +152,7 @@  data Dropdown t k     = Dropdown { _dropdown_value :: Dynamic t k+               , _dropdown_change :: Event t k                }  data DropdownConfig t k@@ -181,7 +185,7 @@         guard $ Map.member k opts         return k   dValue <- combineDyn readKey options =<< holdDyn (Just k0) (leftmost [eChange, fmap Just setK])-  return $ Dropdown dValue+  return $ Dropdown dValue (attachDynWith readKey options eChange)  liftM concat $ mapM makeLenses   [ ''TextAreaConfig

@@ -33,9 +33,9 @@         currentTop <- mapDyn (listWrapperStyle . fst) window         (_, lis) <- elDynAttr "div" totalHeightStyle $ tagWrapper listTag listAttrs currentTop $ listWithKey itemsInWindow $ \k v -> do             (li,_) <- tagWrapper rowTag rowAttrs (constDyn $ toHeightStyle rowPx) $ itemBuilder k v-            return $ fmap (const k) (_el_clicked li)+            return $ fmap (const k) (domEvent Click li)         return lis-      scrollPosition <- holdDyn 0 $ _el_scrolled container+      scrollPosition <- holdDyn 0 $ domEvent Scroll container       window <- mapDyn (findWindow heightPx rowPx) scrollPosition       itemsInWindow <- combineDyn (\(_,(idx,num)) is -> Map.fromList $ take num $ drop idx $ Map.toList is) window items   postBuild <- getPostBuild

@@ -31,12 +31,14 @@ import Reflex import Reflex.Dom.Class import Reflex.Dom.Xhr.Foreign+import Data.Typeable  data XhrRequest    = XhrRequest { _xhrRequest_method :: String                 , _xhrRequest_url :: String                 , _xhrRequest_config :: XhrRequestConfig                 }+   deriving (Show, Read, Eq, Ord, Typeable)  data XhrRequestConfig    = XhrRequestConfig { _xhrRequestConfig_headers :: Map String String@@ -45,10 +47,12 @@                       , _xhrRequestConfig_responseType :: Maybe String                       , _xhrRequestConfig_sendData :: Maybe String                       }+   deriving (Show, Read, Eq, Ord, Typeable)  data XhrResponse    = XhrResponse { _xhrResponse_body :: Maybe Text                  }+   deriving (Show, Read, Eq, Ord, Typeable)  instance Default XhrRequestConfig where   def = XhrRequestConfig { _xhrRequestConfig_headers = Map.empty