git.iko.soy/reflex-dom
on develop help sign in
Fix a memory leak; add a test that demonstrates it
c3b24caRyan Trinkle
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+4−1
compare with develop
unifiedsplit
@@ -31,6 +31,7 @@ import Reflex.TriggerEvent.Base hiding (askEvents)
31import Reflex.TriggerEvent.Class
31import Reflex.TriggerEvent.Class
32
32
33import Control.Concurrent.Chan
33import Control.Concurrent.Chan
34+import Control.Exception (evaluate)
34import Control.Lens hiding (element, ix)
35import Control.Lens hiding (element, ix)
35import Control.Monad.Exception
36import Control.Monad.Exception
36import Control.Monad.Primitive
37import Control.Monad.Primitive
@@ -224,6 +225,9 @@ wrap e cfg = do
224 liftIO $ forM_ mv $ \v -> writeChan events [TriggerRef triggerRef :=> TriggerInvocation v (return ())]
225 liftIO $ forM_ mv $ \v -> writeChan events [TriggerRef triggerRef :=> TriggerInvocation v (return ())]
225 return $ en :=> EventFilterTriggerRef triggerRef
226 return $ en :=> EventFilterTriggerRef triggerRef
226 es <- do
227 es <- do
228+ let h :: forall en. (EventName en, GhcjsDomEvent en) -> JSM (Maybe (er en))
229+ h = _ghcjsEventSpec_handler $ _rawElementConfig_eventSpec cfg -- Note: this needs to be done strictly and outside of the newFanEventWithTrigger, so that the newFanEventWithTrigger doesn't retain the entire cfg, which can cause a cyclic dependency that the GC won't be able to clean up
230+ _ <- liftIO $ evaluate h
227 ctx <- askJSM
231 ctx <- askJSM
228 newFanEventWithTrigger $ \(WrapArg en) t ->
232 newFanEventWithTrigger $ \(WrapArg en) t ->
229 case DMap.lookup en eventTriggerRefs of
233 case DMap.lookup en eventTriggerRefs of
@@ -233,7 +237,6 @@ wrap e cfg = do
233 writeIORef r Nothing
237 writeIORef r Nothing
234 Nothing -> (`runJSM` ctx) <$> (`runJSM` ctx) (elementOnEventName en e $ do
238 Nothing -> (`runJSM` ctx) <$> (`runJSM` ctx) (elementOnEventName en e $ do
235 evt <- DOM.event
239 evt <- DOM.event
236− let h = _ghcjsEventSpec_handler $ _rawElementConfig_eventSpec cfg
237 mv <- lift $ h (en, GhcjsDomEvent evt)
240 mv <- lift $ h (en, GhcjsDomEvent evt)
238 case mv of
241 case mv of
239 Nothing -> return ()
242 Nothing -> return ()
reflex-dom-core/test/gc.hsnew file+21
@@ -0,0 +1,21 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecursiveDo #-}
3+import Control.Concurrent
4+import Control.Monad
5+import Control.Monad.IO.Class
6+import Language.Javascript.JSaddle.Warp
7+import Reflex.Dom.Core
8+import Reflex.Dom.Main
9+
10+main :: IO ()
11+main = run 3911 $ do
12+ mainWidget $ do
13+ let w = do
14+ rec let modifyAttrs = flip pushAlways (updated d) $ \_ -> sample $ current d
15+ (e, _) <- element "button" (def & modifyAttributes .~ modifyAttrs) blank
16+ d <- holdDyn mempty $ mempty <$ domEvent Click e
17+ return ()
18+ redraw <- button "Redraw"
19+ _ <- widgetHold w $ w <$ redraw
20+ return ()
21+ liftIO $ forever $ threadDelay 1000000000