8ac807c · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Merge remote-tracking branch 'origin/ghcjs-dom-0.8' into HEAD

# Conflicts: # reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs

commit8ac807cee83de75e041e2a40daa443f99301be72 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 1 May 2017, 18:27 (10 years ago) parent3db7a09

14 files changed+207−215

compare with develop

unifiedsplit

reflex-dom-core/reflex-dom-core.cabal+2−2

@@ -41,7 +41,7 @@ flag build-examples

4141library

4242 hs-source-dirs: src

4343 build-depends:

44− aeson >= 0.8 && < 1.1,

44+ aeson >= 0.8 && < 1.2,

4545 base >= 4.7 && < 4.11,

4646 bifunctors >= 4.2 && < 6,

4747 bimap >= 0.3 && < 0.4,

@@ -55,7 +55,7 @@ library

5555 dependent-sum-template >= 0.0.0.4 && < 0.1,

5656 directory >= 1.2 && < 1.4,

5757 exception-transformers == 0.4.*,

58− ghcjs-dom >= 0.7.0.4 && < 0.8,

58+ ghcjs-dom >= 0.8.0.0 && < 0.9,

5959 jsaddle >=0.8.0.1 && <0.9,

6060 -- keycode-0.2 has a bug on firefox

6161 keycode >= 0.2.1 && < 0.3,

reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+1−1

@@ -189,7 +189,7 @@ instance (Reflex t) => Default (TextNodeConfig t) where

189189 , _textNodeConfig_setContents = Nothing

190190 }

191191

192−data TextNode d t = TextNode

192+newtype TextNode d t = TextNode

193193 { _textNode_raw :: RawTextNode d

194194 }

195195

reflex-dom-core/src/Reflex/Dom/Builder/Class/Events.hs+4−4

@@ -117,10 +117,10 @@ newtype EventResult en = EventResult { unEventResult :: EventResultType en }

117117type family EventResultType (en :: EventTag) :: * where

118118 EventResultType 'ClickTag = ()

119119 EventResultType 'DblclickTag = (Int, Int)

120− EventResultType 'KeypressTag = Int

121− EventResultType 'KeydownTag = Int

122− EventResultType 'KeyupTag = Int

123− EventResultType 'ScrollTag = Int

120+ EventResultType 'KeypressTag = Word

121+ EventResultType 'KeydownTag = Word

122+ EventResultType 'KeyupTag = Word

123+ EventResultType 'ScrollTag = Double

124124 EventResultType 'MousemoveTag = (Int, Int)

125125 EventResultType 'MousedownTag = (Int, Int)

126126 EventResultType 'MouseupTag = (Int, Int)

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+138−139

@@ -118,10 +118,11 @@ import Data.Text (Text)

118118import qualified Data.Text as T

119119import qualified GHCJS.DOM as DOM

120120import GHCJS.DOM.RequestAnimationFrameCallback

121−import GHCJS.DOM.Document (Document, createDocumentFragmentUnchecked, createElementUnchecked, createElementNSUnchecked, createTextNodeUnchecked)

121+import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode)

122122import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS)

123123import qualified GHCJS.DOM.Element as Element

124124import qualified GHCJS.DOM.Event as Event

125+import qualified GHCJS.DOM.GlobalEventHandlers as Events

125126import GHCJS.DOM.EventM (EventM, event, on)

126127import qualified GHCJS.DOM.EventM as DOM

127128import qualified GHCJS.DOM.FileList as FileList

@@ -136,10 +137,11 @@ import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnc

136137import qualified GHCJS.DOM.Node as DOM (insertBefore_)

137138import GHCJS.DOM.Types

138139 (liftJSM, askJSM, runJSM, JSM, MonadJSM(..),

139− FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,

140− ToDOMString, TouchEvent, WheelEvent, uncheckedCastTo)

140+ FocusEvent, IsHTMLElement, IsEvent, IsNode, KeyboardEvent, Node,

141+ ToDOMString, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)

141142import qualified GHCJS.DOM.Types as DOM

142143import GHCJS.DOM.UIEvent

144+import GHCJS.DOM.KeyboardEvent as KeyboardEvent

143145import qualified GHCJS.DOM.Window as Window

144146import Language.Javascript.JSaddle (call, eval)

145147

@@ -205,7 +207,7 @@ runImmediateDomBuilderT (ImmediateDomBuilderT a) env eventChan = flip runTrigger

205207 v <- synchronously x

206208 _ <- liftIO $ f v

207209 freeRequestAnimationFrameCallback cb

208− _ <- Window.requestAnimationFrame win $ Just cb

210+ _ <- Window.requestAnimationFrame win cb

209211 return ()

210212

