194ba06 · reflex · git.iko.soy

git.iko.soy/reflex

Merge branch 'develop' into ls-cleanup-debug

commit194ba0678013c789903760ad5356871dd0ba8a0c authorleon.smith@obsidian.systems <leon.smith@obsidian.systems> dateFri 13 Dec 2019, 11:53 (7 years ago) parentcdf637c 41b9eaa

19 files changed+208−205

compare with develop

unifiedsplit

ChangeLog.md+32 Quickref.md+14−11 default.nix−43 dep/reflex-platform/default.nix+7 dep/reflex-platform/github.json+7 hydra.json−29 jobsets.nix−70 reflex-platform.nix−8 reflex.cabal+5−5 release.nix+53−7 src/Data/AppendMap.hs+3−1 src/Data/FastWeakBag.hs+9−4 src/Data/WeakBag.hs+8−3 src/Reflex/Class.hs+8−2 src/Reflex/Collection.hs+4−1 src/Reflex/Network.hs+1−1 src/Reflex/Patch/MapWithMove.hs+1−1 src/Reflex/Spider/Internal.hs+55−18 src/Reflex/Workflow.hs+1−1

ChangeLog.md+32

@@ -1,9 +1,31 @@

11# Revision history for reflex

3+## Unreleased

5+* Data.WeakBag.traverse and Data.FastWeakBag.traverse have been

6+ renamed to Data.WeakBag.traverse_ and Data.FastWeakBag.traverse_

7+ respectively.

9+* Fixes a bug in `Reflex.Patch.MapWithMove.patchThatSortsMapWith` that was producing invalid `PatchMapWithMove`.

10+

11+* Add missing `NotReady` instances:

12+ - `instance NotReady (SpiderTimeline x) (SpiderHost x)`

13+ - `instance HasSpiderTimeline x => NotReady (SpiderTimeline x) (PerformEventT (SpiderTimeline x) (SpiderHost x))`

14+

15+## 0.6.2.4

16+

17+* Update to monoidal-containers 0.6

18+

19+## 0.6.2.3

20+

21+* Add an upper-bound to witherable

22+

323## 0.6.2.2

424

525* Support these >= 1. Add `split-these` flag to control whether to use new these/semialign combination or not.

26+

627* Update version bounds to fix some CI failures

28+

729* Add travis CI configuration

830

931## 0.6.2.1

@@ -29,21 +51,31 @@

2951

3052* Fix `holdDyn` so that it is lazy in its event argument

3153 These produce `DMap`s whose values needn't be `Identity`.

54+

3255* Stop using the now-deprecated `*Tag` classes (e.g., `ShowTag`).

56+

3357* Fix `holdDyn` so that it is lazy in its event argument.

3458

3559## 0.6.1.0

3660

3761* Re-export all of `Data.Map.Monoidal`

62+

3863* Fix `QueryT` and `RequesterT` tests

3964

4065## 0.6.0.0 -- 2019-03-20

4166

4267* Deprecate `FunctorMaybe` in favor of `Data.Witherable.Filterable`. We still export `fmapMaybe`, `ffilter`, etc., but they all rely on `Filterable` now.

68+

4369* Rename `MonadDynamicWriter` to `DynamicWriter` and add a deprecation for the old name.

70+

4471* Remove many deprecated functions.

72+

4573* Add a `Num` instance for `Dynamic`.

74+

4675* Add `matchRequestsWithResponses` to make it easier to use `Requester` with protocols that don't do this matching for you.

76+

4777* Add `withRequesterT` to map functions over the request and response of a `RequesterT`.

78+

4879* Suppress nil patches in `QueryT` as an optimization. The `Query` type must now have an `Eq` instance.

80+

4981* Add `throttleBatchWithLag` to `Reflex.Time`. See that module for details.

Quickref.md+14−11

@@ -198,7 +198,7 @@ For Events, the returned Event fires whenever the latest Event supplied by the w

198198The functions mentioned above are used to create a static FRP network.

199199There are additional typeclasses that can be used to modify the FRP network, to have it interact with IO action, or to introspect the building of the network.

200200

201−Th typeclasses and their associated annotations include:

201+The typeclasses and their associated annotations include:

202202

203203- `PostBuild`

204204 Fire an Event when an FRP network has been set up.

