git.iko.soy/patch
on develop help sign in
Merge remote-tracking branch 'origin/develop' into patchmapwithmove2
8572da6John Ericson
ChangeLog.md+7
compare with develop
unifiedsplit
@@ -1,5 +1,12 @@
1# Revision history for reflex
1# Revision history for reflex
2
2
3+## Unreleased
4+
5+* Data.WeakBag.traverse and Data.FastWeakBag.traverse have been
6+ renamed to Data.WeakBag.traverse_ and Data.FastWeakBag.traverse_
7+ respectively.
8+* Fixes a bug in `Reflex.Patch.MapWithMove.patchThatSortsMapWith` that was producing invalid `PatchMapWithMove`.
9+
3## 0.6.2.4
10## 0.6.2.4
4
11
5* Update to monoidal-containers 0.6
12* Update to monoidal-containers 0.6
default.nixdeleted−43
@@ -1,43 +0,0 @@
1−{ mkDerivation, ghc, base, bifunctors, containers, deepseq
2−, dependent-map, dependent-sum, exception-transformers
3−, haskell-src-exts, haskell-src-meta, hlint, lens, MemoTrie
4−, monad-control, mtl, primitive, random, ref-tf
5−, semigroupoids , semigroups, split, stdenv, stm, syb
6−, template-haskell , these, time, transformers
7−, transformers-compat, unbounded-delays, prim-uniq
8−, data-default, filepath, directory, filemanip, ghcjs-base
9−, monoidal-containers, witherable, constraints-extras, profunctors
10−, semialign ? null, splitThese ? (semialign != null)
11−, useTemplateHaskell ? true
12−}:
13−mkDerivation {
14− pname = "reflex";
15− version = "0.6.2.4";
16− src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;
17− libraryHaskellDepends = [
18− base bifunctors containers dependent-map dependent-sum
19− exception-transformers lens
20− MemoTrie monad-control mtl primitive ref-tf semigroupoids
21− semigroups stm syb template-haskell these transformers
22− transformers-compat prim-uniq
23− base bifunctors containers deepseq dependent-map dependent-sum
24− mtl ref-tf split transformers data-default
25− random time unbounded-delays monoidal-containers witherable
26− constraints-extras profunctors
27− ] ++ (if ghc.isGhcjs or false then [
28− ghcjs-base
29− ] else []) ++ (if !useTemplateHaskell then [] else [
30− haskell-src-exts haskell-src-meta
31− ]) ++ (if splitThese then [
32− semialign
33− ] else []);
34− testHaskellDepends = if ghc.isGhcjs or false then [] else [
35− hlint filepath directory filemanip
36− ];
37− configureFlags =
38− stdenv.lib.optional (!useTemplateHaskell) [ "-f-use-template-haskell" ] ++
39− stdenv.lib.optional (!splitThese) [ "-f-split-these" ];
40− homepage = "https://github.com/reflex-frp/reflex";
41− description = "Higher-order Functional Reactive Programming";
42− license = stdenv.lib.licenses.bsd3;
43−}
dep/reflex-platform/default.nixnew file+7
@@ -0,0 +1,7 @@
1+# DO NOT HAND-EDIT THIS FILE
2+import ((import <nixpkgs> {}).fetchFromGitHub (
3+ let json = builtins.fromJSON (builtins.readFile ./github.json);
4+ in { inherit (json) owner repo rev sha256;
5+ private = json.private or false;
6+ }
7+))
dep/reflex-platform/github.jsonnew file+7
@@ -0,0 +1,7 @@
1+{
2+ "owner": "reflex-frp",
3+ "repo": "reflex-platform",
4+ "branch": "jailbreakTheselens",
5+ "rev": "4284ed527c96c373538dc7e31776d9a50ca6aa91",
6+ "sha256": "1m1nkxq7ng9wnqbd77xn8d81f2iz8g61y5m0r3gp0gi0q59jm8ay"
7+}
hydra.jsondeleted−29
@@ -1,29 +0,0 @@
1−{
2− "enabled": 1,
3− "hidden": true,
4− "description": "Jobsets",
5− "nixexprinput": "src",
6− "nixexprpath": "jobsets.nix",
7− "checkinterval": 300,
8− "schedulingshares": 100,
9− "enableemail": false,
10− "emailoverride": "",
11− "keepnr": 10,
12− "inputs": {
13− "src": {
14− "type": "git",
15− "value": "https://github.com/reflex-frp/reflex.git develop",
16− "emailresponsible": false
17− },
18− "nixpkgs": {
19− "type": "git",
20− "value": "https://github.com/NixOS/nixpkgs-channels nixos-unstable",
21− "emailresponsible": false
22− },
23− "prs": {
24− "type": "githubpulls",
25− "value": "reflex-frp reflex",
26− "emailresponsible": false
27− }
28− }
29−}
jobsets.nixdeleted−70
@@ -1,70 +0,0 @@
1−{ prs }:
2−
3−let
4− pkgs = (import ./reflex-platform.nix {}).nixpkgs;
5− mkFetchGithub = value: {
6− inherit value;
7− type = "git";
8− emailresponsible = false;
9− };
10−in
11−with pkgs.lib;
12−let
13− defaults = jobs: {
14− inherit (jobs) description;
15− enabled = 1;
16− hidden = false;
17− keepnr = 10;
18− schedulingshares = 100;
19− checkinterval = 120;
20− enableemail = false;
21− emailoverride = "";
22− nixexprinput = "reflex";
23− nixexprpath = "release.nix";
24− inputs = jobs.inputs // {
25− nixpkgs = {
26− type = "git";
27− value = "https://github.com/NixOS/nixpkgs-channels nixos-unstable";
28− emailresponsible = false;
29− };
30− config = {
31− type = "nix";
32− value = "{ android_sdk.accept_license = true; }";
33− emailresponsible = false;
34− };
35− };
36− };
37− branchJobset = branch: defaults {
38− description = "reflex-${branch}";
39− inputs = {
40− reflex = {
41− value = "https://github.com/reflex-frp/reflex ${branch}";
42− type = "git";
43− emailresponsible = false;
44− };
45− };
46− };
47− makePr = num: info: {
48− name = "reflex-pr-${num}";
49− value = defaults {
50− description = "#${num}: ${info.title}";
51− inputs = {
52− reflex = {
53− #NOTE: This should really use "pull/${num}/merge"; however, GitHub's
54− #status checks only operate on PR heads. This creates a race
55− #condition, which can currently only be solved by requiring PRs to be
56− #up to date before they're merged. See
57− #https://github.com/isaacs/github/issues/1002
58− value = "https://github.com/reflex-frp/reflex pull/${num}/head";
59− type = "git";
60− emailresponsible = false;
61− };
62− };
63− };
64− };
65− processedPrs = mapAttrs' makePr (builtins.fromJSON (builtins.readFile prs));
66− jobsetsAttrs = processedPrs //
67− genAttrs ["develop"] branchJobset;
68−in {
69− jobsets = pkgs.writeText "spec.json" (builtins.toJSON jobsetsAttrs);
70−}
reflex-platform.nixdeleted−8
@@ -1,8 +0,0 @@
1−let
2− reflex-platform-src = (import <nixpkgs> {}).fetchFromGitHub {
3− owner = "reflex-frp";
4− repo = "reflex-platform";
5− rev = "384cd850f3adf1d404bced2424b5f6efb0f415f2";
6− sha256 = "1ws77prqx8khmp8j6br1ij4k2v4dlgv170r9fmg0p1jivfbn8y9d";
7− };
8−in import reflex-platform-src
reflex.cabal+1−1
@@ -78,7 +78,7 @@ library
78
78
79 if flag(split-these)
79 if flag(split-these)
80 build-depends: these >= 1 && <1.1,
80 build-depends: these >= 1 && <1.1,
81− semialign >=1 && <1.1,
81+ semialign >=1 && <1.2,
82 monoidal-containers >= 0.6 && < 0.7
82 monoidal-containers >= 0.6 && < 0.7
83 else
83 else
84 build-depends: these >= 0.4 && <0.9,
84 build-depends: these >= 0.4 && <0.9,
release.nix+43−7
@@ -1,9 +1,45 @@
1−{ rp ? import ./reflex-platform.nix {}
1+{ reflex-platform-fun ? import ./dep/reflex-platform
2}:
2}:
3+
3let
4let
5+ native-reflex-platform = reflex-platform-fun {};
4− inherit (rp.nixpkgs) lib;
6+ inherit (native-reflex-platform.nixpkgs) lib;
5− compilers = ["ghc8_4" "ghc8_0" "ghcjs8_4" "ghcjs8_0"];
7+ systems = ["x86_64-linux" "x86_64-darwin"];
8+
9+ perPlatform = lib.genAttrs systems (system: let
10+ reflex-platform = reflex-platform-fun { inherit system; };
11+ compilers = [
12+ "ghc"
13+ "ghcjs"
14+ ] ++ lib.optionals (reflex-platform.androidSupport) [
15+ "ghcAndroidAarch64"
16+ "ghcAndroidAarch32"
17+ ] ++ lib.optionals (reflex-platform.iosSupport) [
18+ "ghcIosAarch64"
19+ ];
6−in lib.attrValues (lib.genAttrs compilers (ghc: {
20+ hsPkgs = lib.genAttrs compilers (ghc: let
7− reflex-useTemplateHaskell = rp.${ghc}.callPackage ./. { useTemplateHaskell = true; splitThese = false; };
21+ ghc' = reflex-platform.${ghc}.override {
8− reflex = rp.${ghc}.callPackage ./. { useTemplateHaskell = false; splitThese = false; };
22+ overrides = self: super: let
9−}))
23+ reflexSrc = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [
24+ "default.nix"
25+ "release.nix"
26+ ".git"
27+ "dist"
28+ ])) ./.;
29+ in {
30+ reflex-dontUseTemplateHaskell = self.callCabal2nixWithOptions "reflex" reflexSrc "-f -use-template-haskell" {};
31+ reflex = self.callCabal2nixWithOptions "reflex" reflexSrc "-f +use-template-haskell" {};
32+ };
33+ };
34+ in {
35+ inherit (ghc') reflex reflex-dontUseTemplateHaskell;
36+ });
37+ in hsPkgs // {
38+ cache = reflex-platform.pinBuildInputs "reflex-${system}"
39+ (lib.concatLists (map builtins.attrValues (builtins.attrValues hsPkgs)));
40+ });
41+
42+ metaCache = native-reflex-platform.pinBuildInputs "reflex-everywhere"
43+ (map (a: a.cache) (builtins.attrValues perPlatform));
44+
45+in perPlatform // { inherit metaCache; }
src/Data/FastWeakBag.hs+9−4
@@ -18,6 +18,7 @@ module Data.FastWeakBag
18 , isEmpty
18 , isEmpty
19 , insert
19 , insert
20 , traverse
20 , traverse
21+ , traverse_
21 , remove
22 , remove
22 -- * Internal functions
23 -- * Internal functions
23 -- These will not always be available.
24 -- These will not always be available.
@@ -116,14 +117,14 @@ foreign import javascript unsafe "(function(){ for(var i = 0; i < $1.tickets.len
116isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children bag)
117isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children bag)
117#endif
118#endif
118
119
119−{-# INLINE traverse #-}
120+{-# INLINE traverse_ #-}
120-- | Visit every node in the given list. If new nodes are appended during the
121-- | Visit every node in the given list. If new nodes are appended during the
121-- traversal, they will not be visited. Every live node that was in the list
122-- traversal, they will not be visited. Every live node that was in the list
122-- when the traversal began will be visited exactly once; however, no guarantee
123-- when the traversal began will be visited exactly once; however, no guarantee
123-- is made about the order of the traversal.
124-- is made about the order of the traversal.
124−traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
125+traverse_ :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
125#ifdef GHCJS_FAST_WEAK
126#ifdef GHCJS_FAST_WEAK
126−traverse wb f = do
127+traverse_ wb f = do
127 let go cursor = when (not $ js_isNull cursor) $ do
128 let go cursor = when (not $ js_isNull cursor) $ do
128 val <- liftIO $ js_getTicketValue cursor
129 val <- liftIO $ js_getTicketValue cursor
129 f $ unsafeFromRawJSVal val
130 f $ unsafeFromRawJSVal val
@@ -134,13 +135,17 @@ foreign import javascript unsafe "$r = $1.val;" js_getTicketValue :: JSVal -> IO
134--TODO: Fix the race condition where if a cursor is deleted (presumably using 'remove', below) while we're holding it, it can't find its way back to the correct bag
135--TODO: Fix the race condition where if a cursor is deleted (presumably using 'remove', below) while we're holding it, it can't find its way back to the correct bag
135foreign import javascript unsafe "(function(){ for(var i = $1.pos - 1; i >= 0; i--) { if($1.bag.tickets[i] !== null) { return $1.bag.tickets[i]; } }; return null; })()" js_getNext :: FastWeakBagTicket a -> IO JSVal --TODO: Clean up as we go along so this isn't O(n) every time -- Result can be null or a FastWeakBagTicket a
136foreign import javascript unsafe "(function(){ for(var i = $1.pos - 1; i >= 0; i--) { if($1.bag.tickets[i] !== null) { return $1.bag.tickets[i]; } }; return null; })()" js_getNext :: FastWeakBagTicket a -> IO JSVal --TODO: Clean up as we go along so this isn't O(n) every time -- Result can be null or a FastWeakBagTicket a
136#else
137#else
137−traverse (FastWeakBag _ children) f = {-# SCC "traverse" #-} do
138+traverse_ (FastWeakBag _ children) f = {-# SCC "traverse_" #-} do
138 cs <- liftIO $ readIORef children
139 cs <- liftIO $ readIORef children
139 forM_ cs $ \c -> do
140 forM_ cs $ \c -> do
140 ma <- liftIO $ deRefWeak c
141 ma <- liftIO $ deRefWeak c
141 mapM_ f ma
142 mapM_ f ma
142#endif
143#endif
143
144
145+{-# DEPRECATED traverse "Use 'traverse_' instead" #-}
146+traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
147+traverse = traverse_
148+
144-- | Remove an item from the 'FastWeakBag'; does nothing if invoked multiple times
149-- | Remove an item from the 'FastWeakBag'; does nothing if invoked multiple times
145-- on the same 'FastWeakBagTicket'.
150-- on the same 'FastWeakBagTicket'.
146{-# INLINE remove #-}
151{-# INLINE remove #-}
src/Data/WeakBag.hs+8−3
@@ -15,6 +15,7 @@ module Data.WeakBag
15 , singleton
15 , singleton
16 , insert
16 , insert
17 , traverse
17 , traverse
18+ , traverse_
18 , remove
19 , remove
19 -- * Internal functions
20 -- * Internal functions
20 -- These will not always be available.
21 -- These will not always be available.
@@ -99,18 +100,22 @@ singleton a wbRef finalizer = {-# SCC "singleton" #-} do
99 ticket <- insert a bag wbRef finalizer
100 ticket <- insert a bag wbRef finalizer
100 return (bag, ticket)
101 return (bag, ticket)
101
102
102−{-# INLINE traverse #-}
103+{-# INLINE traverse_ #-}
103-- | Visit every node in the given list. If new nodes are appended during the
104-- | Visit every node in the given list. If new nodes are appended during the
104-- traversal, they will not be visited. Every live node that was in the list
105-- traversal, they will not be visited. Every live node that was in the list
105-- when the traversal began will be visited exactly once; however, no guarantee
106-- when the traversal began will be visited exactly once; however, no guarantee
106-- is made about the order of the traversal.
107-- is made about the order of the traversal.
107−traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
108+traverse_ :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
108−traverse (WeakBag _ children) f = {-# SCC "traverse" #-} do
109+traverse_ (WeakBag _ children) f = {-# SCC "traverse" #-} do
109 cs <- liftIO $ readIORef children
110 cs <- liftIO $ readIORef children
110 forM_ cs $ \c -> do
111 forM_ cs $ \c -> do
111 ma <- liftIO $ deRefWeak c
112 ma <- liftIO $ deRefWeak c
112 mapM_ f ma
113 mapM_ f ma
113
114
115+{-# DEPRECATED traverse "Use 'traverse_' instead" #-}
116+traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
117+traverse = traverse_
118+
114-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times
119-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times
115-- on the same 'WeakBagTicket'.
120-- on the same 'WeakBagTicket'.
116{-# INLINE remove #-}
121{-# INLINE remove #-}
src/Reflex/Class.hs+8−2
@@ -173,12 +173,15 @@ module Reflex.Class
173 , slowHeadE
173 , slowHeadE
174 ) where
174 ) where
175
175
176−#if defined(MIN_VERSION_semialign)
176+#ifdef MIN_VERSION_semialign
177import Prelude hiding (zip, zipWith)
177import Prelude hiding (zip, zipWith)
178
178
179#if MIN_VERSION_these(0,8,0)
179#if MIN_VERSION_these(0,8,0)
180import Data.These.Combinators (justThese)
180import Data.These.Combinators (justThese)
181#endif
181#endif
182+#if MIN_VERSION_semialign(1,1,0)
183+import Data.Zip (Zip (..))
184+#endif
182#endif
185#endif
183
186
184import Control.Applicative
187import Control.Applicative
@@ -1077,7 +1080,10 @@ instance Reflex t => Semialign (Event t) where
1077#endif
1080#endif
1078 align = alignEventWithMaybe Just
1081 align = alignEventWithMaybe Just
1079
1082
1080−#if defined(MIN_VERSION_semialign)
1083+#ifdef MIN_VERSION_semialign
1084+#if MIN_VERSION_semialign(1,1,0)
1085+instance Reflex t => Zip (Event t) where
1086+#endif
1081 zip x y = mapMaybe justThese $ align x y
1087 zip x y = mapMaybe justThese $ align x y
1082#endif
1088#endif
1083
1089
src/Reflex/Collection.hs+4−1
@@ -27,8 +27,11 @@ module Reflex.Collection
27 , simpleList
27 , simpleList
28 ) where
28 ) where
29
29
30−#if defined(MIN_VERSION_semialign)
30+#ifdef MIN_VERSION_semialign
31import Prelude hiding (zip, zipWith)
31import Prelude hiding (zip, zipWith)
32+#if MIN_VERSION_semialign(1,1,0)
33+import Data.Zip (Zip (..))
34+#endif
32#endif
35#endif
33
36
34import Control.Monad.Identity
37import Control.Monad.Identity
src/Reflex/Patch/MapWithMove.hs+1−1
@@ -155,7 +155,7 @@ patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipW
155 Just (from, to)
155 Just (from, to)
156 reverseMapping = Map.fromList $ catMaybes $ zipWith f unsorted sorted
156 reverseMapping = Map.fromList $ catMaybes $ zipWith f unsorted sorted
157 g (to, _) (from, _) = if to == from then Nothing else
157 g (to, _) (from, _) = if to == from then Nothing else
158− let Just movingTo = Map.lookup from reverseMapping
158+ let Just movingTo = Map.lookup to reverseMapping
159 in Just (to, NodeInfo (From_Move from) $ Just movingTo)
159 in Just (to, NodeInfo (From_Move from) $ Just movingTo)
160
160
161-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
161-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
src/Reflex/Spider/Internal.hs+24−18
@@ -72,10 +72,13 @@ import System.IO.Unsafe
72import System.Mem.Weak
72import System.Mem.Weak
73import Unsafe.Coerce
73import Unsafe.Coerce
74
74
75−#if defined(MIN_VERSION_semialign)
75+#ifdef MIN_VERSION_semialign
76#if MIN_VERSION_these(0,8,0)
76#if MIN_VERSION_these(0,8,0)
77import Data.These.Combinators (justThese)
77import Data.These.Combinators (justThese)
78#endif
78#endif
79+#if MIN_VERSION_semialign(1,1,0)
80+import Data.Zip (Zip (..))
81+#endif
79#endif
82#endif
80
83
81#ifdef DEBUG_CYCLES
84#ifdef DEBUG_CYCLES
@@ -329,9 +332,9 @@ cacheEvent e =
329 scheduleClear occRef
332 scheduleClear occRef
330 propagateFast a subscribers
333 propagateFast a subscribers
331 , subscriberInvalidateHeight = \old -> do
334 , subscriberInvalidateHeight = \old -> do
332− FastWeakBag.traverse subscribers $ invalidateSubscriberHeight old
335+ FastWeakBag.traverse_ subscribers $ invalidateSubscriberHeight old
333 , subscriberRecalculateHeight = \new -> do
336 , subscriberRecalculateHeight = \new -> do
334− FastWeakBag.traverse subscribers $ recalculateSubscriberHeight new
337+ FastWeakBag.traverse_ subscribers $ recalculateSubscriberHeight new
335 }
338 }
336 when (isJust occ) $ do
339 when (isJust occ) $ do
337 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing
340 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing
@@ -447,12 +450,12 @@ newSubscriberFan subscribed = return $ Subscriber
447 , subscriberInvalidateHeight = \old -> do
450 , subscriberInvalidateHeight = \old -> do
448 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
451 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
449 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
452 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
450− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old
453+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old
451 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
454 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
452 , subscriberRecalculateHeight = \new -> do
455 , subscriberRecalculateHeight = \new -> do
453 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
456 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
454 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
457 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
455− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new
458+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new
456 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
459 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
457 }
460 }
458
461
@@ -468,7 +471,7 @@ newSubscriberSwitch subscribed = return $ Subscriber
468 oldHeight <- readIORef $ switchSubscribedHeight subscribed
471 oldHeight <- readIORef $ switchSubscribedHeight subscribed
469 when (oldHeight /= invalidHeight) $ do
472 when (oldHeight /= invalidHeight) $ do
470 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
473 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
471− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
474+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
472 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
475 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
473 , subscriberRecalculateHeight = \new -> do
476 , subscriberRecalculateHeight = \new -> do
474 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
477 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
@@ -491,8 +494,8 @@ newSubscriberCoincidenceOuter subscribed = return $ Subscriber
491 Nothing -> do
494 Nothing -> do
492 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
495 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
493 writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight
496 writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight
494− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
497+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
495− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight
498+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight
496 Just o -> do -- Since it's already firing, no need to adjust height
499 Just o -> do -- Since it's already firing, no need to adjust height
497 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
500 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
498 scheduleClear $ coincidenceSubscribedOccurrence subscribed
501 scheduleClear $ coincidenceSubscribedOccurrence subscribed
@@ -539,14 +542,14 @@ propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()
539propagate a subscribers = withIncreasedDepth $ do
542propagate a subscribers = withIncreasedDepth $ do
540 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
543 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
541 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
544 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
542− WeakBag.traverse subscribers $ \s -> subscriberPropagate s a
545+ WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
543
546
544-- | Propagate everything at the current height
547-- | Propagate everything at the current height
545propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()
548propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()
546propagateFast a subscribers = withIncreasedDepth $ do
549propagateFast a subscribers = withIncreasedDepth $ do
547 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
550 -- Note: in the following traversal, we do not visit nodes that are added to the list during our traversal; they are new events, which will necessarily have full information already, so there is no need to traverse them
548 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
551 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
549− FastWeakBag.traverse subscribers $ \s -> subscriberPropagate s a
552+ FastWeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
550
553
551--------------------------------------------------------------------------------
554--------------------------------------------------------------------------------
552-- EventSubscribed
555-- EventSubscribed
@@ -1163,7 +1166,10 @@ instance HasSpiderTimeline x => Semialign (Event x) where
1163 align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $
1166 align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $
1164 DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]
1167 DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]
1165
1168
1166−#if defined(MIN_VERSION_semialign)
1169+#ifdef MIN_VERSION_semialign
1170+#if MIN_VERSION_semialign(1,1,0)
1171+instance HasSpiderTimeline x => Zip (Event x) where
1172+#endif
1167 zip x y = mapMaybe justThese $ align x y
1173 zip x y = mapMaybe justThese $ align x y
1168#endif
1174#endif
1169
1175
@@ -1521,15 +1527,15 @@ fanInt p = unsafePerformIO $ do
1521 liftIO $ writeIORef (_fanInt_occRef self) m
1527 liftIO $ writeIORef (_fanInt_occRef self) m
1522 scheduleIntClear $ _fanInt_occRef self
1528 scheduleIntClear $ _fanInt_occRef self
1523 FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?
1529 FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?
1524− FastWeakBag.traverse b $ \s -> do
1530+ FastWeakBag.traverse_ b $ \s -> do
1525 subscriberPropagate s v
1531 subscriberPropagate s v
1526 , subscriberInvalidateHeight = \old -> do
1532 , subscriberInvalidateHeight = \old -> do
1527 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1533 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1528− FastWeakBag.traverse b $ \s -> do
1534+ FastWeakBag.traverse_ b $ \s -> do
1529 subscriberInvalidateHeight s old
1535 subscriberInvalidateHeight s old
1530 , subscriberRecalculateHeight = \new -> do
1536 , subscriberRecalculateHeight = \new -> do
1531 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1537 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1532− FastWeakBag.traverse b $ \s -> do
1538+ FastWeakBag.traverse_ b $ \s -> do
1533 subscriberRecalculateHeight s new
1539 subscriberRecalculateHeight s new
1534 }
1540 }
1535 liftIO $ do
1541 liftIO $ do
@@ -2201,7 +2207,7 @@ runFrame a = SpiderHost $ do
2201 myHeight <- readIORef $ switchSubscribedHeight subscribed
2207 myHeight <- readIORef $ switchSubscribedHeight subscribed
2202 when (parentHeight /= myHeight) $ do
2208 when (parentHeight /= myHeight) $ do
2203 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
2209 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
2204− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
2210+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
2205 mapM_ _someMergeUpdate_invalidateHeight mergeUpdates --TODO: In addition to when the patch is completely empty, we should also not run this if it has some Nothing values, but none of them have actually had any effect; potentially, we could even check for Just values with no effect (e.g. by comparing their IORefs and ignoring them if they are unchanged); actually, we could just check if the new height is different
2211 mapM_ _someMergeUpdate_invalidateHeight mergeUpdates --TODO: In addition to when the patch is completely empty, we should also not run this if it has some Nothing values, but none of them have actually had any effect; potentially, we could even check for Just values with no effect (e.g. by comparing their IORefs and ignoring them if they are unchanged); actually, we could just check if the new height is different
2206 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do
2212 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do
2207 unsubscribe subscription
2213 unsubscribe subscription
@@ -2242,7 +2248,7 @@ invalidateCoincidenceHeight subscribed = do
2242 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed
2248 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed
2243 when (oldHeight /= invalidHeight) $ do
2249 when (oldHeight /= invalidHeight) $ do
2244 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight
2250 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight
2245− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
2251+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
2246
2252
2247updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()
2253updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()
2248updateSwitchHeight new subscribed = do
2254updateSwitchHeight new subscribed = do
@@ -2250,7 +2256,7 @@ updateSwitchHeight new subscribed = do
2250 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
2256 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
2251 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion
2257 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion
2252 writeIORef (switchSubscribedHeight subscribed) $! new
2258 writeIORef (switchSubscribedHeight subscribed) $! new
2253− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new
2259+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new
2254
2260
2255recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
2261recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
2256recalculateCoincidenceHeight subscribed = do
2262recalculateCoincidenceHeight subscribed = do
@@ -2259,7 +2265,7 @@ recalculateCoincidenceHeight subscribed = do
2259 height <- calculateCoincidenceHeight subscribed
2265 height <- calculateCoincidenceHeight subscribed
2260 when (height /= invalidHeight) $ do
2266 when (height /= invalidHeight) $ do
2261 writeIORef (coincidenceSubscribedHeight subscribed) $! height
2267 writeIORef (coincidenceSubscribedHeight subscribed) $! height
2262− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
2268+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
2263
2269
2264calculateSwitchHeight :: SwitchSubscribed x a -> IO Height
2270calculateSwitchHeight :: SwitchSubscribed x a -> IO Height
2265calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)
2271calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)