211213{-# INLINABLE askDocument #-}

@@ -227,14 +229,14 @@ localEnv f = ImmediateDomBuilderT . local f . unImmediateDomBuilderT

227229append :: (IsNode n, MonadJSM m) => n -> ImmediateDomBuilderT t m ()

228230append n = do

229231 p <- askParent

230− liftJSM $ appendChild_ p $ Just n

232+ liftJSM $ appendChild_ p n

231233 return ()

232234

233235{-# INLINABLE textNodeInternal #-}

234236textNodeInternal :: (MonadJSM m, ToDOMString contents) => contents -> ImmediateDomBuilderT t m DOM.Text

235237textNodeInternal t = do

236238 doc <- askDocument

237− n <- liftJSM $ createTextNodeUnchecked doc t

239+ n <- liftJSM $ createTextNode doc t

238240 append n

239241 return n

240242

@@ -242,7 +244,7 @@ textNodeInternal t = do

242244-- all nodes between s and e will be removed, but s and e will not be removed

243245deleteBetweenExclusive :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()

244246deleteBetweenExclusive s e = liftJSM $ do

245− df <- createDocumentFragmentUnchecked =<< getOwnerDocumentUnchecked s

247+ df <- createDocumentFragment =<< getOwnerDocumentUnchecked s

246248 extractBetweenExclusive df s e -- In many places in ImmediateDomBuilderT, we assume that things always have a parent; by adding them to this DocumentFragment, we maintain that invariant

247249

248250-- | s and e must both be children of the same node and s must precede e; all

@@ -267,7 +269,7 @@ extractBetweenExclusive df s e = liftJSM $ do

267269{-# INLINABLE deleteUpTo #-}

268270deleteUpTo :: (MonadJSM m, IsNode start, IsNode end) => start -> end -> m ()

269271deleteUpTo s e = do

270− df <- createDocumentFragmentUnchecked =<< getOwnerDocumentUnchecked s

272+ df <- createDocumentFragment =<< getOwnerDocumentUnchecked s

271273 extractUpTo df s e -- In many places in ImmediateDomBuilderT, we assume that things always have a parent; by adding them to this DocumentFragment, we maintain that invariant

272274

273275extractUpTo :: (MonadJSM m, IsNode start, IsNode end) => DOM.DocumentFragment -> start -> end -> m ()

@@ -298,7 +300,7 @@ collectUpTo s e = do

298300collectUpToGivenParent :: (MonadJSM m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m DOM.DocumentFragment

299301collectUpToGivenParent currentParent s e = do

300302 doc <- getOwnerDocumentUnchecked currentParent

301− df <- createDocumentFragmentUnchecked doc

303+ df <- createDocumentFragment doc

302304 extractUpTo df s e

303305 return df

304306

@@ -348,12 +350,12 @@ wrap e cfg = do

348350 }

349351

350352{-# INLINABLE makeElement #-}

351−makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)

353+makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.HTMLElement)

352354makeElement elementTag cfg child = do

353355 doc <- askDocument

354− e <- liftJSM $ case cfg ^. namespace of

355− Nothing -> createElementUnchecked doc (Just elementTag)

356− Just ens -> createElementNSUnchecked doc (Just ens) (Just elementTag)

356+ e <- liftJSM $ uncheckedCastTo DOM.HTMLElement <$> case cfg ^. namespace of

357+ Nothing -> createElement doc elementTag

358+ Just ens -> createElementNS doc (Just ens) elementTag

357359 ImmediateDomBuilderT $ iforM_ (cfg ^. initialAttributes) $ \(AttributeName mAttrNamespace n) v -> case mAttrNamespace of

358360 Nothing -> lift $ setAttribute e n v

359361 Just ans -> lift $ setAttributeNS e (Just ans) n v

@@ -375,7 +377,7 @@ data GhcjsDomSpace

375377instance DomSpace GhcjsDomSpace where

376378 type EventSpec GhcjsDomSpace = GhcjsEventSpec

377379 type RawTextNode GhcjsDomSpace = DOM.Text

378− type RawElement GhcjsDomSpace = DOM.Element

380+ type RawElement GhcjsDomSpace = DOM.HTMLElement

379381 type RawFile GhcjsDomSpace = DOM.File

380382 type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement

381383 type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement

@@ -424,8 +426,8 @@ instance er ~ EventResult => Default (GhcjsEventSpec er) where

424426 def = GhcjsEventSpec

425427 { _ghcjsEventSpec_filters = mempty

426428 , _ghcjsEventSpec_handler = GhcjsEventHandler $ \(en, GhcjsDomEvent evt) -> do

427− t :: DOM.EventTarget <- withIsEvent en $ Event.getTargetUnchecked evt --TODO: Rework this; defaultDomEventHandler shouldn't need to take this as an argument

428− let e = uncheckedCastTo DOM.Element t

429+ t :: DOM.EventTarget <- withIsEvent en $ Event.getTarget evt --TODO: Rework this; defaultDomEventHandler shouldn't need to take this as an argument

430+ let e = uncheckedCastTo DOM.HTMLElement t

429431 runReaderT (defaultDomEventHandler e en) evt

430432 }

431433

@@ -456,7 +458,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

456458 , valueChangedByUI

457459 ]

458460 Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg

459− checkedChangedByUI <- wrapDomEvent domInputElement (`on` Element.click) $ do

461+ checkedChangedByUI <- wrapDomEvent domInputElement (`on` Events.click) $ do

460462 Input.getChecked domInputElement

461463 checkedChangedBySetChecked <- case _inputElementConfig_setChecked cfg of

462464 Nothing -> return never

@@ -475,7 +477,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

475477 [ False <$ Reflex.select (_element_events e) (WrapArg Blur)

476478 , True <$ Reflex.select (_element_events e) (WrapArg Focus)

477479 ]

478− files <- holdDyn mempty <=< wrapDomEvent domInputElement (`on` Element.change) $ do

480+ files <- holdDyn mempty <=< wrapDomEvent domInputElement (`on` Events.change) $ do

479481 mfiles <- Input.getFiles domInputElement

480482 let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs

481483 maybe (return []) getMyFiles mfiles

@@ -518,14 +520,14 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

518520 selectElement cfg child = do

519521 ((e, result), domElement) <- makeElement "select" (cfg ^. selectElementConfig_elementConfig) child

520522 let domSelectElement = uncheckedCastTo DOM.HTMLSelectElement domElement

521− Select.setValue domSelectElement $ Just (cfg ^. selectElementConfig_initialValue)

522− Just v0 <- Select.getValue domSelectElement

523− let getMyValue = fromMaybe "" <$> Select.getValue domSelectElement

523+ Select.setValue domSelectElement $ cfg ^. selectElementConfig_initialValue

524+ v0 <- Select.getValue domSelectElement

525+ let getMyValue = Select.getValue domSelectElement

524526 valueChangedByUI <- requestDomAction $ liftJSM getMyValue <$ Reflex.select (_element_events e) (WrapArg Change)

525527 valueChangedBySetValue <- case _selectElementConfig_setValue cfg of

526528 Nothing -> return never

527529 Just eSetValue -> requestDomAction $ ffor eSetValue $ \v' -> do

528− Select.setValue domSelectElement $ Just v'

530+ Select.setValue domSelectElement v'

529531 getMyValue -- We get the value after setting it in case the browser has mucked with it somehow

530532 v <- holdDyn v0 $ leftmost

531533 [ valueChangedBySetValue

@@ -579,7 +581,7 @@ extractFragment fragment = do

579581instance SupportsImmediateDomBuilder t m => MountableDomBuilder t (ImmediateDomBuilderT t m) where

580582 type DomFragment (ImmediateDomBuilderT t m) = ImmediateDomFragment

581583 buildDomFragment w = do

582− df <- createDocumentFragmentUnchecked =<< askDocument

584+ df <- createDocumentFragment =<< askDocument

583585 result <- flip localEnv w $ \env -> env

584586 { _immediateDomBuilderEnv_parent = toNode df

585587 }

@@ -589,7 +591,7 @@ instance SupportsImmediateDomBuilder t m => MountableDomBuilder t (ImmediateDomB

589591 parent <- askParent

590592 extractFragment fragment

591593 before <- textNodeInternal ("" :: Text)

592− appendChild_ parent $ Just $ _immediateDomFragment_document fragment

594+ appendChild_ parent $ _immediateDomFragment_document fragment

593595 after <- textNodeInternal ("" :: Text)

594596 xs <- foldDyn (\new (previous, _) -> (new, Just previous)) (fragment, Nothing) setFragment

595597 requestDomAction_ $ ffor (updated xs) $ \(childFragment, Just previousFragment) -> do

@@ -617,7 +619,7 @@ instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, MonadFix m, Prim

617619 when (new == 0) $ _immediateDomBuilderEnv_commitAction initialEnv

618620 -- We draw 'after' in this roundabout way to avoid using MonadFix

619621 doc <- askDocument

620− after <- createTextNodeUnchecked doc ("" :: Text)

622+ after <- createTextNode doc ("" :: Text)

621623 let drawInitialChild = do

622624 unreadyChildren <- liftIO $ newIORef 0

623625 let f = do

@@ -634,7 +636,7 @@ instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, MonadFix m, Prim

634636 return result

635637 a'' <- numberOccurrences a'

636638 (result0, child') <- ImmediateDomBuilderT $ lift $ runWithReplace drawInitialChild $ ffor a'' $ \(cohortId, child) -> do

637− df <- createDocumentFragmentUnchecked doc

639+ df <- createDocumentFragment doc

638640 unreadyChildren <- liftIO $ newIORef 0

639641 let commitAction = do

640642 c <- liftIO $ readIORef currentCohort

@@ -832,7 +834,7 @@ drawChildUpdate :: (MonadIO m, MonadJSM m)

832834drawChildUpdate initialEnv markReady child = do

833835 childReadyState <- liftIO $ newIORef $ ChildReadyState_Unready Nothing

834836 unreadyChildren <- liftIO $ newIORef 0

835− df <- createDocumentFragmentUnchecked $ _immediateDomBuilderEnv_document initialEnv

837+ df <- createDocumentFragment $ _immediateDomBuilderEnv_document initialEnv

836838 (placeholder, result) <- runReaderT (unImmediateDomBuilderT $ (,) <$> textNodeInternal ("" :: Text) <*> child) $ initialEnv

837839 { _immediateDomBuilderEnv_parent = toNode df

838840 , _immediateDomBuilderEnv_unreadyChildren = unreadyChildren

@@ -853,7 +855,7 @@ mkHasFocus e = do

853855insertBefore :: (MonadJSM m, IsNode new, IsNode existing) => new -> existing -> m ()

854856insertBefore new existing = do

855857 p <- getParentNodeUnchecked existing

856− DOM.insertBefore_ p (Just new) (Just existing) -- If there's no parent, that means we've been removed from the DOM; this should not happen if the we're removing ourselves from the performEvent properly

858+ DOM.insertBefore_ p new (Just existing) -- If there's no parent, that means we've been removed from the DOM; this should not happen if the we're removing ourselves from the performEvent properly

857859

858860instance PerformEvent t m => PerformEvent t (ImmediateDomBuilderT t m) where

859861 type Performable (ImmediateDomBuilderT t m) = Performable m

@@ -935,12 +937,12 @@ type family EventType en where

935937 EventType 'SelectTag = UIEvent

936938 EventType 'SubmitTag = DOM.Event

937939 EventType 'WheelTag = WheelEvent

938− EventType 'BeforecutTag = DOM.Event

939− EventType 'CutTag = DOM.Event

940− EventType 'BeforecopyTag = DOM.Event

941− EventType 'CopyTag = DOM.Event

942− EventType 'BeforepasteTag = DOM.Event

943− EventType 'PasteTag = DOM.Event

940+ EventType 'BeforecutTag = ClipboardEvent

941+ EventType 'CutTag = ClipboardEvent

942+ EventType 'BeforecopyTag = ClipboardEvent

943+ EventType 'CopyTag = ClipboardEvent

944+ EventType 'BeforepasteTag = ClipboardEvent

945+ EventType 'PasteTag = ClipboardEvent

944946 EventType 'ResetTag = DOM.Event

945947 EventType 'SearchTag = DOM.Event

946948 EventType 'SelectstartTag = DOM.Event

@@ -950,12 +952,12 @@ type family EventType en where

950952 EventType 'TouchcancelTag = TouchEvent

951953

952954{-# INLINABLE defaultDomEventHandler #-}

953−defaultDomEventHandler :: IsElement e => e -> EventName en -> EventM e (EventType en) (Maybe (EventResult en))

955+defaultDomEventHandler :: IsHTMLElement e => e -> EventName en -> EventM e (EventType en) (Maybe (EventResult en))

954956defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of

955957 Click -> return ()

956958 Dblclick -> getMouseEventCoords

957959 Keypress -> getKeyEvent

958− Scroll -> getScrollTop e

960+ Scroll -> fromIntegral <$> getScrollTop e

959961 Keydown -> getKeyEvent

960962 Keyup -> getKeyEvent

961963 Mousemove -> getMouseEventCoords

@@ -1149,104 +1151,104 @@ showEventName en = case en of

11491151 Touchcancel -> "Touchcancel"

11501152

11511153{-# INLINABLE elementOnEventName #-}

1152−elementOnEventName :: IsElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())

1154+elementOnEventName :: IsHTMLElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())

11531155elementOnEventName en e = case en of

1154− Abort -> on e Element.abort

1155− Blur -> on e Element.blurEvent

1156− Change -> on e Element.change

1157− Click -> on e Element.click

1158− Contextmenu -> on e Element.contextMenu

1159− Dblclick -> on e Element.dblClick

1160− Drag -> on e Element.drag

1161− Dragend -> on e Element.dragEnd

1162− Dragenter -> on e Element.dragEnter

1163− Dragleave -> on e Element.dragLeave

1164− Dragover -> on e Element.dragOver

1165− Dragstart -> on e Element.dragStart

1166− Drop -> on e Element.drop

1167− Error -> on e Element.error

1168− Focus -> on e Element.focusEvent

1169− Input -> on e Element.input

1170− Invalid -> on e Element.invalid

1171− Keydown -> on e Element.keyDown

1172− Keypress -> on e Element.keyPress

1173− Keyup -> on e Element.keyUp

1174− Load -> on e Element.load

1175− Mousedown -> on e Element.mouseDown

1176− Mouseenter -> on e Element.mouseEnter

1177− Mouseleave -> on e Element.mouseLeave

1178− Mousemove -> on e Element.mouseMove

1179− Mouseout -> on e Element.mouseOut

1180− Mouseover -> on e Element.mouseOver

1181− Mouseup -> on e Element.mouseUp

1182− Mousewheel -> on e Element.mouseWheel

1183− Scroll -> on e Element.scroll

1184− Select -> on e Element.select

1185− Submit -> on e Element.submit

1186− Wheel -> on e Element.wheel

1156+ Abort -> on e Events.abort

1157+ Blur -> on e Events.blur

1158+ Change -> on e Events.change

1159+ Click -> on e Events.click

1160+ Contextmenu -> on e Events.contextMenu

1161+ Dblclick -> on e Events.dblClick

1162+ Drag -> on e Events.drag

1163+ Dragend -> on e Events.dragEnd

1164+ Dragenter -> on e Events.dragEnter

1165+ Dragleave -> on e Events.dragLeave

1166+ Dragover -> on e Events.dragOver

1167+ Dragstart -> on e Events.dragStart

1168+ Drop -> on e Events.drop

1169+ Error -> on e Events.error

1170+ Focus -> on e Events.focus

1171+ Input -> on e Events.input

1172+ Invalid -> on e Events.invalid

1173+ Keydown -> on e Events.keyDown

1174+ Keypress -> on e Events.keyPress

1175+ Keyup -> on e Events.keyUp

1176+ Load -> on e Events.load

1177+ Mousedown -> on e Events.mouseDown

1178+ Mouseenter -> on e Events.mouseEnter

1179+ Mouseleave -> on e Events.mouseLeave

1180+ Mousemove -> on e Events.mouseMove

1181+ Mouseout -> on e Events.mouseOut

1182+ Mouseover -> on e Events.mouseOver

1183+ Mouseup -> on e Events.mouseUp

1184+ Mousewheel -> on e Events.mouseWheel

1185+ Scroll -> on e Events.scroll

1186+ Select -> on e Events.select

1187+ Submit -> on e Events.submit

1188+ Wheel -> on e Events.wheel

11871189 Beforecut -> on e Element.beforeCut

11881190 Cut -> on e Element.cut

11891191 Beforecopy -> on e Element.beforeCopy

11901192 Copy -> on e Element.copy

11911193 Beforepaste -> on e Element.beforePaste

11921194 Paste -> on e Element.paste

1193− Reset -> on e Element.reset

1194− Search -> on e Element.search

1195+ Reset -> on e Events.reset

1196+ Search -> on e Events.search

11951197 Selectstart -> on e Element.selectStart

1196− Touchstart -> on e Element.touchStart

1197− Touchmove -> on e Element.touchMove

1198− Touchend -> on e Element.touchEnd

1199− Touchcancel -> on e Element.touchCancel

1198+ Touchstart -> on e Events.touchStart

1199+ Touchmove -> on e Events.touchMove

1200+ Touchend -> on e Events.touchEnd

1201+ Touchcancel -> on e Events.touchCancel

12001202

12011203{-# INLINABLE windowOnEventName #-}

12021204windowOnEventName :: EventName en -> DOM.Window -> EventM DOM.Window (EventType en) () -> JSM (JSM ())

12031205windowOnEventName en e = case en of

1204− Abort -> on e Window.abort

1205− Blur -> on e Window.blurEvent

1206− Change -> on e Window.change

1207− Click -> on e Window.click

1208− Contextmenu -> on e Window.contextMenu

1209− Dblclick -> on e Window.dblClick

1210− Drag -> on e Window.drag

1211− Dragend -> on e Window.dragEnd

1212− Dragenter -> on e Window.dragEnter

1213− Dragleave -> on e Window.dragLeave

1214− Dragover -> on e Window.dragOver

1215− Dragstart -> on e Window.dragStart

1216− Drop -> on e Window.drop

1217− Error -> on e Window.error

1218− Focus -> on e Window.focusEvent

1219− Input -> on e Window.input

1220− Invalid -> on e Window.invalid

1221− Keydown -> on e Window.keyDown

1222− Keypress -> on e Window.keyPress

1223− Keyup -> on e Window.keyUp

1224− Load -> on e Window.load

1225− Mousedown -> on e Window.mouseDown

1226− Mouseenter -> on e Window.mouseEnter

1227− Mouseleave -> on e Window.mouseLeave

1228− Mousemove -> on e Window.mouseMove

1229− Mouseout -> on e Window.mouseOut

1230− Mouseover -> on e Window.mouseOver

1231− Mouseup -> on e Window.mouseUp

1232− Mousewheel -> on e Window.mouseWheel

1233− Scroll -> on e Window.scrollEvent

1234− Select -> on e Window.select

1235− Submit -> on e Window.submit

1236− Wheel -> on e Window.wheel

1206+ Abort -> on e Events.abort

1207+ Blur -> on e Events.blur

1208+ Change -> on e Events.change

1209+ Click -> on e Events.click

1210+ Contextmenu -> on e Events.contextMenu

1211+ Dblclick -> on e Events.dblClick

1212+ Drag -> on e Events.drag

1213+ Dragend -> on e Events.dragEnd

1214+ Dragenter -> on e Events.dragEnter

1215+ Dragleave -> on e Events.dragLeave

1216+ Dragover -> on e Events.dragOver

1217+ Dragstart -> on e Events.dragStart

1218+ Drop -> on e Events.drop

1219+ Error -> on e Events.error

1220+ Focus -> on e Events.focus

1221+ Input -> on e Events.input

1222+ Invalid -> on e Events.invalid

1223+ Keydown -> on e Events.keyDown

1224+ Keypress -> on e Events.keyPress

1225+ Keyup -> on e Events.keyUp

1226+ Load -> on e Events.load

1227+ Mousedown -> on e Events.mouseDown

1228+ Mouseenter -> on e Events.mouseEnter

1229+ Mouseleave -> on e Events.mouseLeave

1230+ Mousemove -> on e Events.mouseMove

1231+ Mouseout -> on e Events.mouseOut

1232+ Mouseover -> on e Events.mouseOver

1233+ Mouseup -> on e Events.mouseUp

1234+ Mousewheel -> on e Events.mouseWheel

1235+ Scroll -> on e Events.scroll

1236+ Select -> on e Events.select

1237+ Submit -> on e Events.submit

1238+ Wheel -> on e Events.wheel

12371239 Beforecut -> const $ return $ return () --TODO

12381240 Cut -> const $ return $ return () --TODO

12391241 Beforecopy -> const $ return $ return () --TODO

12401242 Copy -> const $ return $ return () --TODO

12411243 Beforepaste -> const $ return $ return () --TODO

12421244 Paste -> const $ return $ return () --TODO

1243− Reset -> on e Window.reset

1244− Search -> on e Window.search

1245+ Reset -> on e Events.reset

1246+ Search -> on e Events.search

12451247 Selectstart -> const $ return $ return () --TODO

1246− Touchstart -> on e Window.touchStart

1247− Touchmove -> on e Window.touchMove

1248− Touchend -> on e Window.touchEnd

1249− Touchcancel -> on e Window.touchCancel

1248+ Touchstart -> on e Events.touchStart

1249+ Touchmove -> on e Events.touchMove

1250+ Touchend -> on e Events.touchEnd

1251+ Touchcancel -> on e Events.touchCancel

12501252

12511253{-# INLINABLE wrapDomEvent #-}

12521254wrapDomEvent :: (TriggerEvent t m, MonadJSM m) => e -> (e -> EventM e event () -> JSM (JSM ())) -> EventM e event a -> m (Event t a)

@@ -1291,10 +1293,10 @@ wrapDomEventsMaybe target handlers onEventName = do

12911293 return $! e

12921294

12931295{-# INLINABLE getKeyEvent #-}

1294−getKeyEvent :: EventM e KeyboardEvent Int

1296+getKeyEvent :: EventM e KeyboardEvent Word

12951297getKeyEvent = do

12961298 e <- event

1297− which <- getWhich e

1299+ which <- KeyboardEvent.getWhich e

12981300 if which /= 0 then return which else do

12991301 charCode <- getCharCode e

13001302 if charCode /= 0 then return charCode else

@@ -1309,29 +1311,26 @@ getMouseEventCoords = do

13091311{-# INLINABLE getTouchEvent #-}

13101312getTouchEvent :: EventM e TouchEvent TouchEventResult

13111313getTouchEvent = do

1312− let touchResults = \case

1313− Nothing -> return []

1314− Just ts -> do

1314+ let touchResults ts = do

13151315 n <- TouchList.getLength ts

1316− fmap catMaybes . forM (takeWhile (< n) [0..]) $ \ix -> do

1317− mt <- TouchList.item ts ix

1318− forM mt $ \t -> do

1319− identifier <- Touch.getIdentifier t

1320− screenX <- Touch.getScreenX t

1321− screenY <- Touch.getScreenY t

1322− clientX <- Touch.getClientX t

1323− clientY <- Touch.getClientY t

1324− pageX <- Touch.getPageX t

1325− pageY <- Touch.getPageY t

1326− return $ TouchResult

1327− { _touchResult_identifier = identifier

1328− , _touchResult_screenX = screenX

1329− , _touchResult_screenY = screenY

1330− , _touchResult_clientX = clientX

1331− , _touchResult_clientY = clientY

1332− , _touchResult_pageX = pageX

1333− , _touchResult_pageY = pageY

1334− }

1316+ forM (takeWhile (< n) [0..]) $ \ix -> do

1317+ t <- TouchList.item ts ix

1318+ identifier <- Touch.getIdentifier t

1319+ screenX <- Touch.getScreenX t

1320+ screenY <- Touch.getScreenY t

1321+ clientX <- Touch.getClientX t

1322+ clientY <- Touch.getClientY t

1323+ pageX <- Touch.getPageX t

1324+ pageY <- Touch.getPageY t

1325+ return TouchResult

1326+ { _touchResult_identifier = identifier

1327+ , _touchResult_screenX = screenX

1328+ , _touchResult_screenY = screenY

1329+ , _touchResult_clientX = clientX

1330+ , _touchResult_clientY = clientY

1331+ , _touchResult_pageX = pageX

1332+ , _touchResult_pageY = pageY

1333+ }

13351334 e <- event

13361335 altKey <- TouchEvent.getAltKey e

13371336 ctrlKey <- TouchEvent.getCtrlKey e

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs−1

@@ -5,7 +5,6 @@

55{-# LANGUAGE FlexibleContexts #-}

66{-# LANGUAGE FlexibleInstances #-}

77{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8−{-# LANGUAGE LambdaCase #-}

98{-# LANGUAGE MultiParamTypeClasses #-}

109{-# LANGUAGE OverloadedStrings #-}

1110{-# LANGUAGE PolyKinds #-}

reflex-dom-core/src/Reflex/Dom/Location.hs+3−3

@@ -3,11 +3,11 @@ module Reflex.Dom.Location (getLocationHost, getLocationProtocol) where

33import Data.Text (Text)

44import GHCJS.DOM.Types (MonadJSM)

55import GHCJS.DOM (currentWindowUnchecked)

6−import GHCJS.DOM.Window (getLocationUnchecked)

6+import GHCJS.DOM.Window (getLocation)

77import GHCJS.DOM.Location (getProtocol, getHost)

99getLocationHost :: (MonadJSM m) => m Text

10−getLocationHost = currentWindowUnchecked >>= getLocationUnchecked >>= getHost

10+getLocationHost = currentWindowUnchecked >>= getLocation >>= getHost

1111

1212getLocationProtocol :: (MonadJSM m) => m Text

13−getLocationProtocol = currentWindowUnchecked >>= getLocationUnchecked >>= getProtocol

13+getLocationProtocol = currentWindowUnchecked >>= getLocation >>= getProtocol

reflex-dom-core/src/Reflex/Dom/Main.hs+8−9

@@ -1,9 +1,7 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE ConstraintKinds #-}

32{-# LANGUAGE FlexibleContexts #-}

43{-# LANGUAGE FlexibleInstances #-}

54{-# LANGUAGE GADTs #-}

6−{-# LANGUAGE LambdaCase #-}

75{-# LANGUAGE MultiParamTypeClasses #-}

86{-# LANGUAGE NoMonomorphismRestriction #-}

97{-# LANGUAGE RankNTypes #-}

@@ -41,6 +39,7 @@ import Data.Text.Encoding

4139import GHCJS.DOM

4240import GHCJS.DOM.Document

4341import GHCJS.DOM.Element

42+import GHCJS.DOM.NonElementParentNode

4443import GHCJS.DOM.Node

4544import qualified GHCJS.DOM.Types as DOM

4645import GHCJS.DOM.Types (JSM)

@@ -90,9 +89,9 @@ mainWidgetWithHead' :: (a -> Widget () b, b -> Widget () a) -> JSM ()

9089mainWidgetWithHead' widgets = withJSContextSingletonMono $ \jsSing -> do

9190 doc <- currentDocumentUnchecked

9291 headElement <- getHeadUnchecked doc

93− headFragment <- createDocumentFragmentUnchecked doc

92+ headFragment <- createDocumentFragment doc

9493 bodyElement <- getBodyUnchecked doc

95− bodyFragment <- createDocumentFragmentUnchecked doc

94+ bodyFragment <- createDocumentFragment doc

9695 (events, fc) <- liftIO . attachWidget'' $ \events -> do

9796 let (headWidget, bodyWidget) = widgets

9897 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

@@ -116,14 +115,14 @@ mainWidgetWithHead' widgets = withJSContextSingletonMono $ \jsSing -> do

116115replaceElementContents :: DOM.IsElement e => e -> DOM.DocumentFragment -> JSM ()

117116replaceElementContents e df = do

118117 setInnerHTML e $ Just ("" :: String)

119− _ <- appendChildUnchecked e $ Just df

118+ _ <- appendChild e df

120119 return ()

121120

122121{-# INLINABLE attachWidget' #-}

123122attachWidget' :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM (a, FireCommand Spider (SpiderHost Global))

124123attachWidget' rootElement jsSing w = do

125124 doc <- getOwnerDocumentUnchecked rootElement

126− df <- createDocumentFragmentUnchecked doc

125+ df <- createDocumentFragment doc

127126 ((a, events), fc) <- liftIO . attachWidget'' $ \events -> do

128127 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

129128 unreadyChildren <- liftIO $ newIORef 0

@@ -170,11 +169,11 @@ mainWidgetInElementById eid w = withJSContextSingleton $ \jsSing -> do

170169 root <- getElementByIdUnchecked doc eid

171170 attachWidget root jsSing w

172171

173−data AppInput t = AppInput

172+newtype AppInput t = AppInput

174173 { _appInput_window :: Window t

175174 }

176175

177−data AppOutput t = AppOutput --TODO: Add quit event

176+newtype AppOutput t = AppOutput --TODO: Add quit event

178177 { _appOutput_windowConfig :: WindowConfig t

179178 }

180179

@@ -182,7 +181,7 @@ runApp' :: (t ~ Spider) => (forall x. AppInput t -> Widget x (AppOutput t)) -> J

182181runApp' app = withJSContextSingleton $ \jsSing -> do

183182 doc <- currentDocumentUnchecked

184183 body <- getBodyUnchecked doc

185− win <- getDefaultViewUnchecked doc

184+ win <- getDefaultView doc

186185 rec o <- attachWidget body jsSing $ do

187186 w <- lift $ wrapWindow win $ _appOutput_windowConfig o

188187 app $ AppInput

reflex-dom-core/src/Reflex/Dom/Old.hs+11−14

@@ -61,17 +61,16 @@ import Data.Dependent.Map as DMap

6161import Data.Functor.Misc

6262import Data.Map (Map)

6363import qualified Data.Map as Map

64−import Data.Maybe

6564import Data.Set (Set)

6665import qualified Data.Set as Set

67−import Data.Text

66+import Data.Text (Text)

6867import Foreign.JavaScript.TH

6968import qualified GHCJS.DOM.Element as Element

7069import GHCJS.DOM.EventM (EventM)

7170import GHCJS.DOM.NamedNodeMap as NNM

72−import GHCJS.DOM.Node (getFirstChild, getNodeName, removeChildUnchecked)

71+import GHCJS.DOM.Node (getFirstChild, getNodeName, removeChild)

7372import GHCJS.DOM.Types

74− (MonadJSM, liftJSM, JSM, IsElement, IsNode)

73+ (MonadJSM, liftJSM, JSM, IsHTMLElement, IsNode)

7574import qualified GHCJS.DOM.Types as DOM

7675import Reflex.Class

7776import Reflex.Dom.Builder.Class

@@ -180,7 +179,7 @@ buildElementCommon :: MonadWidget t m => Text -> m a -> ElementConfig er t m ->

180179buildElementCommon elementTag child cfg = element elementTag cfg child

181180

182181

183−onEventName :: IsElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())

182+onEventName :: IsHTMLElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())

184183onEventName = elementOnEventName

185184

186185schedulePostBuild :: (PostBuild t m, PerformEvent t m) => WidgetHost m () -> m ()

@@ -223,14 +222,14 @@ _el_events :: Element er d t -> EventSelector t (WrapArg er EventName)

223222_el_events = _element_events

224223

225224{-# DEPRECATED _el_keypress "Use 'domEvent Keypress' instead" #-}

226−_el_keypress :: Reflex t => El t -> Event t Int

225+_el_keypress :: Reflex t => El t -> Event t Word

227226_el_keypress = domEvent Keypress

228227

229228{-# DEPRECATED _el_scrolled "Use 'domEvent Scroll' instead" #-}

230−_el_scrolled :: Reflex t => El t -> Event t Int

229+_el_scrolled :: Reflex t => El t -> Event t Double

231230_el_scrolled = domEvent Scroll

232231

233−wrapElement :: forall t m. MonadWidget t m => (forall en. DOM.Element -> EventName en -> EventM DOM.Element (EventType en) (Maybe (EventResult en))) -> DOM.Element -> m (El t)

232+wrapElement :: forall t m. MonadWidget t m => (forall en. DOM.HTMLElement -> EventName en -> EventM DOM.Element (EventType en) (Maybe (EventResult en))) -> DOM.HTMLElement -> m (El t)

234233wrapElement eh e = do

235234 let h :: (EventName en, GhcjsDomEvent en) -> JSM (Maybe (EventResult en))

236235 h (en, GhcjsDomEvent evt) = runReaderT (eh e en) evt

@@ -240,7 +239,7 @@ wrapElement eh e = do

240239 }

241240 }

242241

243−unsafePlaceElement :: MonadWidget t m => DOM.Element -> m (Element EventResult (DomBuilderSpace m) t)

242+unsafePlaceElement :: MonadWidget t m => DOM.HTMLElement -> m (Element EventResult (DomBuilderSpace m) t)

244243unsafePlaceElement e = do

245244 placeRawElement e

246245 wrapRawElement e def

@@ -248,10 +247,8 @@ unsafePlaceElement e = do

248247namedNodeMapGetNames :: DOM.NamedNodeMap -> JSM (Set Text)

249248namedNodeMapGetNames self = do

250249 l <- NNM.getLength self

251− let locations = if l == 0 then [] else [0..l-1] -- Can't use 0..l-1 if l is 0 because l is unsigned and will wrap around

252− fmap (Set.fromList . catMaybes) $ forM locations $ \i -> do

253− n <- NNM.itemUnchecked self i

254− getNodeName n

250+ Set.fromList <$> forM (take (fromIntegral l) [0..]) (

251+ NNM.itemUnchecked self >=> getNodeName)

255252

256253nodeClear :: IsNode self => self -> JSM ()

257254nodeClear n = do

@@ -259,7 +256,7 @@ nodeClear n = do

259256 case mfc of

260257 Nothing -> return ()

261258 Just fc -> do

262− _ <- removeChildUnchecked n $ Just fc

259+ _ <- removeChild n fc

263260 nodeClear n

264261

265262elStopPropagationNS :: forall t m en a. (MonadWidget t m) => Maybe Text -> Text -> EventName en -> m a -> m a

reflex-dom-core/src/Reflex/Dom/WebSocket/Foreign.hs+5−5

@@ -21,13 +21,13 @@ import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)

2121import GHCJS.DOM.CloseEvent

2222import GHCJS.DOM.EventM (on)

2323import GHCJS.DOM.MessageEvent

24−import GHCJS.DOM.Types hiding (Text)

24+import GHCJS.DOM.Types hiding (Text, ByteString)

2525import qualified GHCJS.DOM.WebSocket as GD

2626import GHCJS.Foreign (JSType(..), jsTypeOf)

2727import Language.Javascript.JSaddle.Helper (mutableArrayBufferFromJSVal)

2828import Language.Javascript.JSaddle.Types (ghcjsPure)

2929

30−data JSWebSocket = JSWebSocket { unWebSocket :: WebSocket }

30+newtype JSWebSocket = JSWebSocket { unWebSocket :: WebSocket }

3131

3232class IsWebSocketMessage a where

3333 webSocketSend :: JSWebSocket -> a -> JSM ()

@@ -37,14 +37,14 @@ class IsWebSocketMessage a where

3737instance IsWebSocketMessage ByteString where

3838 webSocketSend (JSWebSocket ws) bs = do

3939 ab <- bsToArrayBuffer bs

40− GD.send ws $ Just ab

40+ GD.send ws ab

4141

4242-- Use plaintext websocket communication for Text, and String

4343instance IsWebSocketMessage Text where

4444 webSocketSend (JSWebSocket ws) = GD.sendString ws . T.unpack

4545

4646closeWebSocket :: JSWebSocket -> Word -> Text -> JSM ()

47−closeWebSocket (JSWebSocket ws) = GD.close ws

47+closeWebSocket (JSWebSocket ws) code reason = GD.close ws (Just code) (Just reason)

4848

4949newWebSocket

5050 :: a

@@ -55,7 +55,7 @@ newWebSocket

5555 -> ((Bool, Word, Text) -> JSM ()) -- onclose

5656 -> JSM JSWebSocket

5757newWebSocket _ url onMessage onOpen onError onClose = do

58− ws <- GD.newWebSocket url (Just [] :: Maybe [Text])

58+ ws <- GD.newWebSocket url ([] :: [Text])

5959 GD.setBinaryType ws "arraybuffer"

6060 _ <- on ws GD.open $ liftJSM onOpen

6161 _ <- on ws GD.error $ liftJSM onError

reflex-dom-core/src/Reflex/Dom/Widget/Basic.hs+4−4

@@ -397,7 +397,7 @@ elDynHtmlAttr' elementTag attrs html = do

397397 wrapElement defaultDomEventHandler e

398398-}

399399

400−data Link t

400+newtype Link t

401401 = Link { _link_clicked :: Event t ()

402402 }

403403

@@ -446,11 +446,11 @@ tableDynAttr :: forall t m r k v. (Ord k, DomBuilder t m, MonadHold t m, PostBui

446446 -> Dynamic t (Map k r) -- ^ Map from row key to row value

447447 -> (k -> m (Dynamic t (Map Text Text))) -- ^ Function to compute <tr> element attributes from row key

448448 -> m (Dynamic t (Map k (Element EventResult (DomBuilderSpace m) t, [v]))) -- ^ Map from row key to (El, list of widget return values)

449−tableDynAttr klass cols dRows rowAttrs = elAttr "div" (Map.singleton "style" "zoom: 1; overflow: auto; background: white;") $ do

449+tableDynAttr klass cols dRows rowAttrs = elAttr "div" (Map.singleton "style" "zoom: 1; overflow: auto; background: white;") $

450450 elAttr "table" (Map.singleton "class" klass) $ do

451− el "thead" $ el "tr" $ do

451+ el "thead" $ el "tr" $

452452 mapM_ (\(h, _) -> el "th" $ text h) cols

453− el "tbody" $ do

453+ el "tbody" $

454454 listWithKey dRows (\k r -> do

455455 dAttrs <- rowAttrs k

456456 elDynAttr' "tr" dAttrs $ mapM (\x -> el "td" $ snd x k r) cols)

reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+17−17

@@ -33,13 +33,13 @@ import Data.Maybe

3333import Data.Semigroup

3434import Data.Text (Text)

3535import qualified Data.Text as T

36−import qualified GHCJS.DOM.Element as Element

36+import qualified GHCJS.DOM.GlobalEventHandlers as Events

3737import GHCJS.DOM.EventM (on)

3838import qualified GHCJS.DOM.FileList as FileList

3939import GHCJS.DOM.HTMLInputElement (HTMLInputElement)

4040import GHCJS.DOM.HTMLTextAreaElement (HTMLTextAreaElement)

4141import GHCJS.DOM.Types (MonadJSM, File, uncheckedCastTo)

42−import qualified GHCJS.DOM.Types as DOM (Element(..), EventTarget(..))

42+import qualified GHCJS.DOM.Types as DOM (HTMLElement(..), EventTarget(..))

4343import Reflex.Class

4444import Reflex.Dom.Builder.Class

4545import Reflex.Dom.Builder.Immediate

@@ -56,9 +56,9 @@ import qualified GHCJS.DOM.HTMLInputElement as Input

5656data TextInput t

5757 = TextInput { _textInput_value :: Dynamic t Text

5858 , _textInput_input :: Event t Text

59− , _textInput_keypress :: Event t Int

60− , _textInput_keydown :: Event t Int

61− , _textInput_keyup :: Event t Int

59+ , _textInput_keypress :: Event t Word

60+ , _textInput_keydown :: Event t Word

61+ , _textInput_keyup :: Event t Word

6262 , _textInput_hasFocus :: Dynamic t Bool

6363 , _textInput_builderElement :: InputElement EventResult GhcjsDomSpace t

6464 }

@@ -110,8 +110,8 @@ textInputGetEnter :: Reflex t => TextInput t -> Event t ()

110110textInputGetEnter = keypress Enter

111111

112112{-# INLINABLE keypress #-}

113−keypress :: (Reflex t, HasDomEvent t e 'KeypressTag, DomEventType e 'KeypressTag ~ Int) => Key -> e -> Event t ()

114−keypress key i = fmapMaybe (\n -> if keyCodeLookup n == key then Just () else Nothing) $ domEvent Keypress i

113+keypress :: (Reflex t, HasDomEvent t e 'KeypressTag, DomEventType e 'KeypressTag ~ Word) => Key -> e -> Event t ()

114+keypress key i = fmapMaybe (\n -> if keyCodeLookup (fromIntegral n) == key then Just () else Nothing) $ domEvent Keypress i

115115

116116data RangeInputConfig t

117117 = RangeInputConfig { _rangeInputConfig_initialValue :: Float

@@ -169,7 +169,7 @@ data TextArea t

169169 = TextArea { _textArea_value :: Dynamic t Text

170170 , _textArea_input :: Event t Text

171171 , _textArea_hasFocus :: Dynamic t Bool

172− , _textArea_keypress :: Event t Int

172+ , _textArea_keypress :: Event t Word

173173 , _textArea_element :: HTMLTextAreaElement

174174 }

175175

@@ -287,7 +287,7 @@ checkboxView dAttrs dValue = do

287287 postBuild <- getPostBuild

288288 let filters :: DMap EventName (GhcjsEventFilter CheckboxViewEventResult)

289289 filters = DMap.singleton Click $ GhcjsEventFilter $ \(GhcjsDomEvent evt) -> do

290− t <- Event.getTargetUnchecked evt

290+ t <- Event.getTarget evt

291291 b <- Input.getChecked $ uncheckedCastTo Input.HTMLInputElement t

292292 return $ (,) preventDefault $ return $ Just $ CheckboxViewEventResult b

293293 elementConfig :: ElementConfig CheckboxViewEventResult t m

@@ -299,8 +299,8 @@ checkboxView dAttrs dValue = do

299299 , _ghcjsEventSpec_handler = GhcjsEventHandler $ \(en, GhcjsDomEvent evt) -> case en of

300300 Click -> error "impossible"

301301 _ -> do

302− e :: DOM.EventTarget <- withIsEvent en $ Event.getTargetUnchecked evt

303− let myElement = uncheckedCastTo DOM.Element e

302+ e :: DOM.EventTarget <- withIsEvent en $ Event.getTarget evt

303+ let myElement = uncheckedCastTo DOM.HTMLElement e

304304 mr <- runReaderT (defaultDomEventHandler myElement en) evt

305305 return $ ffor mr $ \(EventResult r) -> CheckboxViewEventResult $ regularToCheckboxViewEventType en r

306306 }

@@ -317,7 +317,7 @@ data FileInput d t

317317 , _fileInput_element :: RawInputElement d

318318 }

319319

320−data FileInputConfig t

320+newtype FileInputConfig t

321321 = FileInputConfig { _fileInputConfig_attributes :: Dynamic t (Map Text Text)

322322 }

323323

@@ -339,7 +339,7 @@ fileInput config = do

339339 cfg = (def :: InputElementConfig EventResult t m) & inputElementConfig_elementConfig .~ elCfg

340340 eRaw <- inputElement cfg

341341 let e = _inputElement_raw eRaw

342− eChange <- wrapDomEvent e (`on` Element.change) $ do

342+ eChange <- wrapDomEvent e (`on` Events.change) $ do

343343 files <- Input.getFilesUnchecked e

344344 len <- FileList.getLength files

345345 mapM (fmap (fromMaybe (error "fileInput: fileList.item returned null")) . FileList.item files) [0 .. len-1]

@@ -481,7 +481,7 @@ textArea_hasFocus f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea x1 x2 y x4 x5) <

481481textArea_input :: Lens' (TextArea t) (Event t Text)

482482textArea_input f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea x1 y x3 x4 x5) <$> f x2

483483{-# INLINE textArea_input #-}

484−textArea_keypress :: Lens' (TextArea t) (Event t Int)

484+textArea_keypress :: Lens' (TextArea t) (Event t Word)

485485textArea_keypress f (TextArea x1 x2 x3 x4 x5) = (\y -> TextArea x1 x2 x3 y x5) <$> f x4

486486{-# INLINE textArea_keypress #-}

487487textArea_value :: Lens' (TextArea t) (Dynamic t Text)

@@ -508,13 +508,13 @@ textInput_hasFocus f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 x

508508textInput_input :: Lens' (TextInput t) (Event t Text)

509509textInput_input f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 y x3 x4 x5 x6 x7) <$> f x2

510510{-# INLINE textInput_input #-}

511−textInput_keydown :: Lens' (TextInput t) (Event t Int)

511+textInput_keydown :: Lens' (TextInput t) (Event t Word)

512512textInput_keydown f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 x3 y x5 x6 x7) <$> f x4

513513{-# INLINE textInput_keydown #-}

514−textInput_keypress :: Lens' (TextInput t) (Event t Int)

514+textInput_keypress :: Lens' (TextInput t) (Event t Word)

515515textInput_keypress f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 y x4 x5 x6 x7) <$> f x3

516516{-# INLINE textInput_keypress #-}

517−textInput_keyup :: Lens' (TextInput t) (Event t Int)

517+textInput_keyup :: Lens' (TextInput t) (Event t Word)

518518textInput_keyup f (TextInput x1 x2 x3 x4 x5 x6 x7) = (\y -> TextInput x1 x2 x3 x4 y x6 x7) <$> f x5

519519{-# INLINE textInput_keyup #-}

520520textInput_value :: Lens' (TextInput t) (Dynamic t Text)

reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs+2−2

@@ -52,7 +52,7 @@ virtualListWithSelection heightPx rowPx maxIndex i0 setI listTag listAttrs rowTa

5252 return lis

5353 selected <- holdDyn (indexToKey i0) sel

5454 pb <- getPostBuild

55− scrollPosition <- holdDyn 0 $ leftmost [ domEvent Scroll container

55+ scrollPosition <- holdDyn 0 $ leftmost [ round <$> domEvent Scroll container

5656 , fmap (const (i0 * rowPx)) pb

5757 ]

5858 let window = zipDynWith (findWindow rowPx) heightPx scrollPosition

@@ -98,7 +98,7 @@ virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemsUpdate itemBu

9898 pb <- getPostBuild

9999 rec (viewport, result) <- elDynAttr "div" containerStyle $ elDynAttr' "div" viewportStyle $ elDynAttr "div" virtualH $

100100 listWithKeyShallowDiff items0 itemsUpdate $ \k v e -> elAttr "div" (mkRow k) $ itemBuilder k v e

101− scrollPosition <- holdDyn 0 $ leftmost [ domEvent Scroll viewport

101+ scrollPosition <- holdDyn 0 $ leftmost [ round <$> domEvent Scroll viewport

102102 , fmap (const (i0 * rowPx)) pb

103103 ]

104104 let window = zipDynWith (findWindow rowPx) heightPx scrollPosition

reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+4−3

@@ -24,7 +24,8 @@ import qualified Data.Map as Map

2424import Data.Monoid

2525import Data.Text (Text)

2626import qualified Data.Text as T

27−import GHCJS.DOM.Element hiding (reset)

27+import GHCJS.DOM.Element

28+import qualified GHCJS.DOM.GlobalEventHandlers as Events (scroll)

2829import GHCJS.DOM.EventM (on)

2930import GHCJS.DOM.Types (liftJSM, MonadJSM)

3031

@@ -78,8 +79,8 @@ resizeDetectorWithAttrs attrs w = do

7879 then return Nothing

7980 else fmap Just reset

8081 pb <- delay 0 =<< getPostBuild

81− expandScroll <- wrapDomEvent (_element_raw expand) (`on` scroll) $ return ()

82− shrinkScroll <- wrapDomEvent (_element_raw shrink) (`on` scroll) $ return ()

82+ expandScroll <- wrapDomEvent (_element_raw expand) (`on` Events.scroll) $ return ()

83+ shrinkScroll <- wrapDomEvent (_element_raw shrink) (`on` Events.scroll) $ return ()

8384 size0 <- performEvent $ fmap (const $ liftJSM reset) pb

8485 rec resize <- performEventAsync $ fmap (\d cb -> (liftIO . cb) =<< liftJSM (resetIfChanged d)) $ tag (current dimensions) $ leftmost [expandScroll, shrinkScroll]

8586 dimensions <- holdDyn (Nothing, Nothing) $ leftmost [ size0, fmapMaybe id resize ]

reflex-dom-core/src/Reflex/Dom/Xhr/Foreign.hs+8−11

@@ -10,7 +10,6 @@ module Reflex.Dom.Xhr.Foreign (

1010) where

1111

1212import Control.Exception (throwIO)

13−import Control.Monad (join)

1413import Control.Monad.IO.Class (MonadIO(..))

1514import Data.Maybe (fromMaybe)

1615import Data.Text (Text)

@@ -19,7 +18,7 @@ import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)

1918import GHCJS.DOM.Enums

2019import GHCJS.DOM.EventM (EventM, on)

2120import GHCJS.DOM.EventTarget (dispatchEvent)

22−import GHCJS.DOM.Types hiding (Text)

21+import GHCJS.DOM.Types hiding (Text, ByteString)

2322import GHCJS.DOM.XMLHttpRequest

2423import Language.Javascript.JSaddle.Helper (mutableArrayBufferFromJSVal)

2524import qualified Language.Javascript.JSaddle.Monad as JS (catch)

@@ -33,7 +32,7 @@ xmlHttpRequestNew = newXMLHttpRequest

3332xmlHttpRequestOpen ::

3433 (ToJSString method, ToJSString url, ToJSString user, ToJSString password, MonadJSM m) =>

3534 XMLHttpRequest -> method -> url -> Bool -> user -> password -> m ()

36−xmlHttpRequestOpen = open

35+xmlHttpRequestOpen request method url async user password = open request method url async (Just user) (Just password)

3736

3837convertException :: XHRError -> XhrException

3938convertException e = case e of

@@ -82,7 +81,7 @@ xmlHttpRequestAbort :: MonadJSM m => XMLHttpRequest -> m ()

8281xmlHttpRequestAbort = abort

8382

8483xmlHttpRequestGetAllResponseHeaders :: MonadJSM m => XMLHttpRequest -> m Text

85−xmlHttpRequestGetAllResponseHeaders self = fromMaybe "" <$> getAllResponseHeaders self

84+xmlHttpRequestGetAllResponseHeaders = getAllResponseHeaders

8685

8786xmlHttpRequestGetResponseHeader :: (ToJSString header, MonadJSM m)

8887 => XMLHttpRequest -> header -> m Text

@@ -91,7 +90,7 @@ xmlHttpRequestGetResponseHeader self header = fromMaybe "" <$> getResponseHeader

9190xmlHttpRequestOverrideMimeType :: (ToJSString override, MonadJSM m) => XMLHttpRequest -> override -> m ()

9291xmlHttpRequestOverrideMimeType = overrideMimeType

9392

94−xmlHttpRequestDispatchEvent :: (IsEvent evt, MonadJSM m) => XMLHttpRequest -> Maybe evt -> m Bool

93+xmlHttpRequestDispatchEvent :: (IsEvent evt, MonadJSM m) => XMLHttpRequest -> evt -> m Bool

9594xmlHttpRequestDispatchEvent = dispatchEvent

9695

9796xmlHttpRequestOnabort :: XMLHttpRequest -> EventM XMLHttpRequest XMLHttpRequestProgressEvent () -> JSM (JSM ())

@@ -134,7 +133,7 @@ xmlHttpRequestGetWithCredentials :: MonadJSM m => XMLHttpRequest -> m Bool

134133xmlHttpRequestGetWithCredentials = getWithCredentials

135134

136135xmlHttpRequestGetUpload :: MonadJSM m => XMLHttpRequest -> m (Maybe XMLHttpRequestUpload)

137−xmlHttpRequestGetUpload = getUpload

136+xmlHttpRequestGetUpload = fmap Just . getUpload

138137

139138xmlHttpRequestGetResponseText :: (FromJSString result, MonadJSM m) => XMLHttpRequest -> m (Maybe result)

140139xmlHttpRequestGetResponseText = getResponseText

@@ -175,12 +174,10 @@ xmlHttpRequestGetResponse xhr = do

175174 mr <- getResponse xhr

176175 rt <- xmlHttpRequestGetResponseType xhr

177176 case rt of

178− Just XhrResponseType_Blob -> fmap XhrResponseBody_Blob . join <$> mapM (castTo Blob) mr

177+ Just XhrResponseType_Blob -> fmap XhrResponseBody_Blob <$> castTo Blob mr

179178 Just XhrResponseType_Text -> Just . XhrResponseBody_Text <$> xmlHttpRequestGetStatusText xhr

180179 Just XhrResponseType_Default -> Just . XhrResponseBody_Text <$> xmlHttpRequestGetStatusText xhr

181− Just XhrResponseType_ArrayBuffer -> case fmap unGObject mr of

182− Nothing -> return Nothing

183− Just ptr -> do

184− ab <- liftJSM $ mutableArrayBufferFromJSVal ptr

180+ Just XhrResponseType_ArrayBuffer -> do

181+ ab <- liftJSM $ mutableArrayBufferFromJSVal mr

185182 Just . XhrResponseBody_ArrayBuffer <$> bsFromMutableArrayBuffer ab

186183 _ -> return Nothing