on develop help sign in
Merge branch 'develop' into quickref-runwithreplace
commit76357d1a9ba41be3155d74e747712f1ce2027909 authorJohn Ericson <John.Ericson@Obsidian.Systems> dateMon 9 Dec 2019, 18:33 (7 years ago) parent322fd6718595a1
11 files changed+97−139
ChangeLog.md+6 default.nix+8−2 dep/reflex-platform/default.nix+7 dep/reflex-platform/github.json+7 hydra.json−29 jobsets.nix−70 reflex-platform.nix−8 release.nix+36−7 src/Data/FastWeakBag.hs+9−4 src/Data/WeakBag.hs+8−3 src/Reflex/Spider/Internal.hs+16−16
ChangeLog.md+6
@@ -1,5 +1,11 @@
11# Revision history for reflex
22
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+
39## 0.6.2.4
410
511* Update to monoidal-containers 0.6
default.nix+8−2
@@ -7,13 +7,18 @@
77, transformers-compat, unbounded-delays, prim-uniq
88, data-default, filepath, directory, filemanip, ghcjs-base
99, monoidal-containers, witherable, profunctors
10−, semialign ? null, splitThese ? (semialign != null)
10+, splitThese ? (semialign != null), semialign ? null, these-lens ? null
1111, useTemplateHaskell ? true
1212}:
1313mkDerivation {
1414 pname = "reflex";
1515 version = "0.6.2.4";
16− src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;
16+ src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [
17+ "default.nix"
18+ "release.nix"
19+ ".git"
20+ "dist"
21+ ])) ./.;
1722 libraryHaskellDepends = [
1823 base bifunctors containers dependent-map dependent-sum
1924 exception-transformers lens
@@ -30,6 +35,7 @@ mkDerivation {
3035 haskell-src-exts haskell-src-meta
3136 ]) ++ (if splitThese then [
3237 semialign
38+ these-lens
3339 ] else []);
3440 testHaskellDepends = if ghc.isGhcjs or false then [] else [
3541 hlint filepath directory filemanip
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
release.nix+36−7
@@ -1,9 +1,38 @@
1−{ rp ? import ./reflex-platform.nix {}
1+{ reflex-platform-fun ? import ./dep/reflex-platform
22}:
3+
34let
4− inherit (rp.nixpkgs) lib;
5− compilers = ["ghc8_4" "ghc8_0" "ghcjs8_4" "ghcjs8_0"];
6−in lib.attrValues (lib.genAttrs compilers (ghc: {
7− reflex-useTemplateHaskell = rp.${ghc}.callPackage ./. { useTemplateHaskell = true; splitThese = false; };
8− reflex = rp.${ghc}.callPackage ./. { useTemplateHaskell = false; splitThese = false; };
9−}))
5+ native-reflex-platform = reflex-platform-fun {};
6+ inherit (native-reflex-platform.nixpkgs) lib;
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+ ];
20+ hsPkgs = lib.genAttrs compilers (ghc: let
21+ ghc' = reflex-platform.${ghc}.override {
22+ overrides = self: super: {
23+ reflex-dontUseTemplateHaskell = self.callPackage ./. { useTemplateHaskell = false; };
24+ reflex = self.callPackage ./. { useTemplateHaskell = true; };
25+ };
26+ };
27+ in {
28+ inherit (ghc') reflex reflex-dontUseTemplateHaskell;
29+ });
30+ in hsPkgs // {
31+ cache = reflex-platform.pinBuildInputs "reflex-${system}"
32+ (lib.concatLists (map builtins.attrValues (builtins.attrValues hsPkgs)));
33+ });
34+
35+ metaCache = native-reflex-platform.pinBuildInputs "reflex-everywhere"
36+ (map (a: a.cache) (builtins.attrValues perPlatform));
37+
38+in perPlatform // { inherit metaCache; }
src/Data/FastWeakBag.hs+9−4
@@ -18,6 +18,7 @@ module Data.FastWeakBag
1818 , isEmpty
1919 , insert
2020 , traverse
21+ , traverse_
2122 , remove
2223 -- * Internal functions
2324 -- These will not always be available.
@@ -116,14 +117,14 @@ foreign import javascript unsafe "(function(){ for(var i = 0; i < $1.tickets.len
116117isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children bag)
117118#endif
118119
119−{-# INLINE traverse #-}
120+{-# INLINE traverse_ #-}
120121-- | Visit every node in the given list. If new nodes are appended during the
121122-- traversal, they will not be visited. Every live node that was in the list
122123-- when the traversal began will be visited exactly once; however, no guarantee
123124-- 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 ()
125126#ifdef GHCJS_FAST_WEAK
126−traverse wb f = do
127+traverse_ wb f = do
127128 let go cursor = when (not $ js_isNull cursor) $ do
128129 val <- liftIO $ js_getTicketValue cursor
129130 f $ unsafeFromRawJSVal val
@@ -134,13 +135,17 @@ foreign import javascript unsafe "$r = $1.val;" js_getTicketValue :: JSVal -> IO
134135--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
135136foreign 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
136137#else
137−traverse (FastWeakBag _ children) f = {-# SCC "traverse" #-} do
138+traverse_ (FastWeakBag _ children) f = {-# SCC "traverse_" #-} do
138139 cs <- liftIO $ readIORef children
139140 forM_ cs $ \c -> do
140141 ma <- liftIO $ deRefWeak c
141142 mapM_ f ma
142143#endif
143144
145+{-# DEPRECATED traverse "Use 'traverse_' instead" #-}
146+traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
147+traverse = traverse_
148+
144149-- | Remove an item from the 'FastWeakBag'; does nothing if invoked multiple times
145150-- on the same 'FastWeakBagTicket'.
146151{-# INLINE remove #-}
src/Data/WeakBag.hs+8−3
@@ -15,6 +15,7 @@ module Data.WeakBag
1515 , singleton
1616 , insert
1717 , traverse
18+ , traverse_
1819 , remove
1920 -- * Internal functions
2021 -- These will not always be available.
@@ -99,18 +100,22 @@ singleton a wbRef finalizer = {-# SCC "singleton" #-} do
99100 ticket <- insert a bag wbRef finalizer
100101 return (bag, ticket)
101102
102−{-# INLINE traverse #-}
103+{-# INLINE traverse_ #-}
103104-- | Visit every node in the given list. If new nodes are appended during the
104105-- traversal, they will not be visited. Every live node that was in the list
105106-- when the traversal began will be visited exactly once; however, no guarantee
106107-- is made about the order of the traversal.
107−traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
108−traverse (WeakBag _ children) f = {-# SCC "traverse" #-} do
108+traverse_ :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
109+traverse_ (WeakBag _ children) f = {-# SCC "traverse" #-} do
109110 cs <- liftIO $ readIORef children
110111 forM_ cs $ \c -> do
111112 ma <- liftIO $ deRefWeak c
112113 mapM_ f ma
113114
115+{-# DEPRECATED traverse "Use 'traverse_' instead" #-}
116+traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
117+traverse = traverse_
118+
114119-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times
115120-- on the same 'WeakBagTicket'.
116121{-# INLINE remove #-}
src/Reflex/Spider/Internal.hs+16−16
@@ -332,9 +332,9 @@ cacheEvent e =
332332 scheduleClear occRef
333333 propagateFast a subscribers
334334 , subscriberInvalidateHeight = \old -> do
335− FastWeakBag.traverse subscribers $ invalidateSubscriberHeight old
335+ FastWeakBag.traverse_ subscribers $ invalidateSubscriberHeight old
336336 , subscriberRecalculateHeight = \new -> do
337− FastWeakBag.traverse subscribers $ recalculateSubscriberHeight new
337+ FastWeakBag.traverse_ subscribers $ recalculateSubscriberHeight new
338338 }
339339 when (isJust occ) $ do
340340 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing
@@ -450,12 +450,12 @@ newSubscriberFan subscribed = return $ Subscriber
450450 , subscriberInvalidateHeight = \old -> do
451451 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
452452 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
453− 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
454454 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
455455 , subscriberRecalculateHeight = \new -> do
456456 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed
457457 subscribers <- readIORef $ fanSubscribedSubscribers subscribed
458− 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
459459 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberFan" <> showNodeId subscribed <> " done"
460460 }
461461
@@ -471,7 +471,7 @@ newSubscriberSwitch subscribed = return $ Subscriber
471471 oldHeight <- readIORef $ switchSubscribedHeight subscribed
472472 when (oldHeight /= invalidHeight) $ do
473473 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
474− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
474+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
475475 when debugInvalidateHeight $ putStrLn $ "invalidateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed <> " done"
476476 , subscriberRecalculateHeight = \new -> do
477477 when debugInvalidateHeight $ putStrLn $ "recalculateSubscriberHeight: SubscriberSwitch" <> showNodeId subscribed
@@ -494,8 +494,8 @@ newSubscriberCoincidenceOuter subscribed = return $ Subscriber
494494 Nothing -> do
495495 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height
496496 writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight
497− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
498− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight
497+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight
498+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight
499499 Just o -> do -- Since it's already firing, no need to adjust height
500500 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ
501501 scheduleClear $ coincidenceSubscribedOccurrence subscribed
@@ -542,14 +542,14 @@ propagate :: a -> WeakBag (Subscriber x a) -> EventM x ()
542542propagate a subscribers = withIncreasedDepth $ do
543543 -- 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
544544 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
545− WeakBag.traverse subscribers $ \s -> subscriberPropagate s a
545+ WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
546546
547547-- | Propagate everything at the current height
548548propagateFast :: a -> FastWeakBag (Subscriber x a) -> EventM x ()
549549propagateFast a subscribers = withIncreasedDepth $ do
550550 -- 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
551551 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work
552− FastWeakBag.traverse subscribers $ \s -> subscriberPropagate s a
552+ FastWeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a
553553
554554--------------------------------------------------------------------------------
555555-- EventSubscribed
@@ -1527,15 +1527,15 @@ fanInt p = unsafePerformIO $ do
15271527 liftIO $ writeIORef (_fanInt_occRef self) m
15281528 scheduleIntClear $ _fanInt_occRef self
15291529 FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> do --TODO: Do we need to know that no subscribers are being added as we traverse?
1530− FastWeakBag.traverse b $ \s -> do
1530+ FastWeakBag.traverse_ b $ \s -> do
15311531 subscriberPropagate s v
15321532 , subscriberInvalidateHeight = \old -> do
15331533 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1534− FastWeakBag.traverse b $ \s -> do
1534+ FastWeakBag.traverse_ b $ \s -> do
15351535 subscriberInvalidateHeight s old
15361536 , subscriberRecalculateHeight = \new -> do
15371537 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b -> do
1538− FastWeakBag.traverse b $ \s -> do
1538+ FastWeakBag.traverse_ b $ \s -> do
15391539 subscriberRecalculateHeight s new
15401540 }
15411541 liftIO $ do
@@ -2207,7 +2207,7 @@ runFrame a = SpiderHost $ do
22072207 myHeight <- readIORef $ switchSubscribedHeight subscribed
22082208 when (parentHeight /= myHeight) $ do
22092209 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight
2210− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
2210+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight
22112211 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
22122212 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do
22132213 unsubscribe subscription
@@ -2248,7 +2248,7 @@ invalidateCoincidenceHeight subscribed = do
22482248 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed
22492249 when (oldHeight /= invalidHeight) $ do
22502250 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight
2251− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
2251+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight
22522252
22532253updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()
22542254updateSwitchHeight new subscribed = do
@@ -2256,7 +2256,7 @@ updateSwitchHeight new subscribed = do
22562256 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion
22572257 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion
22582258 writeIORef (switchSubscribedHeight subscribed) $! new
2259− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new
2259+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new
22602260
22612261recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()
22622262recalculateCoincidenceHeight subscribed = do
@@ -2265,7 +2265,7 @@ recalculateCoincidenceHeight subscribed = do
22652265 height <- calculateCoincidenceHeight subscribed
22662266 when (height /= invalidHeight) $ do
22672267 writeIORef (coincidenceSubscribedHeight subscribed) $! height
2268− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
2268+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height
22692269
22702270calculateSwitchHeight :: SwitchSubscribed x a -> IO Height
22712271calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)