bf99e40 · reflex-dom · git.iko.soy

reflex-dom.cabal+1

compare with develop

unifiedsplit

@@ -100,6 +100,7 @@ library

100-- Reflex.Dom.Xhr.Exception

101

102 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

103+

103 if flag(use-reflex-optimizer)

104 if flag(use-reflex-optimizer)

104 ghc-options: -fplugin=Reflex.Optimizer

105 ghc-options: -fplugin=Reflex.Optimizer

105

106

src/Foreign/JavaScript/TH.hs+5−4

@@ -25,7 +25,8 @@ import Reflex.DynamicWriter

25import Reflex.Host.Class

26import Reflex.PerformEvent.Base

27import Reflex.PerformEvent.Class

28−import Reflex.PostBuild.Class

28+import Reflex.PostBuild.Base

29+import Reflex.Requester.Base

29

30

30import Language.Haskell.TH

31import Language.Haskell.TH

31

32

@@ -49,7 +50,6 @@ import qualified JavaScript.TypedArray.ArrayBuffer as JSArrayBuffer

49

50

50import Data.Hashable

51import Data.Hashable

51import Data.Word

52import Data.Word

52−import Data.Coerce (coerce)

53import Foreign.C.Types

54import Foreign.Ptr

55import Text.Encoding.Z

@@ -76,6 +76,7 @@ import qualified Control.Monad.State.Strict as Strict

76import Control.Monad.Trans.Control

77import Data.ByteString (ByteString)

78import qualified Data.ByteString as BS

79+import Data.Coerce (coerce)

79import Data.Monoid

80import Data.Monoid

80import Data.Text (Text)

81import Data.Text (Text)

81import qualified Data.Text as T

82import qualified Data.Text as T

@@ -222,8 +223,8 @@ instance HasJS x m => HasJS x (DynamicWriterT t w m) where

222 type JSX (DynamicWriterT t w m) = JSX m

223 type JSX (DynamicWriterT t w m) = JSX m

223 liftJS = lift . liftJS

224 liftJS = lift . liftJS

224

225

225−instance HasJS x m => HasJS x (RequestT t request response m) where

226+instance HasJS x m => HasJS x (RequesterT t request response m) where

226− type JSX (RequestT t request response m) = JSX m

227+ type JSX (RequesterT t request response m) = JSX m

227 liftJS = lift . liftJS

228 liftJS = lift . liftJS

228

229

229-- | A Monad that is capable of executing JavaScript

230-- | A Monad that is capable of executing JavaScript

src/Reflex/Dom.hs+1−1

@@ -1,6 +1,6 @@

1module Reflex.Dom (module X) where

2

3−import Reflex as X

3+import Reflex as X hiding (askEvents)

4import Reflex.Dom.Builder.Class as X

5import Reflex.Dom.Builder.Immediate as X

6import Reflex.Dom.Builder.InputDisabled as X

src/Reflex/Dom/Builder/Class.hs+6−6

@@ -22,9 +22,9 @@ module Reflex.Dom.Builder.Class

22import Reflex.Class as Reflex

23import Reflex.Dom.Builder.Class.Events

24import Reflex.DynamicWriter

25−import Reflex.PerformEvent.Base

26import Reflex.PerformEvent.Class

25import Reflex.PerformEvent.Class

27−import Reflex.PostBuild.Class

26+import Reflex.PostBuild.Base

27+import Reflex.Requester.Base

28

29import qualified Control.Category

30import Control.Lens hiding (element)

@@ -520,10 +520,10 @@ instance (DomBuilder t m, Monoid w, MonadHold t m, MonadFix m) => DomBuilder t (

520 { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg

521 }

522

523−instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RequestT t request response m) where

523+instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RequesterT t request response m) where

524− type DomBuilderSpace (RequestT t request response m) = DomBuilderSpace m

524+ type DomBuilderSpace (RequesterT t request response m) = DomBuilderSpace m

525 textNode = liftTextNode

526− element elementTag cfg (RequestT child) = RequestT $ do

526+ element elementTag cfg (RequesterT child) = RequesterT $ do

527 r <- ask

528 s <- get

529 let cfg' = liftElementConfig cfg

@@ -532,7 +532,7 @@ instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RequestT t

