2da056c · reflex-dom · git.iko.soy

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

compare with develop

unifiedsplit

@@ -50,8 +50,8 @@ library

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

51 directory >= 1.2 && < 1.4,

52 exception-transformers == 0.4.*,

53− ghcjs-dom >= 0.8.0.0 && < 0.9,

53+ ghcjs-dom >= 0.9.0.0 && < 0.10,

54− jsaddle >=0.8.0.1 && <0.9,

54+ jsaddle >=0.9.0.0 && <0.10,

55 -- keycode-0.2 has a bug on firefox

56 keycode >= 0.2.1 && < 0.3,

57 lens >= 4.7 && < 5,

reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+7−15

@@ -14,23 +14,15 @@ import Reflex.PerformEvent.Base (PerformEventT (..))

14import Reflex.PostBuild.Base (PostBuildT)

15import Reflex.Requester.Base (RequesterT)

16import Reflex.TriggerEvent.Base

17+import Reflex.Query.Base (QueryT)

17

18

18−instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m) where

19+instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m)

19− liftJSM' = lift . liftJSM'

20−

21instance (MonadJSM (HostFrame t), ReflexHost t) => MonadJSM (PerformEventT t m) where

20instance (MonadJSM (HostFrame t), ReflexHost t) => MonadJSM (PerformEventT t m) where

22 liftJSM' = PerformEventT . lift . liftJSM'

21 liftJSM' = PerformEventT . lift . liftJSM'

23−

24−instance MonadJSM m => MonadJSM (DynamicWriterT t w m) where

22+instance MonadJSM m => MonadJSM (DynamicWriterT t w m)

25− liftJSM' = lift . liftJSM'

26−

27−instance MonadJSM m => MonadJSM (EventWriterT t w m) where

23+instance MonadJSM m => MonadJSM (EventWriterT t w m)

28− liftJSM' = lift . liftJSM'

29−

30−instance MonadJSM m => MonadJSM (RequesterT t request response m) where

24+instance MonadJSM m => MonadJSM (RequesterT t request response m)

31− liftJSM' = lift . liftJSM'

32−

33−instance MonadJSM m => MonadJSM (TriggerEventT t m) where

25+instance MonadJSM m => MonadJSM (TriggerEventT t m)

34− liftJSM' = lift . liftJSM'

26+instance MonadJSM m => MonadJSM (QueryT t q m)

35

27

36#endif

28#endif

reflex-dom-core/src/Foreign/JavaScript/TH.hs+1

@@ -36,6 +36,7 @@ import Reflex.PerformEvent.Class

36import Reflex.PostBuild.Base

37import Reflex.Query.Base

38import Reflex.Requester.Base

39+import Reflex.Query.Base (QueryT(..))

39

40

40#ifdef USE_TEMPLATE_HASKELL

41#ifdef USE_TEMPLATE_HASKELL

41import Language.Haskell.TH

42import Language.Haskell.TH

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

@@ -37,6 +37,8 @@ import Reflex.PostBuild.Base

37import Reflex.Query.Base

38import Reflex.Query.Class

39import Reflex.Requester.Base

40+import Reflex.Query.Base

41+import Reflex.Query.Class

40

42

41import qualified Control.Category

43import qualified Control.Category

42import Control.Lens hiding (element)

44import Control.Lens hiding (element)

@@ -625,6 +627,27 @@ instance Reflex t => HasDomEvent t (TextAreaElement EventResult d t) en where

625instance DomBuilder t m => DomBuilder t (ReaderT r m) where

627instance DomBuilder t m => DomBuilder t (ReaderT r m) where

626 type DomBuilderSpace (ReaderT r m) = DomBuilderSpace m

628 type DomBuilderSpace (ReaderT r m) = DomBuilderSpace m

627

629

630+instance (DomBuilder t m, MonadFix m, MonadHold t m, Group q, Query q, Additive q) => DomBuilder t (QueryT t q m) where

631+ type DomBuilderSpace (QueryT t q m) = DomBuilderSpace m

632+ textNode = liftTextNode

633+ element elementTag cfg (QueryT child) = QueryT $ do

634+ s <- get

635+ let cfg' = cfg

636+ { _elementConfig_eventSpec = _elementConfig_eventSpec cfg }

637+ (e, (a, newS)) <- lift $ element elementTag cfg' $ runStateT child s

638+ put newS

639+ return (e, a)

640+

641+ inputElement = lift . inputElement

642+ textAreaElement = lift . textAreaElement

643+ selectElement cfg (QueryT child) = QueryT $ do

644+ s <- get