@@ -206,7 +206,7 @@ Th typeclasses and their associated annotations include:

206206 [B] -- Function runs in any monad supporting PostBuild

207207 ```

208208

209−- `Adjustable`

209+- `Adjustable`

210210 Use Events to add or remove pieces of an FRP network.

211211 ```haskell

212212 [A] -- Function runs in any monad supporting Adjustable

@@ -271,7 +271,7 @@ Th typeclasses and their associated annotations include:

271271```haskell

272272-- Run side-effecting actions in Event when it occurs; returned Event contains

273273-- results. Side effects run in the (Performable m) monad which is associated with

274−-- the (PerformEvent t m) typeclass constraint.

274+-- the (PerformEvent t m) typeclass constraint.

275275-- This allows for working with IO when a ((MonadIO (Performable m)) constraint is available.

276276[P] performEvent :: Event (Performable m a ) -> m (Event a)

277277

@@ -295,17 +295,20 @@ Th typeclasses and their associated annotations include:

295295## Networks

296296

297297```haskell

298−-- Functions from Reflex.Network used to deal with Dynamics/Events carrying (m a)

298+-- Functions from Reflex.Adjustable / Reflex.Network used to deal with Dynamics/Events carrying (m a)

299299

300−-- Given a Dynamic of network-creating actions, create a network that is recreated whenever the Dynamic updates.

301−-- The returned Event of network results occurs when the Dynamic does. Note: Often, the type a is an Event,

300+[A] runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)

301+

302+-- Given a Dynamic of network-creating actions, create a network that is recreated whenever the Dynamic updates.

303+-- The returned Event of network results occurs when the Dynamic does. Note: Often, the type a is an Event,

302304-- in which case the return value is an Event-of-Events that would typically be flattened (via switchHold).

303−[P,A] networkView :: Dynamic (m a) -> m (Event a)

305+[P,A] networkView :: Dynamic (m a) -> m (Event a)

304306

305−-- Given an initial network and an Event of network-creating actions, create a network that is recreated whenever the

306−-- Event fires. The returned Dynamic of network results occurs when the Event does. Note: Often, the type a is an

307+-- Given an initial network and an Event of network-creating actions, create a network that is recreated whenever the

308+-- Event fires. The returned Dynamic of network results occurs when the Event does. Note: Often, the type a is an

307309-- Event, in which case the return value is a Dynamic-of-Events that would typically be flattened.

308−[H,A] networkHold :: m a -> Event (m a) -> m (Dynamic a)

310+[H,A] networkHold :: m a -> Event (m a) -> m (Dynamic a)

309311

310312-- Render a placeholder network to be shown while another network is not yet done building

311−[P,A] untilReady :: m a -> m b -> m (a, Event b)

313+[P,A] untilReady :: m a -> m b -> m (a, Event b)