532 return (el, a)

533 inputElement cfg = lift $ inputElement $ cfg & inputElementConfig_elementConfig %~ liftElementConfig

534 textAreaElement cfg = lift $ textAreaElement $ cfg & textAreaElementConfig_elementConfig %~ liftElementConfig

535− selectElement cfg (RequestT child) = RequestT $ do

535+ selectElement cfg (RequesterT child) = RequesterT $ do

536 r <- ask

537 s <- get

538 let cfg' = cfg & selectElementConfig_elementConfig %~ liftElementConfig

src/Reflex/Dom/Builder/Immediate.hs+12−9

@@ -24,6 +24,8 @@ import Reflex.Dynamic

24import Reflex.Host.Class

25import Reflex.PerformEvent.Class

26import Reflex.PostBuild.Class

27+import Reflex.TriggerEvent.Class

28+import Reflex.TriggerEvent.Base hiding (askEvents)

27

29

28import Control.Concurrent.Chan

30import Control.Concurrent.Chan

29import Control.Lens hiding (element)

31import Control.Lens hiding (element)

@@ -58,8 +60,9 @@ import qualified GHCJS.DOM.HTMLInputElement as Input

58import qualified GHCJS.DOM.HTMLSelectElement as Select

60import qualified GHCJS.DOM.HTMLSelectElement as Select

59import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea

61import qualified GHCJS.DOM.HTMLTextAreaElement as TextArea

60import GHCJS.DOM.MouseEvent

62import GHCJS.DOM.MouseEvent

61−import GHCJS.DOM.Node (appendChild, getOwnerDocument, getParentNode, getPreviousSibling, insertBefore,

63+import GHCJS.DOM.Node (appendChild, getOwnerDocument, getParentNode, getPreviousSibling,

62 removeChild, setNodeValue, toNode)

64 removeChild, setNodeValue, toNode)

65+import qualified GHCJS.DOM.Node as DOM (insertBefore)

63import GHCJS.DOM.Types

66import GHCJS.DOM.Types

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

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

65 FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,

68 FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,

@@ -72,8 +75,6 @@ import Debug.Trace hiding (traceEvent)

72

75

73data TriggerRef t a = TriggerRef { unTriggerRef :: IORef (Maybe (EventTrigger t a)) }

76data TriggerRef t a = TriggerRef { unTriggerRef :: IORef (Maybe (EventTrigger t a)) }

74

77

75−data TriggerInvocation a = TriggerInvocation a (JSM ())

76−

77data ImmediateDomBuilderEnv t

78data ImmediateDomBuilderEnv t

78 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document

