103face · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Use HasPostGui instead of MonadIORestore in Xhr

commit103face73ba31d872af068619e6076accadc3131 authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 9 Apr 2015, 19:08 (12 years ago) parenta8ab161

3 files changed+35−11

compare with develop

unifiedsplit

src/Reflex/Dom/Class.hs+1−1 src/Reflex/Dom/Internal.hs+31−7 src/Reflex/Dom/Xhr.hs+3−3

src/Reflex/Dom/Class.hs+1−1

@@ -28,7 +28,7 @@ keycodeEscape :: Int

2828keycodeEscape = 27

2929

3030class ( 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)

3232 , MonadIO (WidgetHost m), MonadIO (GuiAction m), Functor (WidgetHost m), MonadSample t (WidgetHost m)

3333 , HasPostGui t (GuiAction m) (WidgetHost m), HasPostGui t (GuiAction m) m, MonadRef m, MonadRef (WidgetHost m)

3434 , 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)

132132 newEventWithTrigger = lift . newEventWithTrigger

133133

134134instance ( 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

136136 , ReflexHost t, MonadReflexCreateTrigger t m, MonadSample t m, MonadHold t m

137137 , MonadFix m

138138 ) => MonadWidget t (Widget t (Gui t h m)) where

@@ -172,13 +172,13 @@ holdOnStartup a0 ma = do

172172 runFrameWithTriggerRef startupDoneTriggerRef a

173173 hold a0 startupDone

174174

175−mainWidget :: Widget Spider (Gui Spider SpiderHost (HostFrame Spider)) () -> IO ()

175+mainWidget :: Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) () -> IO ()

176176mainWidget w = runWebGUI $ \webView -> do

177177 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView

178178 Just body <- documentGetBody doc

179179 attachWidget body webView w

180180

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 ()

182182mainWidgetWithHead h b = runWebGUI $ \webView -> do

183183 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView

184184 Just headElement <- liftM (fmap castToHTMLElement) $ documentGetHead doc

@@ -186,7 +186,7 @@ mainWidgetWithHead h b = runWebGUI $ \webView -> do

186186 Just body <- documentGetBody doc

187187 attachWidget body webView b

188188

189−mainWidgetWithCss :: ByteString -> Widget Spider (Gui Spider SpiderHost (HostFrame Spider)) () -> IO ()

189+mainWidgetWithCss :: ByteString -> Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) () -> IO ()

190190mainWidgetWithCss css w = runWebGUI $ \webView -> do

191191 Just doc <- liftM (fmap castToHTMLDocument) $ webViewGetDomDocument webView

192192 Just headElement <- liftM (fmap castToHTMLElement) $ documentGetHead doc

@@ -194,11 +194,35 @@ mainWidgetWithCss css w = runWebGUI $ \webView -> do

194194 Just body <- documentGetBody doc

195195 attachWidget body webView w

196196

197−attachWidget :: (IsHTMLElement e) => e -> WebView -> Widget Spider (Gui Spider 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

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+

221+attachWidget :: (IsHTMLElement e) => e -> WebView -> Widget Spider (Gui Spider (WithWebView SpiderHost) (HostFrame Spider)) a -> IO a

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

199223 Just doc <- liftM (fmap castToHTMLDocument) $ liftIO $ nodeGetOwnerDocument rootElement

200224 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)

202226 runWithActions dm = do

203227 voidActionNeeded <- fireEventsAndRead dm $ do

204228 sequence =<< readEvent voidActionHandle

src/Reflex/Dom/Xhr.hs+3−3

@@ -57,10 +57,10 @@ instance Default XhrRequestConfig where

5757xhrRequest :: String -> String -> XhrRequestConfig -> XhrRequest

5858xhrRequest = XhrRequest

5959

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

6161newXMLHttpRequest req cb = do

6262 wv <- askWebView

63− rst <- askRestore

63+ postGui <- askPostGui

6464 liftIO $ do

6565 xhr <- xmlHttpRequestNew wv

6666 let c = _xhrRequest_config req

@@ -78,7 +78,7 @@ newXMLHttpRequest req cb = do

7878 if readyState == 4

7979 then do

8080 r <- liftIO $ xmlHttpRequestGetResponseText xhr

81− _ <- liftIO $ restore rst $ cb $ XhrResponse $ responseTextToText r

81+ _ <- liftIO $ postGui $ cb $ XhrResponse $ responseTextToText r

8282 return ()

8383 else return ()

8484 _ <- xmlHttpRequestSend xhr (_xhrRequestConfig_sendData c)