314+```

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, profunctors

10−, semialign ? null, splitThese ? (semialign != null)

11−, useTemplateHaskell ? true

12−}:

13−mkDerivation {

14− pname = "reflex";

15− version = "0.6.2.2";

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− 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": "develop",

5+ "rev": "e7b76dd552a10916c7d8702c11292dac4f4299ea",

6+ "sha256": "0s1183arrwldcs50qhzgnv94v24n9bgq6dfq64wp0a3q2nzyvgwh"

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+5−5

@@ -1,5 +1,5 @@

11Name: reflex

2−Version: 0.6.2.2

2+Version: 0.6.2.4

33Synopsis: Higher-order Functional Reactive Programming

44Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system

55License: BSD3

@@ -85,15 +85,15 @@ library

8585 time >= 1.4 && < 1.9,

8686 transformers >= 0.5.6.0 && < 0.6,

8787 unbounded-delays >= 0.1.0.0 && < 0.2,

88− witherable >= 0.2 && < 0.4

88+ witherable >= 0.3 && < 0.3.2

8989

9090 if flag(split-these)

9191 build-depends: these >= 1 && <1.1,

92− semialign >=1 && <1.1,

93− monoidal-containers >= 0.5.0.1 && < 0.6

92+ semialign >=1 && <1.2,

93+ monoidal-containers >= 0.6 && < 0.7

9494 else

9595 build-depends: these >= 0.4 && <0.9,

96− monoidal-containers == 0.5.0.0

96+ monoidal-containers == 0.4.0.0

9797

9898 exposed-modules:

9999 Control.Monad.ReaderIO

release.nix+53−7

@@ -1,9 +1,55 @@

1−{ rp ? import ./reflex-platform.nix {}

1+{ reflex-platform-fun ? import ./dep/reflex-platform

22}:

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"];

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+ variations = map (v: "reflex" + v) [

21+ "-dontUseTemplateHaskell"

22+ ""

23+ ];

24+ compilerPkgs = lib.genAttrs compilers (ghc: let

25+ variationPkgs = lib.genAttrs variations (variation: let

26+ reflex-platform = reflex-platform-fun {

27+ inherit system;

28+ __useTemplateHaskell = variation == "reflex"; # TODO hack

29+ haskellOverlays = [

30+ # Use this package's source for reflex

31+ (self: super: {

32+ _dep = super._dep // {

33+ reflex = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [

34+ "release.nix"

35+ ".git"

36+ "dist"

37+ ])) ./.;

38+ };

39+ })

40+ ];

41+ };

42+ in reflex-platform.${ghc}.reflex);

43+ in variationPkgs // {

44+ cache = reflex-platform.pinBuildInputs "reflex-${system}-${ghc}"

45+ (builtins.attrValues variationPkgs);

46+ });

47+ in compilerPkgs // {

48+ cache = reflex-platform.pinBuildInputs "reflex-${system}"

49+ (map (a: a.cache) (builtins.attrValues compilerPkgs));

50+ });

51+

52+ metaCache = native-reflex-platform.pinBuildInputs "reflex-everywhere"

53+ (map (a: a.cache) (builtins.attrValues perPlatform));

54+

55+in perPlatform // { inherit metaCache; }

src/Data/AppendMap.hs+3−1

@@ -32,6 +32,8 @@ import qualified Data.Map as Map (showTree, showTreeWith)

3232#endif

3333import qualified Data.Witherable as W

3434import Data.Map.Monoidal

35+import qualified Data.Map.Monoidal as MonoidalMap

36+

3537

3638{-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-}

3739-- | AppendMap is a synonym for 'Data.Map.Monoidal.MonoidalMap'

@@ -48,7 +50,7 @@ pattern AppendMap m = MonoidalMap m

4850

4951#if !MIN_VERSION_witherable(0,3,2)

5052instance W.Filterable (MonoidalMap k) where

51− mapMaybe = mapMaybe

53+ mapMaybe = MonoidalMap.mapMaybe

5254#endif

5355

5456-- | Deletes a key, returning 'Nothing' if the result is empty.

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/Class.hs+8−2

@@ -173,12 +173,15 @@ module Reflex.Class

173173 , slowHeadE

174174 ) where

175175

176−#if defined(MIN_VERSION_semialign)

176+#ifdef MIN_VERSION_semialign

177177import Prelude hiding (zip, zipWith)

178178

179179#if MIN_VERSION_these(0,8,0)

180180import Data.These.Combinators (justThese)

181181#endif

182+#if MIN_VERSION_semialign(1,1,0)

183+import Data.Zip (Zip (..))

184+#endif

182185#endif

183186

184187import Control.Applicative

@@ -1077,7 +1080,10 @@ instance Reflex t => Semialign (Event t) where

10771080#endif

10781081 align = alignEventWithMaybe Just

10791082

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

10811087 zip x y = mapMaybe justThese $ align x y

10821088#endif

10831089

src/Reflex/Collection.hs+4−1

@@ -27,8 +27,11 @@ module Reflex.Collection

2727 , simpleList

2828 ) where

2929

30−#if defined(MIN_VERSION_semialign)

30+#ifdef MIN_VERSION_semialign

3131import Prelude hiding (zip, zipWith)

32+#if MIN_VERSION_semialign(1,1,0)

33+import Data.Zip (Zip (..))

34+#endif

3235#endif

3336

3437import Control.Monad.Identity

src/Reflex/Network.hs+1−1

@@ -20,7 +20,7 @@ import Reflex.NotReady.Class

2020import Reflex.PostBuild.Class

2121

2222-- | A 'Dynamic' "network": Takes a 'Dynamic' of network-creating actions and replaces the network whenever the 'Dynamic' updates.

23−-- The returned Event of network results fires when the 'Dynamic' updates.

23+-- The returned Event of network results fires at post-build time and when the 'Dynamic' updates.

2424-- Note: Often, the type 'a' is an Event, in which case the return value is an Event-of-Events, where the outer 'Event' fires

2525-- when switching networks. Such an 'Event' would typically be flattened (via 'switchPromptly').

2626networkView :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)

src/Reflex/Patch/MapWithMove.hs+1−1

@@ -155,7 +155,7 @@ patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipW

155155 Just (from, to)

156156 reverseMapping = Map.fromList $ catMaybes $ zipWith f unsorted sorted

157157 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

159159 in Just (to, NodeInfo (From_Move from) $ Just movingTo)

160160

161161-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,

src/Reflex/Spider/Internal.hs+55−18

@@ -73,10 +73,13 @@ import System.IO.Unsafe

7373import System.Mem.Weak

7474import Unsafe.Coerce

7575

76−#if defined(MIN_VERSION_semialign)

76+#ifdef MIN_VERSION_semialign

7777#if MIN_VERSION_these(0,8,0)

7878import Data.These.Combinators (justThese)

7979#endif

80+#if MIN_VERSION_semialign(1,1,0)

81+import Data.Zip (Zip (..))

82+#endif

8083#endif

8184

8285#ifdef DEBUG_CYCLES

@@ -103,6 +106,7 @@ import qualified Reflex.Host.Class

103106import Reflex.NotReady.Class

104107import Reflex.Patch

105108import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove

109+import Reflex.PerformEvent.Base (PerformEventT)

106110

107111#ifdef DEBUG_TRACE_EVENTS

108112import qualified Data.ByteString.Char8 as BS8

@@ -294,6 +298,7 @@ cacheEvent e =

294298#endif

295299 subscribers <- liftIO FastWeakBag.empty

296300 occRef <- liftIO $ newIORef Nothing -- This should never be read prior to being set below

301+<<<<<<< HEAD

297302 (parentSub, occ) <- subscribeAndRead e $ debugSubscriber' ("cacheEvent" <> showNodeId' nodeId) $ Subscriber

298303 { subscriberPropagate = \a -> do

299304 -- checkCycle (_eventSubscription_subscribed parentSub)

@@ -303,6 +308,29 @@ cacheEvent e =

303308 , subscriberInvalidateHeight = FastWeakBag.traverse subscribers . invalidateSubscriberHeight

304309 , subscriberRecalculateHeight = FastWeakBag.traverse subscribers . recalculateSubscriberHeight

305310 }

311+||||||| merged common ancestors

312+ (parentSub, occ) <- subscribeAndRead e $ Subscriber

313+ { subscriberPropagate = \a -> do

314+ liftIO $ writeIORef occRef $ Just a

315+ scheduleClear occRef

316+ propagateFast a subscribers

317+ , subscriberInvalidateHeight = \old -> do

318+ FastWeakBag.traverse subscribers $ invalidateSubscriberHeight old

319+ , subscriberRecalculateHeight = \new -> do

320+ FastWeakBag.traverse subscribers $ recalculateSubscriberHeight new

321+ }

322+=======

323+ (parentSub, occ) <- subscribeAndRead e $ Subscriber

324+ { subscriberPropagate = \a -> do

325+ liftIO $ writeIORef occRef $ Just a

326+ scheduleClear occRef

327+ propagateFast a subscribers

328+ , subscriberInvalidateHeight = \old -> do

329+ FastWeakBag.traverse_ subscribers $ invalidateSubscriberHeight old

330+ , subscriberRecalculateHeight = \new -> do

331+ FastWeakBag.traverse_ subscribers $ recalculateSubscriberHeight new

332+ }

333+>>>>>>> develop

306334 when (isJust occ) $ do

307335 liftIO $ writeIORef occRef occ -- Set the initial value of occRef; we don't need to do this if occ is Nothing

308336 scheduleClear occRef

@@ -435,14 +463,12 @@ newSubscriberFan subscribed = debugSubscriber ("SubscriberFan " <> showNodeId su

435463 return ()

436464 , subscriberInvalidateHeight = \old -> do

437465 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

438− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old

439−

466+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ invalidateSubscriberHeight old

440467 , subscriberRecalculateHeight = \new -> do

441468 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

442− forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new

469+ forM_ (DMap.toList subscribers) $ \(_ :=> v) -> WeakBag.traverse_ (_fanSubscribedChildren_list v) $ recalculateSubscriberHeight new

443470 }

444471

445−

446472newSubscriberSwitch :: forall x a. HasSpiderTimeline x => SwitchSubscribed x a -> IO (Subscriber x a)

447473newSubscriberSwitch subscribed = debugSubscriber ("SubscriberCoincidenceOuter" <> showNodeId subscribed) $ Subscriber

448474 { subscriberPropagate = \a -> {-# SCC "traverseSwitch" #-} do

@@ -453,7 +479,7 @@ newSubscriberSwitch subscribed = debugSubscriber ("SubscriberCoincidenceOuter" <

453479 oldHeight <- readIORef $ switchSubscribedHeight subscribed

454480 when (oldHeight /= invalidHeight) $ do

455481 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight

456− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

482+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

457483 , subscriberRecalculateHeight = (`updateSwitchHeight` subscribed)

458484 }

459485

@@ -472,8 +498,8 @@ newSubscriberCoincidenceOuter subscribed = debugSubscriber ("SubscriberCoinciden

472498 Nothing ->

473499 when (innerHeight > outerHeight) $ liftIO $ do -- If the event fires, it will fire at a later height

474500 writeIORef (coincidenceSubscribedHeight subscribed) $! innerHeight

475− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight

476− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight

501+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight outerHeight

502+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight innerHeight

477503 Just o -> do -- Since it's already firing, no need to adjust height

478504 liftIO $ writeIORef (coincidenceSubscribedOccurrence subscribed) occ

479505 scheduleClear $ coincidenceSubscribedOccurrence subscribed

@@ -507,14 +533,14 @@ propagate :: forall x a. HasSpiderTimeline x => a -> WeakBag (Subscriber x a) ->

507533propagate a subscribers = withIncreasedDepth (Proxy::Proxy x) $

508534 -- 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

509535 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work

510− WeakBag.traverse subscribers $ \s -> subscriberPropagate s a

536+ WeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a

511537

512538-- | Propagate everything at the current height

513539propagateFast :: forall x a. HasSpiderTimeline x => a -> FastWeakBag (Subscriber x a) -> EventM x ()

514540propagateFast a subscribers = withIncreasedDepth (Proxy::Proxy x) $

515541 -- 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

516542 --TODO: Should we check if nodes already have their values before propagating? Maybe we're re-doing work

517− FastWeakBag.traverse subscribers $ \s -> subscriberPropagate s a

543+ FastWeakBag.traverse_ subscribers $ \s -> subscriberPropagate s a

518544

519545--------------------------------------------------------------------------------

520546-- EventSubscribed

@@ -1139,7 +1165,10 @@ instance HasSpiderTimeline x => Semialign (Event x) where

11391165 align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $

11401166 DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

11411167

1142−#if defined(MIN_VERSION_semialign)

1168+#ifdef MIN_VERSION_semialign

1169+#if MIN_VERSION_semialign(1,1,0)

1170+instance HasSpiderTimeline x => Zip (Event x) where

1171+#endif

11431172 zip x y = mapMaybe justThese $ align x y

11441173#endif

11451174

@@ -1587,15 +1616,15 @@ fanInt p = unsafePerformIO $ do

15871616 liftIO $ writeIORef (_fanInt_occRef self) m

15881617 scheduleIntClear $ _fanInt_occRef self

15891618 FastMutableIntMap.forIntersectionWithImmutable_ (_fanInt_subscribers self) m $ \b v -> --TODO: Do we need to know that no subscribers are being added as we traverse?

1590− FastWeakBag.traverse b $ \s ->

1619+ FastWeakBag.traverse_ b $ \s ->

15911620 subscriberPropagate s v

15921621 , subscriberInvalidateHeight = \old ->

15931622 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b ->

1594− FastWeakBag.traverse b $ \s ->

1623+ FastWeakBag.traverse_ b $ \s ->

15951624 subscriberInvalidateHeight s old

15961625 , subscriberRecalculateHeight = \new ->

15971626 FastMutableIntMap.for_ (_fanInt_subscribers self) $ \b ->

1598− FastWeakBag.traverse b $ \s ->

1627+ FastWeakBag.traverse_ b $ \s ->

15991628 subscriberRecalculateHeight s new

16001629 }

16011630 liftIO $ do

@@ -2326,7 +2355,7 @@ runFrame a = SpiderHost $ do

23262355 myHeight <- readIORef $ switchSubscribedHeight subscribed

23272356 when (parentHeight /= myHeight) $ do

23282357 writeIORef (switchSubscribedHeight subscribed) $! invalidHeight

2329− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight

2358+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ invalidateSubscriberHeight myHeight

23302359 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

23312360 forM_ coincidenceInfos $ \(SomeResetCoincidence subscription mcs) -> do

23322361 unsubscribe subscription

@@ -2367,7 +2396,7 @@ invalidateCoincidenceHeight subscribed = do

23672396 oldHeight <- readIORef $ coincidenceSubscribedHeight subscribed

23682397 when (oldHeight /= invalidHeight) $ do

23692398 writeIORef (coincidenceSubscribedHeight subscribed) $! invalidHeight

2370− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

2399+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ invalidateSubscriberHeight oldHeight

23712400

23722401updateSwitchHeight :: Height -> SwitchSubscribed x a -> IO ()

23732402updateSwitchHeight new subscribed = do

@@ -2375,7 +2404,7 @@ updateSwitchHeight new subscribed = do

23752404 when (oldHeight == invalidHeight) $ do --TODO: This 'when' should probably be an assertion

23762405 when (new /= invalidHeight) $ do --TODO: This 'when' should probably be an assertion

23772406 writeIORef (switchSubscribedHeight subscribed) $! new

2378− WeakBag.traverse (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new

2407+ WeakBag.traverse_ (switchSubscribedSubscribers subscribed) $ recalculateSubscriberHeight new

23792408

23802409recalculateCoincidenceHeight :: CoincidenceSubscribed x a -> IO ()

23812410recalculateCoincidenceHeight subscribed = do

@@ -2384,7 +2413,7 @@ recalculateCoincidenceHeight subscribed = do

23842413 height <- calculateCoincidenceHeight subscribed

23852414 when (height /= invalidHeight) $ do

23862415 writeIORef (coincidenceSubscribedHeight subscribed) $! height

2387− WeakBag.traverse (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height

2416+ WeakBag.traverse_ (coincidenceSubscribedSubscribers subscribed) $ recalculateSubscriberHeight height

23882417

23892418calculateSwitchHeight :: SwitchSubscribed x a -> IO Height

23902419calculateSwitchHeight subscribed = getEventSubscribedHeight . _eventSubscription_subscribed =<< readIORef (switchSubscribedCurrentParent subscribed)

@@ -2824,3 +2853,11 @@ instance MonadAtomicRef (SpiderHostFrame x) where

28242853instance PrimMonad (SpiderHostFrame x) where

28252854 type PrimState (SpiderHostFrame x) = PrimState IO

28262855 primitive = SpiderHostFrame . EventM . primitive

2856+

2857+instance NotReady (SpiderTimeline x) (SpiderHost x) where

2858+ notReadyUntil _ = return ()

2859+ notReady = return ()

2860+

2861+instance HasSpiderTimeline x => NotReady (SpiderTimeline x) (PerformEventT (SpiderTimeline x) (SpiderHost x)) where

2862+ notReadyUntil _ = return ()

2863+ notReady = return ()

src/Reflex/Workflow.hs+1−1

@@ -34,7 +34,7 @@ workflow w0 = do

3434 rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult

3535 return $ fmap fst eResult

3636

37−-- | Similar to 'workflow', but outputs an 'Event' that fires whenever the current 'Workflow' is replaced by the next 'Workflow'.

37+-- | Similar to 'workflow', but outputs an 'Event' that fires at post-build time and whenever the current 'Workflow' is replaced by the next 'Workflow'.

3838workflowView :: forall t m a. (Reflex t, NotReady t m, Adjustable t m, MonadFix m, MonadHold t m, PostBuild t m) => Workflow t m a -> m (Event t a)

3939workflowView w0 = do

4040 rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace