git.iko.soy/reflex-dom
on develop help sign in
Use HasPostGui instead of MonadIORestore in Xhr
103faceRyan Trinkle
src/Reflex/Dom/Class.hs+1−1
compare with develop
unifiedsplit
@@ -28,7 +28,7 @@ keycodeEscape :: Int
28keycodeEscape = 27
28keycodeEscape = 27
29
29
30class ( Reflex t, MonadHold t m, MonadIO m, Functor m, MonadReflexCreateTrigger t m
30class ( Reflex t, MonadHold t m, MonadIO m, Functor m, MonadReflexCreateTrigger t m
31− , HasDocument m, HasWebView m, HasWebView (WidgetHost m), MonadIORestore (WidgetHost m)
31+ , HasDocument m, HasWebView m, HasWebView (WidgetHost m)
32 , MonadIO (WidgetHost m), MonadIO (GuiAction m), Functor (WidgetHost m), MonadSample t (WidgetHost m)
32 , MonadIO (WidgetHost m), MonadIO (GuiAction m), Functor (WidgetHost m), MonadSample t (WidgetHost m)
33 , HasPostGui t (GuiAction m) (WidgetHost m), HasPostGui t (GuiAction m) m, MonadRef m, MonadRef (WidgetHost m)
33 , HasPostGui t (GuiAction m) (WidgetHost m), HasPostGui t (GuiAction m) m, MonadRef m, MonadRef (WidgetHost m)
34 , Ref m ~ Ref IO, Ref (WidgetHost m) ~ Ref IO --TODO: Eliminate this reliance on IO
34 , Ref m ~ Ref IO, Ref (WidgetHost m) ~ Ref IO --TODO: Eliminate this reliance on IO
src/Reflex/Dom/Internal.hs+31−7
@@ -132,7 +132,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (Widget t m)
132 newEventWithTrigger = lift . newEventWithTrigger
132 newEventWithTrigger = lift . newEventWithTrigger
133
133
134instance ( MonadRef m, Ref m ~ Ref IO, MonadRef h, Ref h ~ Ref IO --TODO: Shouldn't need to be IO
134instance ( MonadRef m, Ref m ~ Ref IO, MonadRef h, Ref h ~ Ref IO --TODO: Shouldn't need to be IO
135− , MonadIO m, MonadIO h, Functor m, MonadIORestore m
135+ , MonadIO m, MonadIO h, Functor m
136 , ReflexHost t, MonadReflexCreateTrigger t m, MonadSample t m, MonadHold t m
136 , ReflexHost t, MonadReflexCreateTrigger t m, MonadSample t m, MonadHold t m
137 , MonadFix m
137 , MonadFix m
138 ) => MonadWidget t (Widget t (Gui t h m)) where
138 ) => MonadWidget t (Widget t (Gui t h m)) where
@@ -172,13 +172,13 @@ holdOnStartup a0 ma = do
172 runFrameWithTriggerRef startupDoneTriggerRef a
172 runFrameWithTriggerRef startupDoneTriggerRef a
173 hold a0 startupDone
173 hold a0 startupDone
174
174
175−mainWidget :: Widget Spider (Gui Spider SpiderHost (HostFrame Spider)) () -> IO ()
175+mainWidget :: Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) () -> IO ()
176mainWidget w = runWebGUI $ \webView -> do
176mainWidget w = runWebGUI $ \webView -> do
177 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView
177 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView
178 Just body <- documentGetBody doc
178 Just body <- documentGetBody doc
179 attachWidget body webView w
179 attachWidget body webView w
180
180
181−mainWidgetWithHead :: Widget Spider (Gui Spider SpiderHost (HostFrame Spider)) () -> Widget Spider (Gui Spider SpiderHost (HostFrame Spider)) () -> IO ()
181+mainWidgetWithHead :: Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) () -> Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) () -> IO ()
182mainWidgetWithHead h b = runWebGUI $ \webView -> do
182mainWidgetWithHead h b = runWebGUI $ \webView -> do
183 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView
183 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView
184 Just headElement <- liftM (fmap castToHTMLElement) $ documentGetHead doc
184 Just headElement <- liftM (fmap castToHTMLElement) $ documentGetHead doc
@@ -186,7 +186,7 @@ mainWidgetWithHead h b = runWebGUI $ \webView -> do
186 Just body <- documentGetBody doc
186 Just body <- documentGetBody doc
187 attachWidget body webView b
187 attachWidget body webView b
188
188
189−mainWidgetWithCss :: ByteString -> Widget Spider (Gui Spider SpiderHost (HostFrame Spider)) () -> IO ()
189+mainWidgetWithCss :: ByteString -> Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) () -> IO ()
190mainWidgetWithCss css w = runWebGUI $ \webView -> do
190mainWidgetWithCss css w = runWebGUI $ \webView -> do
191 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView
191 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView
192 Just headElement <- liftM (fmap castToHTMLElement) $ documentGetHead doc
192 Just headElement <- liftM (fmap castToHTMLElement) $ documentGetHead doc
@@ -194,11 +194,35 @@ mainWidgetWithCss css w = runWebGUI $ \webView -> do
194 Just body <- documentGetBody doc
194 Just body <- documentGetBody doc
195 attachWidget body webView w
195 attachWidget body webView w
196
196
197+newtype WithWebView m a = WithWebView { unWithWebView :: ReaderT WebView m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
198+
199+instance MonadTrans WithWebView where
200+ lift = WithWebView . lift
201+
202+instance MonadRef m => MonadRef (WithWebView m) where
203+ type Ref (WithWebView m) = Ref m
204+ newRef = lift . newRef
205+ readRef = lift . readRef
206+ writeRef r = lift . writeRef r
207+
208+instance MonadAtomicRef m => MonadAtomicRef (WithWebView m) where
209+ atomicModifyRef r = lift . atomicModifyRef r
210+
211+deriving instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (WithWebView m)
212+instance MonadReflexHost t m => MonadReflexHost t (WithWebView m) where
213+ fireEventsAndRead dm a = lift $ fireEventsAndRead dm a
214+ subscribeEvent = lift . subscribeEvent
215+ runFrame = lift . runFrame
216+ runHostFrame = lift . runHostFrame
217+
218+runWithWebView :: WithWebView m a -> WebView -> m a
219+runWithWebView = runReaderT . unWithWebView
220+
197−attachWidget :: (IsHTMLElement e) => e -> WebView -> Widget Spider (Gui Spider SpiderHost (HostFrame Spider)) a -> IO a
221+attachWidget :: (IsHTMLElement e) => e -> WebView -> Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) a -> IO a
198−attachWidget rootElement wv w = runSpiderHost $ do --TODO: It seems to re-run this handler if the URL changes, even if it's only the fragment
222+attachWidget rootElement wv w = runSpiderHost $ flip runWithWebView wv $ do --TODO: It seems to re-run this handler if the URL changes, even if it's only the fragment
199 Just doc <- liftM (fmap castToHTMLDocument) $ liftIO $ nodeGetOwnerDocument rootElement
223 Just doc <- liftM (fmap castToHTMLDocument) $ liftIO $ nodeGetOwnerDocument rootElement
200 frames <- liftIO newChan
224 frames <- liftIO newChan
201− rec let guiEnv = GuiEnv doc (writeChan frames . runSpiderHost) runWithActions wv :: GuiEnv Spider SpiderHost
225+ rec let guiEnv = GuiEnv doc (writeChan frames . runSpiderHost . flip runWithWebView wv) runWithActions wv :: GuiEnv Spider (WithWebView SpiderHost)
202 runWithActions dm = do
226 runWithActions dm = do
203 voidActionNeeded <- fireEventsAndRead dm $ do
227 voidActionNeeded <- fireEventsAndRead dm $ do
204 sequence =<< readEvent voidActionHandle
228 sequence =<< readEvent voidActionHandle
src/Reflex/Dom/Xhr.hs+3−3
@@ -57,10 +57,10 @@ instance Default XhrRequestConfig where
57xhrRequest :: String -> String -> XhrRequestConfig -> XhrRequest
57xhrRequest :: String -> String -> XhrRequestConfig -> XhrRequest
58xhrRequest = XhrRequest
58xhrRequest = XhrRequest
59
59
60−newXMLHttpRequest :: (HasWebView m, MonadIO m, MonadIORestore m) => XhrRequest -> (XhrResponse -> m a) -> m XMLHttpRequest
60+newXMLHttpRequest :: (HasWebView m, MonadIO m, HasPostGui t h m) => XhrRequest -> (XhrResponse -> h ()) -> m XMLHttpRequest
61newXMLHttpRequest req cb = do
61newXMLHttpRequest req cb = do
62 wv <- askWebView
62 wv <- askWebView
63− rst <- askRestore
63+ postGui <- askPostGui
64 liftIO $ do
64 liftIO $ do
65 xhr <- xmlHttpRequestNew wv
65 xhr <- xmlHttpRequestNew wv
66 let c = _xhrRequest_config req
66 let c = _xhrRequest_config req
@@ -78,7 +78,7 @@ newXMLHttpRequest req cb = do
78 if readyState == 4
78 if readyState == 4
79 then do
79 then do
80 r <- liftIO $ xmlHttpRequestGetResponseText xhr
80 r <- liftIO $ xmlHttpRequestGetResponseText xhr
81− _ <- liftIO $ restore rst $ cb $ XhrResponse $ responseTextToText r
81+ _ <- liftIO $ postGui $ cb $ XhrResponse $ responseTextToText r
82 return ()
82 return ()
83 else return ()
83 else return ()
84 _ <- xmlHttpRequestSend xhr (_xhrRequestConfig_sendData c)
84 _ <- xmlHttpRequestSend xhr (_xhrRequestConfig_sendData c)