645+ (e, (a, newS)) <- lift $ selectElement cfg $ runStateT child s

646+ put newS

647+ return (e, a)

648+ placeRawElement = lift . placeRawElement

649+ wrapRawElement e = lift . wrapRawElement e

650+

628type LiftDomBuilder t f m =

651type LiftDomBuilder t f m =

629 ( Reflex t

652 ( Reflex t

630 , MonadTransControlStateless f

653 , MonadTransControlStateless f

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+12−7

@@ -93,6 +93,7 @@ import Reflex.PostBuild.Class

93import Reflex.TriggerEvent.Base hiding (askEvents)

94import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)

95import Reflex.TriggerEvent.Class

96+import Reflex.Query.Base (QueryT)

96

97

97import Control.Concurrent

98import Control.Concurrent

98import Control.Lens hiding (element, ix)

99import Control.Lens hiding (element, ix)

@@ -129,6 +130,7 @@ import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setA

129import qualified GHCJS.DOM.Element as Element

130import qualified GHCJS.DOM.Element as Element

130import qualified GHCJS.DOM.Event as Event

131import qualified GHCJS.DOM.Event as Event

131import qualified GHCJS.DOM.GlobalEventHandlers as Events

132import qualified GHCJS.DOM.GlobalEventHandlers as Events

133+import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events

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

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

133import qualified GHCJS.DOM.EventM as DOM

135import qualified GHCJS.DOM.EventM as DOM

134import qualified GHCJS.DOM.FileList as FileList

136import qualified GHCJS.DOM.FileList as FileList

@@ -232,6 +234,8 @@ instance HasDocument m => HasDocument (Lazy.StateT s m)

232instance HasDocument m => HasDocument (EventWriterT t w m)

234instance HasDocument m => HasDocument (EventWriterT t w m)

233instance HasDocument m => HasDocument (DynamicWriterT t w m)

235instance HasDocument m => HasDocument (DynamicWriterT t w m)

234instance HasDocument m => HasDocument (PostBuildT t m)

236instance HasDocument m => HasDocument (PostBuildT t m)

237+instance HasDocument m => HasDocument (RequesterT t request response m)

238+instance HasDocument m => HasDocument (QueryT t q m)

235

239

236instance Monad m => HasDocument (ImmediateDomBuilderT t m) where

240instance Monad m => HasDocument (ImmediateDomBuilderT t m) where

237 {-# INLINABLE askDocument #-}

241 {-# INLINABLE askDocument #-}

@@ -449,7 +453,7 @@ instance er ~ EventResult => Default (GhcjsEventSpec er) where

449 def = GhcjsEventSpec

453 def = GhcjsEventSpec

450 { _ghcjsEventSpec_filters = mempty

454 { _ghcjsEventSpec_filters = mempty

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

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

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

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

453 let e = uncheckedCastTo DOM.Element t

457 let e = uncheckedCastTo DOM.Element t

454 runReaderT (defaultDomEventHandler e en) evt

458 runReaderT (defaultDomEventHandler e en) evt

455 }

459 }

@@ -1181,6 +1185,7 @@ instance DOM.FromJSVal ElementEventTarget where

1181 fromJSVal = fmap (fmap ElementEventTarget) . DOM.fromJSVal

1185 fromJSVal = fmap (fmap ElementEventTarget) . DOM.fromJSVal

1182instance DOM.IsEventTarget ElementEventTarget

1186instance DOM.IsEventTarget ElementEventTarget

1183instance DOM.IsGlobalEventHandlers ElementEventTarget

1187instance DOM.IsGlobalEventHandlers ElementEventTarget

1188+instance DOM.IsDocumentAndElementEventHandlers ElementEventTarget

1184

1189

1185{-# INLINABLE elementOnEventName #-}

1190{-# INLINABLE elementOnEventName #-}

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

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

@@ -1218,12 +1223,12 @@ elementOnEventName en e_ = let e = ElementEventTarget (DOM.toElement e_) in case

1218 Select -> on e Events.select

1223 Select -> on e Events.select

1219 Submit -> on e Events.submit

1224 Submit -> on e Events.submit

1220 Wheel -> on e Events.wheel

1225 Wheel -> on e Events.wheel

1221− Beforecut -> on e Element.beforeCut

1226+ Beforecut -> on e Events.beforeCut

1222− Cut -> on e Element.cut

1227+ Cut -> on e Events.cut

1223− Beforecopy -> on e Element.beforeCopy

1228+ Beforecopy -> on e Events.beforeCopy

1224− Copy -> on e Element.copy

1229+ Copy -> on e Events.copy

1225− Beforepaste -> on e Element.beforePaste

1230+ Beforepaste -> on e Events.beforePaste

1226− Paste -> on e Element.paste

1231+ Paste -> on e Events.paste

1227 Reset -> on e Events.reset

1232 Reset -> on e Events.reset

1228 Search -> on e Events.search

1233 Search -> on e Events.search

1229 Selectstart -> on e Element.selectStart

1234 Selectstart -> on e Element.selectStart

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

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

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

182 doc <- currentDocumentUnchecked

183 body <- getBodyUnchecked doc

184− win <- getDefaultView doc

184+ win <- getDefaultViewUnchecked doc

185 rec o <- attachWidget body jsSing $ do

186 w <- lift $ wrapWindow win $ _appOutput_windowConfig o

187 app $ AppInput

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

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

287 postBuild <- getPostBuild

288 let filters :: DMap EventName (GhcjsEventFilter CheckboxViewEventResult)

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

290− t <- Event.getTarget evt

290+ t <- Event.getTargetUnchecked evt

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

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

293 elementConfig :: ElementConfig CheckboxViewEventResult t (DomBuilderSpace m)

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

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

300 Click -> error "impossible"

301 _ -> do

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

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

303 let myElement = uncheckedCastTo DOM.HTMLElement e

304 mr <- runReaderT (defaultDomEventHandler myElement en) evt

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

reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+9−7

@@ -27,7 +27,8 @@ import qualified Data.Text as T

27import GHCJS.DOM.Element

28import GHCJS.DOM.EventM (on)

29import qualified GHCJS.DOM.GlobalEventHandlers as Events (scroll)

30−import GHCJS.DOM.Types (MonadJSM, liftJSM)

30+import GHCJS.DOM.Types (MonadJSM, liftJSM, uncheckedCastTo, HTMLElement(..))

31+import GHCJS.DOM.HTMLElement (getOffsetWidth, getOffsetHeight)

31import qualified GHCJS.DOM.Types as DOM

32import qualified GHCJS.DOM.Types as DOM

32

33

33-- | A widget that wraps the given widget in a div and fires an event when resized.

34-- | A widget that wraps the given widget in a div and fires an event when resized.

@@ -54,8 +55,9 @@ resizeDetectorWithAttrs attrs w = do

54 (expand, (expandChild, _)) <- elAttr' "div" containerAttrs $ elAttr' "div" ("style" =: childStyle) $ return ()

55 (expand, (expandChild, _)) <- elAttr' "div" containerAttrs $ elAttr' "div" ("style" =: childStyle) $ return ()

55 (shrink, _) <- elAttr' "div" containerAttrs $ elAttr "div" ("style" =: (childStyle <> "width: 200%; height: 200%;")) $ return ()

56 (shrink, _) <- elAttr' "div" containerAttrs $ elAttr "div" ("style" =: (childStyle <> "width: 200%; height: 200%;")) $ return ()

56 return (expand, expandChild, shrink, w')

57 return (expand, expandChild, shrink, w')

58+ let p = uncheckedCastTo HTMLElement $ _element_raw parent

57− let reset = do

59+ reset = do

58− let e = _element_raw expand

60+ let e = uncheckedCastTo HTMLElement $ _element_raw expand

59 s = _element_raw shrink

61 s = _element_raw shrink

60 eow <- getOffsetWidth e

62 eow <- getOffsetWidth e

61 eoh <- getOffsetHeight e

63 eoh <- getOffsetHeight e

@@ -70,12 +72,12 @@ resizeDetectorWithAttrs attrs w = do

70 setScrollLeft s ssw

72 setScrollLeft s ssw

71 ssh <- getScrollHeight s

73 ssh <- getScrollHeight s

72 setScrollTop s ssh

74 setScrollTop s ssh

73− lastWidth <- getOffsetWidth (_element_raw parent)

75+ lastWidth <- getOffsetWidth p

74− lastHeight <- getOffsetHeight (_element_raw parent)

76+ lastHeight <- getOffsetHeight p

75 return (Just lastWidth, Just lastHeight)

77 return (Just lastWidth, Just lastHeight)

76 resetIfChanged ds = do

78 resetIfChanged ds = do

77− pow <- getOffsetWidth (_element_raw parent)

79+ pow <- getOffsetWidth p

78− poh <- getOffsetHeight (_element_raw parent)

80+ poh <- getOffsetHeight p

79 if ds == (Just pow, Just poh)

81 if ds == (Just pow, Just poh)

80 then return Nothing

82 then return Nothing

81 else fmap Just reset

83 else fmap Just reset