79 = ImmediateDomBuilderEnv { _immediateDomBuilderEnv_document :: Document

79 , _immediateDomBuilderEnv_parent :: Node

80 , _immediateDomBuilderEnv_parent :: Node

@@ -143,7 +144,7 @@ deleteBetweenInclusive s e = do

143 return ()

144 return ()

144

145

145-- | s and e must both be children of the same node and s must precede e

146-- | s and e must both be children of the same node and s must precede e

146−deleteBetweenExclusive :: (MonadIO m, IsNode start, IsNode end) => start -> end -> m ()

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

147deleteBetweenExclusive s e = do

148deleteBetweenExclusive s e = do

148 mCurrentParent <- getParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment

149 mCurrentParent <- getParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment

149 case mCurrentParent of

150 case mCurrentParent of

@@ -161,7 +162,7 @@ deleteBetweenExclusive s e = do

161

162

162-- | s and e must both be children of the same node and s must precede e; s and all nodes between s and e will be removed, but e will not be removed

163-- | s and e must both be children of the same node and s must precede e; s and all nodes between s and e will be removed, but e will not be removed

163{-# INLINABLE deleteUpTo #-}

164{-# INLINABLE deleteUpTo #-}

164−deleteUpTo :: (MonadIO m, IsNode start, IsNode end) => start -> end -> m ()

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

165deleteUpTo s e = do

166deleteUpTo s e = do

166 mCurrentParent <- getParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment

167 mCurrentParent <- getParentNode e -- May be different than it was at initial construction, e.g., because the parent may have dumped us in from a DocumentFragment

167 case mCurrentParent of

168 case mCurrentParent of

@@ -169,14 +170,16 @@ deleteUpTo s e = do

169 Just currentParent -> deleteUpToGivenParent currentParent s e

170 Just currentParent -> deleteUpToGivenParent currentParent s e

170

171

171{-# INLINABLE deleteUpToGivenParent #-}

172{-# INLINABLE deleteUpToGivenParent #-}

172−deleteUpToGivenParent :: (MonadIO m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m ()

173+deleteUpToGivenParent :: (MonadJSM m, IsNode parent, IsNode start, IsNode end) => parent -> start -> end -> m ()

173deleteUpToGivenParent currentParent s e = do

174deleteUpToGivenParent currentParent s e = do

174 fix $ \loop -> do

175 fix $ \loop -> do

175 Just x <- getPreviousSibling e -- This can't be Nothing because we should hit 's' first

176 Just x <- getPreviousSibling e -- This can't be Nothing because we should hit 's' first

176 _ <- removeChild currentParent $ Just x

177 _ <- removeChild currentParent $ Just x

177− when (toNode s /= toNode x) loop

178+ liftJSM (strictEqual s x) >>= \case

179+ True -> return ()

180+ False -> loop

178

181

179−type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadHold t m, MonadFix m, PerformEvent t m, Performable m ~ m, MonadReflexCreateTrigger t m, Deletable t m, MonadRef m, Ref m ~ Ref JSM)

182+type SupportsImmediateDomBuilder t m = (Reflex t, MonadJSM m, MonadJSM (Performable m), MonadHold t m, MonadFix m, PerformEvent t m, MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref JSM, MonadAdjust t m)

180

183

181newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))

184newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))

182

185

@@ -417,7 +420,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

417 placeRawElement = append

420 placeRawElement = append

418 wrapRawElement = wrap

421 wrapRawElement = wrap

419

422

420−instance (Reflex t, MonadAdjust t m, MonadIO m, MonadHold t m, PerformEvent t m, MonadIO (Performable m)) => MonadAdjust t (ImmediateDomBuilderT t m) where

423+instance (Reflex t, MonadAdjust t m, MonadJSM m, MonadHold t m, PerformEvent t m, MonadJSM (Performable m)) => MonadAdjust t (ImmediateDomBuilderT t m) where

421 runWithReplace a0 a' = do

424 runWithReplace a0 a' = do

422 initialEnv <- ImmediateDomBuilderT ask

425 initialEnv <- ImmediateDomBuilderT ask

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

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

src/Reflex/Dom/Builder/Static.hs+2−1

@@ -46,8 +46,9 @@ import Reflex.Dynamic

46import Reflex.Host.Class

47import Reflex.PerformEvent.Base

48import Reflex.PerformEvent.Class

49−import Reflex.PostBuild.Class

49+import Reflex.PostBuild.Base

50import Reflex.Spider

51+import Reflex.TriggerEvent.Class

51

52

52newtype StaticDomBuilderT t m a = StaticDomBuilderT

53newtype StaticDomBuilderT t m a = StaticDomBuilderT

53 { unStaticDomBuilderT :: StateT [Behavior t Builder] m a -- Accumulated Html will be in reversed order

54 { unStaticDomBuilderT :: StateT [Behavior t Builder] m a -- Accumulated Html will be in reversed order

src/Reflex/Dom/Internal.hs+20−17

@@ -22,8 +22,9 @@ import Reflex.Dom.Builder.Immediate

22import Reflex.Dom.Class

23import Reflex.Host.Class

24import Reflex.PerformEvent.Base

25−import Reflex.PostBuild.Class

25+import Reflex.PostBuild.Base

26import Reflex.Spider (Global, Spider, SpiderHost, runSpiderHost)

27+import Reflex.TriggerEvent.Base

27

28

28import Control.Concurrent

29import Control.Concurrent

29import Control.Lens

30import Control.Lens

@@ -89,21 +90,23 @@ instance MonadJSM m => MonadJSM (PostBuildT t m) where

89

90

90{-# INLINABLE attachWidget #-}

91{-# INLINABLE attachWidget #-}

91attachWidget :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM a

92attachWidget :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM a

92−attachWidget rootElement wv w = fst <$> attachWidget' rootElement wv w

93+attachWidget rootElement wv w = liftIO $ fst <$> attachWidget' rootElement wv w

93−

94+

94−mainWidgetWithHead' :: (forall x. (a -> Widget x b, b -> Widget x a)) -> IO ()

95+mainWidgetWithHead' :: (forall x. (a -> Widget x b, b -> Widget x a)) -> JSM ()

96+mainWidgetWithHead' widgets = withJSContextSingleton $ \jsSing -> do

97+ Just doc <- currentDocument

98+ Just headElement <- getHead doc

99+ Just bodyElement <- getBody doc

95−mainWidgetWithHead' widgets = runWebGUI $ \webView -> withWebViewSingleton webView $ \wv -> fmap fst $ attachWidget'' $ \events -> do

100+-- runWebGUI $ \webView -> withWebViewSingleton webView $ \wv ->

101+ liftIO $ fmap fst $ attachWidget'' $ \events -> do

96 let (headWidget, bodyWidget) = widgets

102 let (headWidget, bodyWidget) = widgets

97− Just doc <- liftIO $ fmap DOM.castToHTMLDocument <$> webViewGetDomDocument webView

98− Just headElement <- getHead doc

99− Just bodyElement <- getBody doc

100 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

103 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

101− rec b <- unsafeReplaceElementContentsWithWidget events postBuild headElement wv $ headWidget a

104+ rec b <- unsafeReplaceElementContentsWithWidget events postBuild headElement jsSing $ headWidget a

102− a <- unsafeReplaceElementContentsWithWidget events postBuild bodyElement wv $ bodyWidget b

105+ a <- unsafeReplaceElementContentsWithWidget events postBuild bodyElement jsSing $ bodyWidget b

103 return ((), postBuildTriggerRef)

106 return ((), postBuildTriggerRef)

104

107

105−unsafeReplaceElementContentsWithWidget :: DOM.IsElement e => EventChannel -> R.Event Spider () -> e -> WebViewSingleton x -> Widget x a -> PerformEventT Spider (SpiderHost Global) a

108+unsafeReplaceElementContentsWithWidget :: DOM.IsElement e => EventChannel -> R.Event Spider () -> e -> JSContextSingleton x -> Widget x a -> PerformEventT Spider (SpiderHost Global) a

106−unsafeReplaceElementContentsWithWidget events postBuild rootElement wv w = do

109+unsafeReplaceElementContentsWithWidget events postBuild rootElement jsSing w = (`runWithJSContextSingleton` jsSing) $ do

107 Just doc <- getOwnerDocument rootElement

110 Just doc <- getOwnerDocument rootElement

108 Just df <- createDocumentFragment doc

111 Just df <- createDocumentFragment doc

109 let builderEnv = ImmediateDomBuilderEnv

112 let builderEnv = ImmediateDomBuilderEnv

@@ -111,16 +114,16 @@ unsafeReplaceElementContentsWithWidget events postBuild rootElement wv w = do

111 , _immediateDomBuilderEnv_parent = toNode df

114 , _immediateDomBuilderEnv_parent = toNode df

112 , _immediateDomBuilderEnv_events = events

115 , _immediateDomBuilderEnv_events = events

113 }

116 }

114− result <- runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv

117+ result <- runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv

115 setInnerHTML rootElement $ Just ("" :: String)

118 setInnerHTML rootElement $ Just ("" :: String)

116 _ <- appendChild rootElement $ Just df

119 _ <- appendChild rootElement $ Just df

117 return result

120 return result

118

121

119{-# INLINABLE attachWidget' #-}

122{-# INLINABLE attachWidget' #-}

120−attachWidget' :: DOM.IsElement e => e -> WebViewSingleton x -> Widget x a -> IO (a, FireCommand Spider (SpiderHost Global))

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

121−attachWidget' rootElement wv w = attachWidget'' $ \events -> do

124+attachWidget' rootElement jsSing w = attachWidget'' $ \events -> do

122 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

125 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

123− result <- unsafeReplaceElementContentsWithWidget events postBuild rootElement wv w

126+ result <- unsafeReplaceElementContentsWithWidget events postBuild rootElement jsSing w

124 return (result, postBuildTriggerRef)

127 return (result, postBuildTriggerRef)

125

128

126type EventChannel = Chan [DSum (TriggerRef Spider) TriggerInvocation]

129type EventChannel = Chan [DSum (TriggerRef Spider) TriggerInvocation]

@@ -141,7 +144,7 @@ attachWidget'' w = do

141 me <- readIORef er

144 me <- readIORef er

142 return $ fmap (\e -> e :=> Identity a) me

145 return $ fmap (\e -> e :=> Identity a) me

143 _ <- fire (catMaybes mes) $ return ()

146 _ <- fire (catMaybes mes) $ return ()

144− liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> (`runJSM` ctx) cb

147+ liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb

145 return ()

148 return ()

146 return (result, fc)

149 return (result, fc)

147

150

src/Reflex/Dom/Old.hs+1

@@ -73,6 +73,7 @@ import Reflex.Dom.Widget.Basic

73import Reflex.Host.Class

74import Reflex.PerformEvent.Class

75import Reflex.PostBuild.Class

76+import Reflex.TriggerEvent.Class

76

77

77data ElConfig attrs = ElConfig

78data ElConfig attrs = ElConfig

78 { _elConfig_namespace :: Maybe Text

79 { _elConfig_namespace :: Maybe Text

src/Reflex/Dom/Time.hs+2−1

@@ -10,6 +10,7 @@ import Reflex.Class

10import Reflex.Dynamic

11import Reflex.PerformEvent.Class

12import Reflex.PostBuild.Class

13+import Reflex.TriggerEvent.Class

13

14

14import Control.Concurrent

15import Control.Concurrent

15import qualified Control.Concurrent.Thread.Delay as Concurrent

16import qualified Control.Concurrent.Thread.Delay as Concurrent

@@ -33,7 +34,7 @@ data TickInfo

33

34

34-- | Special case of tickLossyFrom that uses the post-build event to start the

35-- | Special case of tickLossyFrom that uses the post-build event to start the

35-- tick thread.

36-- tick thread.

36−tickLossy :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadJSM (Performable m), MonadFix m) => NominalDiffTime -> UTCTime -> m (Event t TickInfo)

37+tickLossy :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> UTCTime -> m (Event t TickInfo)

37tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild

38tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild

38

39

39-- | Send events over time with the given basis time and interval

40-- | Send events over time with the given basis time and interval

src/Reflex/Dom/WebSocket.hs+1

@@ -28,6 +28,7 @@ import Reflex.Dom.Class

28import Reflex.Dom.WebSocket.Foreign

29import Reflex.PerformEvent.Class

30import Reflex.PostBuild.Class

31+import Reflex.TriggerEvent.Class

31

32

32import Control.Concurrent

33import Control.Concurrent

33import Control.Concurrent.STM

34import Control.Concurrent.STM

src/Reflex/Dom/Widget/Input.hs+1−1

@@ -42,8 +42,8 @@ import Reflex.Dom.Builder.Immediate

42import Reflex.Dom.Class

43import Reflex.Dom.Widget.Basic

44import Reflex.Dynamic

45−import Reflex.PerformEvent.Class

46import Reflex.PostBuild.Class

45import Reflex.PostBuild.Class

46+import Reflex.TriggerEvent.Class

47import qualified Text.Read as T

48

49import qualified GHCJS.DOM.Event as Event

src/Reflex/Dom/Widget/Resize.hs+1

@@ -13,6 +13,7 @@ import Reflex.Dom.Class

13import Reflex.Dom.Widget.Basic

14import Reflex.PerformEvent.Class

15import Reflex.PostBuild.Class

16+import Reflex.TriggerEvent.Class

16

17

17import Control.Monad

18import Control.Monad

18import Control.Monad.Fix

19import Control.Monad.Fix

src/Reflex/Dom/Xhr.hs+1

@@ -62,6 +62,7 @@ where

62import Reflex.Class

63import Reflex.Dom.Class

64import Reflex.PerformEvent.Class

65+import Reflex.TriggerEvent.Class

65

66

66import Control.Concurrent

67import Control.Concurrent

67import Control.Exception (handle)

68import Control.Exception (handle)