144de62 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Merge branch 'release/0.6.2.1' of github.com:ryantrinkle/reflex

144de62Ali Abrar7 years ago

CONTRIBUTING.mdnew file+62

compare with develop

unifiedsplit

@@ -0,0 +1,62 @@

1+# Contribution Guide

3+Contributions and issue reports are encouraged and appreciated!

5+- [Opening Issues](#opening-issues)

6+- [Submitting Changes](#submitting-changes)

7+ - [Guidelines for Commit Messages](#guidelines-for-commit-messages)

8+ - [Guidelines for Pull Requests](#guidelines-for-pull-requests)

9+ - [Code Quality](#code-quality)

10+ - [Documentation](#documentation)

11+

12+## Opening Issues

13+

14+Before opening an issue, please check whether your issue has already been reported. Assuming it has not:

15+

16+* Describe the issue you're encountering or the suggestion you're making

17+* Include any relevant steps to reproduce or code samples you can. It's always easier for us to debug if we have something that demonstrates the error.

18+* Let us know what version of reflex you were using. If you're using a github checkout, provide the git hash.

19+* Describe how you're building reflex (i.e., via reflex-platform, cabal install, stack, obelisk, etc.). If you're using reflex-platform or obelisk, provide the git hash of your checkout.

20+

21+## Submitting Changes

22+

23+### Guidelines for Commit Messages

24+

25+#### Summary Line

26+The summary line of your commit message should summarize the changes being made. Commit messages should be written in the imperative mood and should describe what happens when the commit is applied.

27+

28+One way to think about it is that your commit message should be able to complete the sentence:

29+"When applied, this commit will..."

30+

31+#### Body

32+For breaking changes, new features, refactors, or other major changes, the body of the commit message should describe the motivation behind the change in greater detail and may include references to the issue tracker. The body shouldn't repeat code/comments from the diff.

33+

34+### Guidelines for Pull Requests

35+

36+Wherever possible, pull requests should add a single feature or fix a single bug. Pull requests should not bundle several unrelated changes.

37+

38+### Code Quality

39+

40+#### Warnings

41+

42+Your pull request should add no new warnings to the project. It should also generally not disable any warnings.

43+

44+#### Build and Test

45+

46+Make sure the project builds and that the tests pass! This will generally also be checked by CI before merge, but trying it yourself first means you'll catch problems earlier and your contribution can be merged that much sooner!

47+

48+### Documentation

49+

50+#### In the code

51+We're always striving to improve documentation. Please include [haddock](https://haskell-haddock.readthedocs.io/en/latest/index.html) documentation for any added code, and update the documentation for any code you modify.

52+

53+#### In the [Changelog](ChangeLog.md)

54+Add an entry to the changelog when your PR:

55+* Adds a feature

56+* Deprecates something

57+* Includes a breaking change

58+* Makes any other change that will impact users

59+

60+#### In the [Readme](README.md)

61+The readme is the first place a lot of people look for information about the repository. Update any parts of the readme that are affected by your PR.

62+

ChangeLog.md+30−11

@@ -1,17 +1,36 @@

1# Revision history for reflex

3−## 0.6.0.0 -- 2019-03-20

3+## Unreleased

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

5+* Generalize `fan` to `fanG` to take a `DMap` with non-`Identity`

6−* Rename MonadDynamicWriter to DynamicWriter and add a deprecation for the old name.

6+ values.

7−* Remove many deprecated functions.

8−* Add a Num instance for Dynamic.

8+* Generalize merging functions:

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

9+ `merge` to `mergeG`,

10−* Add withRequesterT to map functions over the request and response of a RequesterT.

10+ `mergeIncremental` to `mergeIncrementalG`,

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

11+ `distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,

12−* Add throttleBatchWithLag to Reflex.Time. See that module for details.

12+ `mergeIncrementalWithMove` to `mergeIncrementalWithMoveG`.

13+

14+

15+## 0.6.2.0

16+

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

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

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

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

14## 0.6.1.0

22## 0.6.1.0

16−* Re-export all of Data.Map.Monoidal

24+* Re-export all of `Data.Map.Monoidal`

17−* Fix QueryT and RequesterT tests

25+* Fix `QueryT` and `RequesterT` tests

26+

27+## 0.6.0.0 -- 2019-03-20

28+

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

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

31+* Remove many deprecated functions.

32+* Add a `Num` instance for `Dynamic`.

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

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

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

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

README.md+3−2

@@ -1,4 +1,7 @@

1## [Reflex](https://reflex-frp.org/)

3+[![Hackage](https://img.shields.io/hackage/v/reflex.svg)](http://hackage.haskell.org/package/reflex)

2### Practical Functional Reactive Programming

5### Practical Functional Reactive Programming

4Reflex is a fully-deterministic, higher-order Functional Reactive Programming (FRP) interface and an engine that efficiently implements that interface.

7Reflex is a fully-deterministic, higher-order Functional Reactive Programming (FRP) interface and an engine that efficiently implements that interface.

@@ -14,8 +17,6 @@ A summary of Reflex functions is available in the [quick reference](Quickref.md)

15[/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

18[/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

17−[hackage](https://hackage.haskell.org/package/reflex)

18−

19[irc.freenode.net #reflex-frp](http://webchat.freenode.net?channels=%23reflex-frp&uio=d4)

20[irc.freenode.net #reflex-frp](http://webchat.freenode.net?channels=%23reflex-frp&uio=d4)

21### Hacking

22### Hacking

default.nix+1−1

@@ -11,7 +11,7 @@

11}:

12mkDerivation {

13 pname = "reflex";

14− version = "0.6.1";

14+ version = "0.6.2.1";

15 src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

16 libraryHaskellDepends = [

17 base bifunctors containers dependent-map dependent-sum

reflex.cabal+9−7

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

1Name: reflex

2−Version: 0.6.1

2+Version: 0.6.2.1

3Synopsis: Higher-order Functional Reactive Programming

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

5License: BSD3

@@ -44,13 +44,15 @@ library

44 base >= 4.9 && < 4.13,

45 bifunctors >= 5.2 && < 5.6,

46 comonad,

47+ constraints-extras >= 0.2,

47 containers >= 0.5 && < 0.7,

48 containers >= 0.5 && < 0.7,

48 data-default >= 0.5 && < 0.8,

49 data-default >= 0.5 && < 0.8,

49− dependent-map >= 0.2.4 && < 0.3,

50+ dependent-map >= 0.3 && < 0.4,

50 exception-transformers == 0.4.*,

51 exception-transformers == 0.4.*,

52+ profunctors,

51 lens >= 4.7 && < 5,

53 lens >= 4.7 && < 5,

52 monad-control >= 1.0.1 && < 1.1,

54 monad-control >= 1.0.1 && < 1.1,

53− monoidal-containers == 0.4.*,

55+ monoidal-containers >= 0.4 && < 0.6,

54 mtl >= 2.1 && < 2.3,

56 mtl >= 2.1 && < 2.3,

55 prim-uniq >= 0.1.0.1 && < 0.2,

57 prim-uniq >= 0.1.0.1 && < 0.2,

56 primitive >= 0.5 && < 0.7,

58 primitive >= 0.5 && < 0.7,

@@ -61,7 +63,7 @@ library

61 semigroups >= 0.16 && < 0.19,

63 semigroups >= 0.16 && < 0.19,

62 stm >= 2.4 && < 2.6,

64 stm >= 2.4 && < 2.6,

63 syb >= 0.5 && < 0.8,

65 syb >= 0.5 && < 0.8,

64− these >= 0.4 && < 0.7.7,

66+ these >= 0.4 && < 0.9,

65 time >= 1.4 && < 1.9,

67 time >= 1.4 && < 1.9,

66 transformers >= 0.2,

68 transformers >= 0.2,

67 transformers-compat >= 0.3,

69 transformers-compat >= 0.3,

@@ -133,8 +135,8 @@ library

133 if flag(use-template-haskell)

135 if flag(use-template-haskell)

134 cpp-options: -DUSE_TEMPLATE_HASKELL

136 cpp-options: -DUSE_TEMPLATE_HASKELL

135 build-depends:

137 build-depends:

136− dependent-sum >= 0.3 && < 0.5,

138+ dependent-sum >= 0.6 && < 0.7,

137− haskell-src-exts >= 1.16 && < 1.21,

139+ haskell-src-exts >= 1.16 && < 1.22,

138 haskell-src-meta >= 0.6 && < 0.9,

140 haskell-src-meta >= 0.6 && < 0.9,

139 template-haskell >= 2.9 && < 2.15

141 template-haskell >= 2.9 && < 2.15

140 exposed-modules:

142 exposed-modules:

@@ -142,7 +144,7 @@ library

142 other-extensions: TemplateHaskell

144 other-extensions: TemplateHaskell

143 else

145 else

144 build-depends:

146 build-depends:

145− dependent-sum == 0.4.*

147+ dependent-sum == 0.6.*

146

148

147 if flag(fast-weak) && impl(ghcjs)

149 if flag(fast-weak) && impl(ghcjs)

148 cpp-options: -DGHCJS_FAST_WEAK

150 cpp-options: -DGHCJS_FAST_WEAK

src/Data/AppendMap.hs+14−4

@@ -7,10 +7,14 @@

7{-# LANGUAGE ScopedTypeVariables #-}

8{-# LANGUAGE TypeFamilies #-}

9{-# OPTIONS_GHC -fno-warn-orphans #-}

10−-- | 'Data.Map' with a better 'Monoid' instance

10+-- |

11−--

11+-- Module:

12+-- Data.AppendMap

13+-- Description:

14+-- Instances and convenience functions for 'Data.Map.Monoidal'. We use

15+-- monoidal-containers to take advantage of its better monoid instance.

12−-- 'Data.Map' has @mappend = union@, which is left-biased. AppendMap has

16+-- 'Data.Map' has @mappend = union@, which is left-biased. 'MonoidalMap'

13−-- @mappend = unionWith mappend@ instead.

17+-- has @mappend = unionWith mappend@ instead.

14module Data.AppendMap

18module Data.AppendMap

15 ( module Data.AppendMap

19 ( module Data.AppendMap

16 , module Data.Map.Monoidal

20 , module Data.Map.Monoidal

@@ -30,12 +34,15 @@ import qualified Data.Witherable as W

30import Data.Map.Monoidal

34import Data.Map.Monoidal

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

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

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

33type AppendMap = MonoidalMap

38type AppendMap = MonoidalMap

35{-# DEPRECATED _unAppendMap "Use 'getMonoidalMap' instead" #-}

40{-# DEPRECATED _unAppendMap "Use 'getMonoidalMap' instead" #-}

41+-- | A synonym for 'getMonoidalMap'

36_unAppendMap :: MonoidalMap k v -> Map k v

42_unAppendMap :: MonoidalMap k v -> Map k v

37_unAppendMap = getMonoidalMap

43_unAppendMap = getMonoidalMap

45+-- | Pattern synonym for 'MonoidalMap'

39pattern AppendMap :: Map k v -> MonoidalMap k v

46pattern AppendMap :: Map k v -> MonoidalMap k v

40pattern AppendMap m = MonoidalMap m

47pattern AppendMap m = MonoidalMap m

@@ -50,6 +57,7 @@ nonEmptyDelete k vs =

50 then Nothing

57 then Nothing

51 else Just deleted

58 else Just deleted

60+-- | Like 'mapMaybe' but indicates whether the resulting container is empty

53mapMaybeNoNull :: (a -> Maybe b)

61mapMaybeNoNull :: (a -> Maybe b)

54 -> MonoidalMap token a

62 -> MonoidalMap token a

55 -> Maybe (MonoidalMap token b)

63 -> Maybe (MonoidalMap token b)

@@ -60,9 +68,11 @@ mapMaybeNoNull f as =

60 else Just bs

68 else Just bs

62-- TODO: Move instances to `Reflex.Patch`

70-- TODO: Move instances to `Reflex.Patch`

71+-- | Displays a 'MonoidalMap' as a tree. See 'Data.Map.Lazy.showTree' for details.

63showTree :: forall k a. (Show k, Show a) => MonoidalMap k a -> String

72showTree :: forall k a. (Show k, Show a) => MonoidalMap k a -> String

64showTree = coerce (Map.showTree :: Map k a -> String)

73showTree = coerce (Map.showTree :: Map k a -> String)

75+-- | Displays a 'MonoidalMap' as a tree, using the supplied function to convert nodes to string.

66showTreeWith :: forall k a. (k -> a -> String) -> Bool -> Bool -> MonoidalMap k a -> String

76showTreeWith :: forall k a. (k -> a -> String) -> Bool -> Bool -> MonoidalMap k a -> String

67showTreeWith = coerce (Map.showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String)

77showTreeWith = coerce (Map.showTreeWith :: (k -> a -> String) -> Bool -> Bool -> Map k a -> String)

src/Data/FastMutableIntMap.hs+17

@@ -1,4 +1,9 @@

1{-# LANGUAGE TypeFamilies #-}

2+-- |

3+-- Module:

4+-- Data.FastMutableIntMap

5+-- Description:

6+-- A mutable version of 'IntMap'

2module Data.FastMutableIntMap

7module Data.FastMutableIntMap

3 ( FastMutableIntMap

8 ( FastMutableIntMap

4 , new

9 , new

@@ -32,33 +37,43 @@ import Data.IORef

32import Reflex.Patch.Class

37import Reflex.Patch.Class

33import Reflex.Patch.IntMap

38import Reflex.Patch.IntMap

40+-- | A 'FastMutableIntMap' holds a map of values of type @a@ and allows low-overhead modifications via IO.

41+-- Operations on 'FastMutableIntMap' run in IO.

35newtype FastMutableIntMap a = FastMutableIntMap (IORef (IntMap a))

42newtype FastMutableIntMap a = FastMutableIntMap (IORef (IntMap a))

44+-- | Create a new 'FastMutableIntMap' out of an 'IntMap'

37new :: IntMap a -> IO (FastMutableIntMap a)

45new :: IntMap a -> IO (FastMutableIntMap a)

38new m = FastMutableIntMap <$> newIORef m

46new m = FastMutableIntMap <$> newIORef m

48+-- | Create a new empty 'FastMutableIntMap'

40newEmpty :: IO (FastMutableIntMap a)

49newEmpty :: IO (FastMutableIntMap a)

41newEmpty = FastMutableIntMap <$> newIORef IntMap.empty

50newEmpty = FastMutableIntMap <$> newIORef IntMap.empty

52+-- | Insert an element into a 'FastMutableIntMap' at the given key

43insert :: FastMutableIntMap a -> Int -> a -> IO ()

53insert :: FastMutableIntMap a -> Int -> a -> IO ()

44insert (FastMutableIntMap r) k v = modifyIORef' r $ IntMap.insert k v

54insert (FastMutableIntMap r) k v = modifyIORef' r $ IntMap.insert k v

56+-- | Attempt to lookup an element by key in a 'FastMutableIntMap'

46lookup :: FastMutableIntMap a -> Int -> IO (Maybe a)

57lookup :: FastMutableIntMap a -> Int -> IO (Maybe a)

47lookup (FastMutableIntMap r) k = IntMap.lookup k <$> readIORef r

58lookup (FastMutableIntMap r) k = IntMap.lookup k <$> readIORef r

60+-- | Runs the provided action over the intersection of a 'FastMutableIntMap' and an 'IntMap'

49forIntersectionWithImmutable_ :: MonadIO m => FastMutableIntMap a -> IntMap b -> (a -> b -> m ()) -> m ()

61forIntersectionWithImmutable_ :: MonadIO m => FastMutableIntMap a -> IntMap b -> (a -> b -> m ()) -> m ()

50forIntersectionWithImmutable_ (FastMutableIntMap r) b f = do

62forIntersectionWithImmutable_ (FastMutableIntMap r) b f = do

51 a <- liftIO $ readIORef r

63 a <- liftIO $ readIORef r

52 traverse_ (uncurry f) $ IntMap.intersectionWith (,) a b

64 traverse_ (uncurry f) $ IntMap.intersectionWith (,) a b

66+-- | Runs the provided action over the values of a 'FastMutableIntMap'

54for_ :: MonadIO m => FastMutableIntMap a -> (a -> m ()) -> m ()

67for_ :: MonadIO m => FastMutableIntMap a -> (a -> m ()) -> m ()

55for_ (FastMutableIntMap r) f = do

68for_ (FastMutableIntMap r) f = do

56 a <- liftIO $ readIORef r

69 a <- liftIO $ readIORef r

57 traverse_ f a

70 traverse_ f a

72+-- | Checks whether a 'FastMutableIntMap' is empty

59isEmpty :: FastMutableIntMap a -> IO Bool

73isEmpty :: FastMutableIntMap a -> IO Bool

60isEmpty (FastMutableIntMap r) = IntMap.null <$> readIORef r

74isEmpty (FastMutableIntMap r) = IntMap.null <$> readIORef r

76+-- | Retrieves the size of a 'FastMutableIntMap'

62size :: FastMutableIntMap a -> IO Int

77size :: FastMutableIntMap a -> IO Int

63size (FastMutableIntMap r) = IntMap.size <$> readIORef r

78size (FastMutableIntMap r) = IntMap.size <$> readIORef r

@@ -69,6 +84,8 @@ getFrozenAndClear (FastMutableIntMap r) = do

69 writeIORef r IntMap.empty

84 writeIORef r IntMap.empty

70 return result

85 return result

87+-- | Updates the value of a 'FastMutableIntMap' with the given patch (see 'Reflex.Patch.IntMap'),

88+-- and returns an 'IntMap' with the modified keys and values.

72applyPatch :: FastMutableIntMap a -> PatchIntMap a -> IO (IntMap a)

89applyPatch :: FastMutableIntMap a -> PatchIntMap a -> IO (IntMap a)

73applyPatch (FastMutableIntMap r) p@(PatchIntMap m) = do

90applyPatch (FastMutableIntMap r) p@(PatchIntMap m) = do

74 v <- readIORef r

91 v <- readIORef r

src/Data/FastWeakBag.hs+1−1

@@ -50,7 +50,7 @@ newtype FastWeakBag a = FastWeakBag JSVal

50#else

51data FastWeakBag a = FastWeakBag

52 { _weakBag_nextId :: {-# UNPACK #-} !(IORef Int) --TODO: what if this wraps around?

53− , _weakBag_children :: {-# UNPACK #-} !(IORef (IntMap (Weak a)))

53+ , _weakBag_children :: {-# UNPACK #-} !(IORef (IntMap (Weak a))) -- ^ Map of items contained by the 'FastWeakBag'

54 }

55#endif

src/Data/Functor/Misc.hs+2−11

@@ -52,8 +52,7 @@ import Data.IntMap (IntMap)

52import qualified Data.IntMap as IntMap

53import Data.Map (Map)

54import qualified Data.Map as Map

55−import Data.Some (Some)

55+import Data.Some (Some(Some))

56−import qualified Data.Some as Some

57import Data.These

56import Data.These

58import Data.Typeable hiding (Refl)

57import Data.Typeable hiding (Refl)

@@ -79,9 +78,6 @@ deriving instance Read k => Read (Const2 k v v)

79instance Show k => GShow (Const2 k v) where

78instance Show k => GShow (Const2 k v) where

80 gshowsPrec n x@(Const2 _) = showsPrec n x

79 gshowsPrec n x@(Const2 _) = showsPrec n x

82−instance (Show k, Show (f v)) => ShowTag (Const2 k v) f where

83− showTaggedPrec (Const2 _) = showsPrec

84−

85instance Eq k => GEq (Const2 k v) where

81instance Eq k => GEq (Const2 k v) where

86 geq (Const2 a) (Const2 b) =

82 geq (Const2 a) (Const2 b) =

87 if a == b

83 if a == b

@@ -124,7 +120,7 @@ intMapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=

124-- | Convert a 'DMap' to a regular 'Map' by forgetting the types associated with

120-- | Convert a 'DMap' to a regular 'Map' by forgetting the types associated with

125-- the keys, using a function to remove the wrapping 'Functor'

121-- the keys, using a function to remove the wrapping 'Functor'

126weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'

122weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'

127−weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some.This k, f v)) . DMap.toAscList

123+weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some k, f v)) . DMap.toAscList

128

124

129--------------------------------------------------------------------------------

125--------------------------------------------------------------------------------

130-- WrapArg

126-- WrapArg

@@ -214,11 +210,6 @@ instance GShow (EitherTag l r) where

214 LeftTag -> showString "LeftTag"

210 LeftTag -> showString "LeftTag"

215 RightTag -> showString "RightTag"

211 RightTag -> showString "RightTag"

216

212

217−instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where

218− showTaggedPrec t n (Identity a) = case t of

219− LeftTag -> showsPrec n a

220− RightTag -> showsPrec n a

221−

222-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.

213-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.

223eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity

214eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity

224eitherToDSum = \case

215eitherToDSum = \case

src/Reflex/Adjustable/Class.hs+30−3

@@ -11,6 +11,13 @@

11#ifdef USE_REFLEX_OPTIMIZER

12{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

13#endif

14+-- |

15+-- Module:

16+-- Reflex.Adjustable.Class

17+-- Description:

18+-- A class for actions that can be "adjusted" over time based on some 'Event'

19+-- such that, when observed after the firing of any such 'Event', the result

20+-- is as though the action was originally run with the 'Event's value.

14module Reflex.Adjustable.Class

21module Reflex.Adjustable.Class

15 (

22 (

16 -- * The Adjustable typeclass

23 -- * The Adjustable typeclass

@@ -94,13 +101,32 @@ instance Adjustable t m => Adjustable t (ReaderT r m) where

94 r <- ask

101 r <- ask

95 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'

102 lift $ traverseDMapWithKeyWithAdjustWithMove (\k v -> runReaderT (f k v) r) dm0 dm'

103

104+-- | Traverse a 'DMap' of 'Adjustable' actions, running each of them. The provided 'Event' of patches

105+-- to the 'DMap' can add, remove, or update values.

106+sequenceDMapWithAdjust

107+ :: (GCompare k, Adjustable t m)

108+ => DMap k m

109+ -> Event t (PatchDMap k m)

97−sequenceDMapWithAdjust :: (GCompare k, Adjustable t m) => DMap k m -> Event t (PatchDMap k m) -> m (DMap k Identity, Event t (PatchDMap k Identity))

110+ -> m (DMap k Identity, Event t (PatchDMap k Identity))

98sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity

111sequenceDMapWithAdjust = traverseDMapWithKeyWithAdjust $ \_ -> fmap Identity

112

113+-- | Traverses a 'DMap' of 'Adjustable' actions, running each of them. The provided 'Event' of patches

114+-- to the 'DMap' can add, remove, update, move, or swap values.

115+sequenceDMapWithAdjustWithMove

116+ :: (GCompare k, Adjustable t m)

117+ => DMap k m

118+ -> Event t (PatchDMapWithMove k m)

100−sequenceDMapWithAdjustWithMove :: (GCompare k, Adjustable t m) => DMap k m -> Event t (PatchDMapWithMove k m) -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))

119+ -> m (DMap k Identity, Event t (PatchDMapWithMove k Identity))

101sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity

120sequenceDMapWithAdjustWithMove = traverseDMapWithKeyWithAdjustWithMove $ \_ -> fmap Identity

102

121

122+-- | Traverses a 'Map', running the provided 'Adjustable' action. The provided 'Event' of patches to the 'Map'

123+-- can add, remove, update, move, or swap values.

124+mapMapWithAdjustWithMove

125+ :: forall t m k v v'. (Adjustable t m, Ord k)

126+ => (k -> v -> m v')

127+ -> Map k v

128+ -> Event t (PatchMapWithMove k v)

103−mapMapWithAdjustWithMove :: forall t m k v v'. (Adjustable t m, Ord k) => (k -> v -> m v') -> Map k v -> Event t (PatchMapWithMove k v) -> m (Map k v', Event t (PatchMapWithMove k v'))

129+ -> m (Map k v', Event t (PatchMapWithMove k v'))

104mapMapWithAdjustWithMove f m0 m' = do

130mapMapWithAdjustWithMove f m0 m' = do

105 (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')

131 (out0 :: DMap (Const2 k v) (Constant v'), out') <- traverseDMapWithKeyWithAdjustWithMove (\(Const2 k) (Identity v) -> Constant <$> f k v) (mapToDMap m0) (const2PatchDMapWithMoveWith Identity <$> m')

106 return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')

132 return (dmapToMapWith (\(Constant v') -> v') out0, patchDMapWithMoveToPatchMapWithMoveWith (\(Constant v') -> v') <$> out')

@@ -110,4 +136,5 @@ mapMapWithAdjustWithMove f m0 m' = do

110--------------------------------------------------------------------------------

136--------------------------------------------------------------------------------

111

137

112{-# DEPRECATED MonadAdjust "Use Adjustable instead" #-}

138{-# DEPRECATED MonadAdjust "Use Adjustable instead" #-}

139+-- | Synonym for 'Adjustable'

113type MonadAdjust = Adjustable

140type MonadAdjust = Adjustable

src/Reflex/Class.hs+184−26

@@ -17,6 +17,7 @@

17{-# LANGUAGE TypeFamilies #-}

18{-# LANGUAGE TypeOperators #-}

19{-# LANGUAGE UndecidableInstances #-}

20+{-# LANGUAGE Trustworthy #-}

20#ifdef USE_REFLEX_OPTIMIZER

21#ifdef USE_REFLEX_OPTIMIZER

21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

22{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

22#endif

23#endif

@@ -40,12 +41,16 @@ module Reflex.Class

40 , MonadHold (..)

41 , MonadHold (..)

41 -- ** 'fan' related types

42 -- ** 'fan' related types

42 , EventSelector (..)

43 , EventSelector (..)

44+ , EventSelectorG (..)

43 , EventSelectorInt (..)

45 , EventSelectorInt (..)

44 -- * Convenience functions

46 -- * Convenience functions

45 , constDyn

47 , constDyn

46 , pushAlways

48 , pushAlways

47 -- ** Combining 'Event's

49 -- ** Combining 'Event's

48 , leftmost

50 , leftmost

51+ , merge

52+ , mergeIncremental

53+ , mergeIncrementalWithMove

49 , mergeMap

54 , mergeMap

50 , mergeIntMap

55 , mergeIntMap

51 , mergeMapIncremental

56 , mergeMapIncremental

@@ -60,6 +65,7 @@ module Reflex.Class

60 , alignEventWithMaybe

65 , alignEventWithMaybe

61 -- ** Breaking up 'Event's

66 -- ** Breaking up 'Event's

62 , splitE

67 , splitE

68+ , fan

63 , fanEither

69 , fanEither

64 , fanThese

70 , fanThese

65 , fanMap

71 , fanMap

@@ -84,6 +90,7 @@ module Reflex.Class

84 , gate

90 , gate

85 -- ** Combining 'Dynamic's

91 -- ** Combining 'Dynamic's

86 , distributeDMapOverDynPure

92 , distributeDMapOverDynPure

93+ , distributeDMapOverDynPureG

87 , distributeListOverDyn

94 , distributeListOverDyn

88 , distributeListOverDynWith

95 , distributeListOverDynWith

89 , zipDyn

96 , zipDyn

@@ -193,8 +200,7 @@ import qualified Data.IntMap.Strict as IntMap

193import Data.List.NonEmpty (NonEmpty (..))

200import Data.List.NonEmpty (NonEmpty (..))

194import Data.Map (Map)

201import Data.Map (Map)

195import Data.Semigroup (Semigroup, sconcat, stimes, (<>))

202import Data.Semigroup (Semigroup, sconcat, stimes, (<>))

196−import Data.Some (Some)

203+import Data.Some (Some(Some))

197−import qualified Data.Some as Some

198import Data.String

204import Data.String

199import Data.These

205import Data.These

200import Data.Type.Coercion

206import Data.Type.Coercion

@@ -256,11 +262,16 @@ class ( MonadHold t (PushM t)

256 -- | Merge a collection of events; the resulting 'Event' will only occur if at

262 -- | Merge a collection of events; the resulting 'Event' will only occur if at

257 -- least one input event is occurring, and will contain all of the input keys

263 -- least one input event is occurring, and will contain all of the input keys

258 -- that are occurring simultaneously

264 -- that are occurring simultaneously

265+

259− merge :: GCompare k => DMap k (Event t) -> Event t (DMap k Identity) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty

266+ --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty

267+ mergeG :: GCompare k => (forall a. q a -> Event t (v a))

268+ -> DMap k q -> Event t (DMap k v)

269+

260− -- | Efficiently fan-out an event to many destinations. This function should

270+ -- | Efficiently fan-out an event to many destinations. You should save the

261− -- be partially applied, and then the result applied repeatedly to create

271+ -- result in a @let@-binding, and then repeatedly 'selectG' on the result to

262− -- child events

272+ -- create child events

263− fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it

273+ fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v

274+

264 -- | Create an 'Event' that will occur whenever the currently-selected input

275 -- | Create an 'Event' that will occur whenever the currently-selected input

265 -- 'Event' occurs

276 -- 'Event' occurs

266 switch :: Behavior t (Event t a) -> Event t a

277 switch :: Behavior t (Event t a) -> Event t a

@@ -278,9 +289,14 @@ class ( MonadHold t (PushM t)

278 -- that value.

289 -- that value.

279 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p

290 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p

280 -- | Create a merge whose parents can change over time

291 -- | Create a merge whose parents can change over time

292+ mergeIncrementalG :: GCompare k

293+ => (forall a. q a -> Event t (v a))

281− mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)

294+ -> Incremental t (PatchDMap k q)

295+ -> Event t (DMap k v)

282 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental

296 -- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental

297+ mergeIncrementalWithMoveG :: GCompare k

298+ => (forall a. q a -> Event t (v a))

283− mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)

299+ -> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)

284 -- | Extract the 'Behavior' component of an 'Incremental'

300 -- | Extract the 'Behavior' component of an 'Incremental'

285 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)

301 currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)

286 -- | Extract the 'Event' component of an 'Incremental'

302 -- | Extract the 'Event' component of an 'Incremental'

@@ -299,7 +315,21 @@ class ( MonadHold t (PushM t)

299 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)

315 mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)

300 fanInt :: Event t (IntMap a) -> EventSelectorInt t a

316 fanInt :: Event t (IntMap a) -> EventSelectorInt t a

301

317

318+-- | Efficiently fan-out an event to many destinations. You should save the

319+-- result in a @let@-binding, and then repeatedly 'select' on the result to

320+-- create child events

321+fan :: forall t k. (Reflex t, GCompare k)

322+ => Event t (DMap k Identity) -> EventSelector t k

323+ --TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it

324+fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)

325+ where

326+ fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a

327+ fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of

328+ Coercion -> coerce

329+

302--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on

330--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on

331+-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple

332+-- keys simultaneously.

303mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)

333mergeInt :: Reflex t => IntMap (Event t a) -> Event t (IntMap a)

304mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never

334mergeInt m = mergeIntIncremental $ unsafeBuildIncremental (return m) never

305

335

@@ -368,26 +398,91 @@ class MonadSample t m => MonadHold t m where

368 -- the supplied 'Event'.

398 -- the supplied 'Event'.

369 headE :: Event t a -> m (Event t a)

399 headE :: Event t a -> m (Event t a)

370

400

401+-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',

402+-- using the combining function to produce a patch.

403+accumIncremental

371−accumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> p) -> PatchTarget p -> Event t b -> m (Incremental t p)

404+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

405+ => (PatchTarget p -> b -> p)

406+ -> PatchTarget p

407+ -> Event t b

408+ -> m (Incremental t p)

372accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o

409accumIncremental f = accumMaybeIncremental $ \v o -> Just $ f v o

410+

411+-- | Similar to 'accumIncremental' but the combining function runs in 'PushM'

412+accumMIncremental

373−accumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t p) -> PatchTarget p -> Event t b -> m (Incremental t p)

413+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

414+ => (PatchTarget p -> b -> PushM t p)

415+ -> PatchTarget p

416+ -> Event t b

417+ -> m (Incremental t p)

374accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o

418accumMIncremental f = accumMaybeMIncremental $ \v o -> Just <$> f v o

419+

420+-- | Similar to 'accumIncremental' but allows filtering of updates (by dropping updates when the

421+-- combining function produces @Nothing@)

422+accumMaybeIncremental

375−accumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> Maybe p) -> PatchTarget p -> Event t b -> m (Incremental t p)

423+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

424+ => (PatchTarget p -> b -> Maybe p)

425+ -> PatchTarget p

426+ -> Event t b

427+ -> m (Incremental t p)

376accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o

428accumMaybeIncremental f = accumMaybeMIncremental $ \v o -> return $ f v o

429+

430+-- | Similar to 'accumMaybeMIncremental' but the combining function runs in 'PushM'

431+accumMaybeMIncremental

377−accumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p)) -> PatchTarget p -> Event t b -> m (Incremental t p)

432+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

433+ => (PatchTarget p -> b -> PushM t (Maybe p))

434+ -> PatchTarget p

435+ -> Event t b

436+ -> m (Incremental t p)

378accumMaybeMIncremental f z e = do

437accumMaybeMIncremental f z e = do

379 rec let e' = flip push e $ \o -> do

438 rec let e' = flip push e $ \o -> do

380 v <- sample $ currentIncremental d'

439 v <- sample $ currentIncremental d'

381 f v o

440 f v o

382 d' <- holdIncremental z e'

441 d' <- holdIncremental z e'

383 return d'

442 return d'

443+

444+-- | Accumulate an 'Incremental' by folding occurrences of an 'Event'

445+-- with a function that both accumulates and produces a value to fire

446+-- as an 'Event'. Returns both the accumulated value and the constructed

447+-- 'Event'.

448+mapAccumIncremental

384−mapAccumIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)

449+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

450+ => (PatchTarget p -> b -> (p, c))

451+ -> PatchTarget p

452+ -> Event t b

453+ -> m (Incremental t p, Event t c)

385mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o

454mapAccumIncremental f = mapAccumMaybeIncremental $ \v o -> bimap Just Just $ f v o

455+

456+-- | Like 'mapAccumIncremental' but the combining function runs in 'PushM'

457+mapAccumMIncremental

386−mapAccumMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (p, c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)

458+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

459+ => (PatchTarget p -> b -> PushM t (p, c))

460+ -> PatchTarget p

461+ -> Event t b

462+ -> m (Incremental t p, Event t c)

387mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o

463mapAccumMIncremental f = mapAccumMaybeMIncremental $ \v o -> bimap Just Just <$> f v o

464+

465+-- | Accumulate an 'Incremental' by folding occurrences of an 'Event' with

466+-- a function that both optionally accumulates and optionally produces

467+-- a value to fire as a separate output 'Event'.

468+-- Note that because 'Nothing's are discarded in both cases, the output

469+-- 'Event' may fire even though the output 'Incremental' has not changed, and

470+-- the output 'Incremental' may update even when the output 'Event' is not firing.

471+mapAccumMaybeIncremental

388−mapAccumMaybeIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)

472+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

473+ => (PatchTarget p -> b -> (Maybe p, Maybe c))

474+ -> PatchTarget p

475+ -> Event t b

476+ -> m (Incremental t p, Event t c)

389mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o

477mapAccumMaybeIncremental f = mapAccumMaybeMIncremental $ \v o -> return $ f v o

478+

479+-- | Like 'mapAccumMaybeIncremental' but the combining function is a 'PushM' action

480+mapAccumMaybeMIncremental

390−mapAccumMaybeMIncremental :: (Reflex t, Patch p, MonadHold t m, MonadFix m) => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c)) -> PatchTarget p -> Event t b -> m (Incremental t p, Event t c)

481+ :: (Reflex t, Patch p, MonadHold t m, MonadFix m)

482+ => (PatchTarget p -> b -> PushM t (Maybe p, Maybe c))

483+ -> PatchTarget p

484+ -> Event t b

485+ -> m (Incremental t p, Event t c)

391mapAccumMaybeMIncremental f z e = do

486mapAccumMaybeMIncremental f z e = do

392 rec let e' = flip push e $ \o -> do

487 rec let e' = flip push e $ \o -> do

393 v <- sample $ currentIncremental d'

488 v <- sample $ currentIncremental d'

@@ -398,6 +493,7 @@ mapAccumMaybeMIncremental f z e = do

398 d' <- holdIncremental z $ mapMaybe fst e'

493 d' <- holdIncremental z $ mapMaybe fst e'

399 return (d', mapMaybe snd e')

494 return (d', mapMaybe snd e')

400

495

496+-- | A somewhat slow implementation of 'headE'

401slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

497slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

402slowHeadE e = do

498slowHeadE e = do

403 rec be <- hold e $ fmapCheap (const never) e'

499 rec be <- hold e $ fmapCheap (const never) e'

@@ -418,6 +514,19 @@ newtype EventSelector t k = EventSelector

418 select :: forall a. k a -> Event t a

514 select :: forall a. k a -> Event t a

419 }

515 }

420

516

517+newtype EventSelectorG t k v = EventSelectorG

518+ { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is

519+ -- determined by the type of the key, so this can be used to fan-out

520+ -- 'Event's whose sub-'Event's have different types.

521+ --

522+ -- Using 'EventSelector's and the 'fan' primitive is far more efficient than

523+ -- (but equivalent to) using 'mapMaybe' to select only the relevant

524+ -- occurrences of an 'Event'.

525+ selectG :: forall a. k a -> Event t (v a)

526+ }

527+

528+-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually

529+-- filtering by key.

421newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }

530newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }

422

531

423--------------------------------------------------------------------------------

532--------------------------------------------------------------------------------

@@ -801,7 +910,12 @@ mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)

801mergeList [] = never

910mergeList [] = never

802mergeList es = mergeWithFoldCheap' id es

911mergeList es = mergeWithFoldCheap' id es

803

912

913+unsafeMapIncremental

914+ :: (Reflex t, Patch p, Patch p')

804−unsafeMapIncremental :: (Reflex t, Patch p, Patch p') => (PatchTarget p -> PatchTarget p') -> (p -> p') -> Incremental t p -> Incremental t p'

915+ => (PatchTarget p -> PatchTarget p')

916+ -> (p -> p')

917+ -> Incremental t p

918+ -> Incremental t p'

805unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a

919unsafeMapIncremental f g a = unsafeBuildIncremental (fmap f $ sample $ currentIncremental a) $ g <$> updatedIncremental a

806

920

807-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that

921-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that

@@ -918,6 +1032,9 @@ coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $

918 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }

1032 ni { PatchMapWithMove._nodeInfo_from = PatchMapWithMove.From_Delete }

919 ]

1033 ]

920

1034

1035+-- | Given a 'PatchTarget' of events (e.g., a 'Map' with 'Event' values) and an event of 'Patch'es

1036+-- (e.g., a 'PatchMap' with 'Event' values), produce an 'Event' of the 'PatchTarget' type that

1037+-- fires with the patched value.

921switchHoldPromptOnlyIncremental

1038switchHoldPromptOnlyIncremental

922 :: forall t m p pt w

1039 :: forall t m p pt w

923 . ( Reflex t

1040 . ( Reflex t

@@ -942,8 +1059,12 @@ switchHoldPromptOnlyIncremental mergePatchIncremental coincidencePatch e0 e' = d

942

1059

943instance Reflex t => Align (Event t) where

1060instance Reflex t => Align (Event t) where

944 nil = never

1061 nil = never

1062+#if MIN_VERSION_these(0, 8, 0)

1063+instance Reflex t => Semialign (Event t) where

1064+#endif

945 align = alignEventWithMaybe Just

1065 align = alignEventWithMaybe Just

946

1066

1067+

947-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and

1068-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and

948-- the 'Behavior' is true at the time of occurrence.

1069-- the 'Behavior' is true at the time of occurrence.

949gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a

1070gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a

@@ -998,12 +1119,21 @@ instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where

998-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same

1119-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same

999-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.

1120-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.

1000distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)

1121distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)

1001−distributeDMapOverDynPure dm = case DMap.toList dm of

1122+distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic

1123+

1124+-- | This function converts a 'DMap' whose elements are 'Dynamic's into a

1125+-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same

1126+-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.

1127+distributeDMapOverDynPureG

1128+ :: forall t k q v. (Reflex t, GCompare k)

1129+ => (forall a. q a -> Dynamic t (v a))

1130+ -> DMap k q -> Dynamic t (DMap k v)

1131+distributeDMapOverDynPureG nt dm = case DMap.toList dm of

1002 [] -> constDyn DMap.empty

1132 [] -> constDyn DMap.empty

1003− [k :=> v] -> fmap (DMap.singleton k . Identity) v

1133+ [k :=> v] -> DMap.singleton k <$> nt v

1004 _ ->

1134 _ ->

1005− let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm

1135+ let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm

1006− edmPre = merge $ DMap.map updated dm

1136+ edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm

1007 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do

1137 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do

1008 olds <- sample $ current result

1138 olds <- sample $ current result

1009 return $ DMap.unionWithKey (\_ _ new -> new) olds news

1139 return $ DMap.unionWithKey (\_ _ new -> new) olds news

@@ -1015,7 +1145,16 @@ distributeListOverDyn = distributeListOverDynWith id

1015

1145

1016-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's

1146-- | Create a new 'Dynamic' by applying a combining function to a list of 'Dynamic's

1017distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b

1147distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b

1018−distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]

1148+distributeListOverDynWith f =

1149+ fmap (f . map fromDSum . DMap.toAscList) .

1150+ distributeDMapOverDynPure .

1151+ DMap.fromDistinctAscList .

1152+ zipWith toDSum [0..]

1153+ where

1154+ toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)

1155+ toDSum k v = Const2 k :=> v

1156+ fromDSum :: DSum (Const2 Int a) Identity -> a

1157+ fromDSum (Const2 _ :=> Identity v) = v

1019

1158

1020-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs

1159-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs

1021-- unless the second supplied 'Event' occurs simultaneously.

1160-- unless the second supplied 'Event' occurs simultaneously.

@@ -1064,9 +1203,9 @@ factorEvent

1064 -> Event t (DSum k v)

1203 -> Event t (DSum k v)

1065 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))

1204 -> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))

1066factorEvent k0 kv' = do

1205factorEvent k0 kv' = do

1067− key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'

1206+ key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'

1068 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case

1207 let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case

1069− Some.This oldKey -> case newKey `geq` oldKey of

1208+ Some oldKey -> case newKey `geq` oldKey of

1070 Just Refl -> return Nothing

1209 Just Refl -> return Nothing

1071 Nothing -> do

1210 Nothing -> do

1072 newInner <- filterEventKey newKey kv'

1211 newInner <- filterEventKey newKey kv'

@@ -1276,7 +1415,7 @@ mapAccumMaybeB

1276 -> m (Behavior t a, Event t c)

1415 -> m (Behavior t a, Event t c)

1277mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o

1416mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o

1278

1417

1279−-- | LIke 'mapAccumMaybeB' except that the combining function is a 'PushM' action.

1418+-- | Like 'mapAccumMaybeB' except that the combining function is a 'PushM' action.

1280{-# INLINE mapAccumMaybeMB #-}

1419{-# INLINE mapAccumMaybeMB #-}

1281mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

1420mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

1282mapAccumMaybeMB f z e = do

1421mapAccumMaybeMB f z e = do

@@ -1467,6 +1606,23 @@ fmapCheap f = pushCheap $ return . Just . f

1467tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b

1606tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b

1468tagCheap b = pushAlwaysCheap $ \_ -> sample b

1607tagCheap b = pushAlwaysCheap $ \_ -> sample b

1469

1608

1609+-- | Merge a collection of events; the resulting 'Event' will only occur if at

1610+-- least one input event is occurring, and will contain all of the input keys

1611+-- that are occurring simultaneously

1612+merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)

1613+merge = mergeG coerceEvent

1614+{-# INLINE merge #-}

1615+

1616+-- | Create a merge whose parents can change over time

1617+mergeIncremental :: (Reflex t, GCompare k)

1618+ => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)

1619+mergeIncremental = mergeIncrementalG coerceEvent

1620+

1621+-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental

1622+mergeIncrementalWithMove :: (Reflex t, GCompare k)

1623+ => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)

1624+mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent

1625+

1470-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.

1626-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.

1471{-# INLINE mergeWithCheap #-}

1627{-# INLINE mergeWithCheap #-}

1472mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a

1628mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a

@@ -1491,8 +1647,10 @@ mergeWithFoldCheap' f es =

1491--------------------------------------------------------------------------------

1647--------------------------------------------------------------------------------

1492

1648

1493{-# DEPRECATED switchPromptly "Use 'switchHoldPromptly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}

1649{-# DEPRECATED switchPromptly "Use 'switchHoldPromptly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}

1650+-- | See 'switchHoldPromptly'

1494switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)

1651switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)

1495switchPromptly = switchHoldPromptly

1652switchPromptly = switchHoldPromptly

1496{-# DEPRECATED switchPromptOnly "Use 'switchHoldPromptOnly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}

1653{-# DEPRECATED switchPromptOnly "Use 'switchHoldPromptOnly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}

1654+-- | See 'switchHoldPromptOnly'

1497switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)

1655switchPromptOnly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)

1498switchPromptOnly = switchHoldPromptOnly

1656switchPromptOnly = switchHoldPromptOnly

src/Reflex/Dynamic.hs+8−10

@@ -203,17 +203,9 @@ distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithF

203

204-- | Convert a list with 'Dynamic' elements into a 'Dynamic' of a list with

205-- non-'Dynamic' elements, preserving the order of the elements.

206+{-# DEPRECATED distributeListOverDynPure "Use 'distributeListOverDyn' instead" #-}

206distributeListOverDynPure :: Reflex t => [Dynamic t v] -> Dynamic t [v]

207distributeListOverDynPure :: Reflex t => [Dynamic t v] -> Dynamic t [v]

207−distributeListOverDynPure =

208+distributeListOverDynPure = distributeListOverDyn

208− fmap (map fromDSum . DMap.toAscList) .

209− distributeDMapOverDynPure .

210− DMap.fromDistinctAscList .

211− zipWith toDSum [0..]

212− where

213− toDSum :: Int -> Dynamic t a -> DSum (Const2 Int a) (Dynamic t)

214− toDSum k v = Const2 k :=> v

215− fromDSum :: DSum (Const2 Int a) Identity -> a

216− fromDSum (Const2 _ :=> Identity v) = v

217

209

218--TODO: Generalize this to functors other than Maps

210--TODO: Generalize this to functors other than Maps

219-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'

211-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'

@@ -301,6 +293,8 @@ maybeDyn = fmap (fmap unpack) . eitherDyn . fmap pack

301 Left _ -> Nothing

293 Left _ -> Nothing

302 Right a -> Just a

294 Right a -> Just a

303

295

296+-- | Turns a 'Dynamic t (Either a b)' into a 'Dynamic t (Either (Dynamic t a) (Dynamic t b))' such that

297+-- the outer 'Dynamic' is updated only when the 'Either' constructor changes (e.g., from 'Left' to 'Right').

304eitherDyn :: forall t a b m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Either a b) -> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))

298eitherDyn :: forall t a b m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Either a b) -> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))

305eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum

299eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum

306 where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)

300 where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)

@@ -308,6 +302,9 @@ eitherDyn = fmap (fmap unpack) . factorDyn . fmap eitherToDSum

308 LeftTag :=> Compose a -> Left $ coerceDynamic a

302 LeftTag :=> Compose a -> Left $ coerceDynamic a

309 RightTag :=> Compose b -> Right $ coerceDynamic b

303 RightTag :=> Compose b -> Right $ coerceDynamic b

310

304

305+-- | Factor a 'Dynamic t DSum' into a 'Dynamic' 'DSum' containing nested 'Dynamic' values.

306+-- The outer 'Dynamic' updates only when the key of the 'DSum' changes, while the update of the inner

307+-- 'Dynamic' represents updates within the current key.

311factorDyn :: forall t m k v. (Reflex t, MonadHold t m, GEq k)

308factorDyn :: forall t m k v. (Reflex t, MonadHold t m, GEq k)

312 => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))

309 => Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))

313factorDyn d = buildDynamic (sample (current d) >>= holdKey) update where

310factorDyn d = buildDynamic (sample (current d) >>= holdKey) update where

@@ -322,6 +319,7 @@ factorDyn d = buildDynamic (sample (current d) >>= holdKey) update where

322 inner' <- filterEventKey k (updated d)

319 inner' <- filterEventKey k (updated d)

323 inner <- holdDyn v inner'

320 inner <- holdDyn v inner'

324 return $ k :=> Compose inner

321 return $ k :=> Compose inner

322+

325--------------------------------------------------------------------------------

323--------------------------------------------------------------------------------

326-- Demux

324-- Demux

327--------------------------------------------------------------------------------

325--------------------------------------------------------------------------------

src/Reflex/DynamicWriter/Class.hs+1

@@ -17,6 +17,7 @@ import Control.Monad.Reader (ReaderT, lift)

17import Reflex.Class (Dynamic)

19{-# DEPRECATED MonadDynamicWriter "Use 'DynamicWriter' instead" #-}

20+-- | Type synonym for 'DynamicWriter'

20type MonadDynamicWriter = DynamicWriter

21type MonadDynamicWriter = DynamicWriter

22-- | 'MonadDynamicWriter' efficiently collects 'Dynamic' values using 'tellDyn'

23-- | 'MonadDynamicWriter' efficiently collects 'Dynamic' values using 'tellDyn'

src/Reflex/Patch/DMapWithMove.hs+6−7

@@ -19,9 +19,9 @@ import Reflex.Patch.Class

19import Reflex.Patch.MapWithMove (PatchMapWithMove (..))

20import qualified Reflex.Patch.MapWithMove as MapWithMove

22+import Data.Constraint.Extras

22import Data.Dependent.Map (DMap, DSum (..), GCompare (..))

23import Data.Dependent.Map (DMap, DSum (..), GCompare (..))

23import qualified Data.Dependent.Map as DMap

24import qualified Data.Dependent.Map as DMap

24−import Data.Dependent.Sum (EqTag (..))

25import Data.Functor.Constant

26import Data.Functor.Misc

27import Data.Functor.Product

@@ -30,8 +30,7 @@ import Data.GADT.Show (GShow, gshow)

30import qualified Data.Map as Map

31import Data.Maybe

32import Data.Semigroup (Semigroup (..), (<>))

33−import Data.Some (Some)

33+import Data.Some (Some(Some))

34−import qualified Data.Some as Some

35import Data.These

34import Data.These

37-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo' which describes how it will be changed by the patch and connects move sources and

36-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo' which describes how it will be changed by the patch and connects move sources and

@@ -105,8 +104,8 @@ validationErrorsForPatchDMapWithMove m =

105 unbalancedMove _ = Nothing

104 unbalancedMove _ = Nothing

106

105

107-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.

106-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.

108−instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where

107+instance (GEq k, Has' Eq k (NodeInfo k v)) => Eq (PatchDMapWithMove k v) where

109− PatchDMapWithMove a == PatchDMapWithMove b = a == b

108+ PatchDMapWithMove a == PatchDMapWithMove b = a == b

110

109

111-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9

110-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9

112data Pair1 f g a = Pair1 (f a) (g a)

111data Pair1 f g a = Pair1 (f a) (g a)

@@ -311,8 +310,8 @@ weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenD

311 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of

310 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of

312 From_Insert v -> MapWithMove.From_Insert $ f v

311 From_Insert v -> MapWithMove.From_Insert $ f v

313 From_Delete -> MapWithMove.From_Delete

312 From_Delete -> MapWithMove.From_Delete

314− From_Move k -> MapWithMove.From_Move $ Some.This k

313+ From_Move k -> MapWithMove.From_Move $ Some k

315− , MapWithMove._nodeInfo_to = Some.This <$> getComposeMaybe (_nodeInfo_to ni)

314+ , MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)

316 }

315 }

317

316

318-- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any

317-- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any

src/Reflex/Profiled.hs+10−6

@@ -8,6 +8,8 @@

8{-# LANGUAGE StandaloneDeriving #-}

9{-# LANGUAGE TypeFamilies #-}

10{-# LANGUAGE UndecidableInstances #-}

11+{-# LANGUAGE PolyKinds #-}

12+{-# LANGUAGE RankNTypes #-}

11-- |

13-- |

12-- Module:

14-- Module:

13-- Reflex.Profiled

15-- Reflex.Profiled

@@ -16,7 +18,6 @@

16-- profiling/cost-center information.

18-- profiling/cost-center information.

17module Reflex.Profiled where

19module Reflex.Profiled where

19−import Control.Lens hiding (children)

20import Control.Monad

21import Control.Monad

21import Control.Monad.Exception

22import Control.Monad.Exception

22import Control.Monad.Fix

23import Control.Monad.Fix

@@ -33,6 +34,7 @@ import Data.Map (Map)

33import qualified Data.Map.Strict as Map

34import qualified Data.Map.Strict as Map

34import Data.Monoid ((<>))

35import Data.Monoid ((<>))

35import Data.Ord

36import Data.Ord

37+import Data.Profunctor.Unsafe ((#.))

36import qualified Data.Semigroup as S

38import qualified Data.Semigroup as S

37import Data.Type.Coercion

39import Data.Type.Coercion

38import Foreign.Ptr

40import Foreign.Ptr

@@ -133,17 +135,19 @@ instance Reflex t => Reflex (ProfiledTimeline t) where

133 push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us

135 push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us

134 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

136 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

135 pull = Behavior_Profiled . pull . coerce

137 pull = Behavior_Profiled . pull . coerce

136− merge :: forall k. GCompare k => DMap k (Event (ProfiledTimeline t)) -> Event (ProfiledTimeline t) (DMap k Identity)

138+ fanG (Event_Profiled e) = EventSelectorG $ coerce $ selectG (fanG $ profileEvent e)

139+ mergeG :: forall (k :: z -> *) q v. GCompare k

140+ => (forall a. q a -> Event (ProfiledTimeline t) (v a))

137− merge = Event_Profiled . merge . (unsafeCoerce :: DMap k (Event (ProfiledTimeline t)) -> DMap k (Event t))

141+ -> DMap k q -> Event (ProfiledTimeline t) (DMap k v)

138− fan (Event_Profiled e) = EventSelector $ coerce $ select (fan $ profileEvent e)

142+ mergeG nt = Event_Profiled #. mergeG (coerce nt)

139 switch (Behavior_Profiled b) = coerce $ profileEvent $ switch (coerceBehavior b)

143 switch (Behavior_Profiled b) = coerce $ profileEvent $ switch (coerceBehavior b)

140 coincidence (Event_Profiled e) = coerce $ profileEvent $ coincidence (coerceEvent e)

144 coincidence (Event_Profiled e) = coerce $ profileEvent $ coincidence (coerceEvent e)

141 current (Dynamic_Profiled d) = coerce $ current d

145 current (Dynamic_Profiled d) = coerce $ current d

142 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

146 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

143 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

147 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

144 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

148 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

145− mergeIncremental = Event_Profiled . mergeIncremental . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchDMap k (Event (ProfiledTimeline t))) -> Incremental t (PatchDMap k (Event t)))

149+ mergeIncrementalG nt = (Event_Profiled . coerce) #. mergeIncrementalG nt

146− mergeIncrementalWithMove = Event_Profiled . mergeIncrementalWithMove . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchDMapWithMove k (Event (ProfiledTimeline t))) -> Incremental t (PatchDMapWithMove k (Event t)))

150+ mergeIncrementalWithMoveG nt = (Event_Profiled . coerce) #. mergeIncrementalWithMoveG nt

147 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

151 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

148 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

152 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

149 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

153 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

src/Reflex/Pure.hs+19−12

@@ -5,6 +5,9 @@

5{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE TypeFamilies #-}

8+{-# LANGUAGE RankNTypes #-}

9+{-# LANGUAGE PolyKinds #-}

10+

8#ifdef USE_REFLEX_OPTIMIZER

11#ifdef USE_REFLEX_OPTIMIZER

9{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

12{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

10#endif

13#endif

@@ -43,10 +46,11 @@ import Data.MemoTrie

43import Data.Monoid

46import Data.Monoid

44import Data.Type.Coercion

47import Data.Type.Coercion

45import Reflex.Class

48import Reflex.Class

49+import Data.Kind (Type)

47-- | A completely pure-functional 'Reflex' timeline, identifying moments in time

51-- | A completely pure-functional 'Reflex' timeline, identifying moments in time

48-- with the type @/t/@.

52-- with the type @/t/@.

49−data Pure t

53+data Pure (t :: Type)

51-- | The 'Enum' instance of @/t/@ must be dense: for all @/x :: t/@, there must not exist

55-- | The 'Enum' instance of @/t/@ must be dense: for all @/x :: t/@, there must not exist

52-- any @/y :: t/@ such that @/'pred' x < y < x/@. The 'HasTrie' instance will be used

56-- any @/y :: t/@ such that @/'pred' x < y < x/@. The 'HasTrie' instance will be used

@@ -79,17 +83,18 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

79 -- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a

83 -- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a

80 -- warning because the GCompare instance is not used; however, removing the

84 -- warning because the GCompare instance is not used; however, removing the

81 -- GCompare instance produces a different warning, due to that constraint

85 -- GCompare instance produces a different warning, due to that constraint

82− -- being present in the original class definition

86+ -- being present in the original class definition.

84− --merge :: GCompare k => DMap k (Event (Pure t)) -> Event (Pure t) (DMap k Identity)

88+ --mergeG :: GCompare k => (forall a. q a -> Event (Pure t) (v a))

89+ -- -> DMap k q -> Event (Pure t) (DMap k v)

85− merge events = Event $ memo $ \t ->

90+ mergeG nt events = Event $ memo $ \t ->

86− let currentOccurrences = DMap.mapMaybeWithKey (\_ (Event a) -> Identity <$> a t) events

91+ let currentOccurrences = DMap.mapMaybeWithKey (\_ q -> case nt q of Event a -> a t) events

87 in if DMap.null currentOccurrences

92 in if DMap.null currentOccurrences

88 then Nothing

93 then Nothing

89 else Just currentOccurrences

94 else Just currentOccurrences

91− fan :: GCompare k => Event (Pure t) (DMap k Identity) -> EventSelector (Pure t) k

96+ -- fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v

92− fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= fmap runIdentity . DMap.lookup k

97+ fanG e = EventSelectorG $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k

94 switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a

99 switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a

95 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t

100 switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t

@@ -112,8 +117,8 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

112 --a) -> Incremental (Pure t) p a

117 --a) -> Incremental (Pure t) p a

113 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)

118 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)

114

119

115− mergeIncremental = mergeIncrementalImpl

120+ mergeIncrementalG = mergeIncrementalImpl

116− mergeIncrementalWithMove = mergeIncrementalImpl

121+ mergeIncrementalWithMoveG = mergeIncrementalImpl

117

122

118 currentIncremental i = Behavior $ \t -> fst $ unIncremental i t

123 currentIncremental i = Behavior $ \t -> fst $ unIncremental i t

119

124

@@ -133,9 +138,11 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

133

138

134 mergeIntIncremental = mergeIntIncrementalImpl

139 mergeIntIncremental = mergeIntIncrementalImpl

135

140

136−mergeIncrementalImpl :: (PatchTarget p ~ DMap k (Event (Pure t)), GCompare k) => Incremental (Pure t) p -> Event (Pure t) (DMap k Identity)

141+mergeIncrementalImpl :: (PatchTarget p ~ DMap k q, GCompare k)

142+ => (forall a. q a -> Event (Pure t) (v a))

143+ -> Incremental (Pure t) p -> Event (Pure t) (DMap k v)

137−mergeIncrementalImpl i = Event $ \t ->

144+mergeIncrementalImpl nt i = Event $ \t ->

138− let results = DMap.mapMaybeWithKey (\_ (Event e) -> Identity <$> e t) $ fst $ unIncremental i t

145+ let results = DMap.mapMaybeWithKey (\_ q -> case nt q of Event e -> e t) $ fst $ unIncremental i t

139 in if DMap.null results

146 in if DMap.null results

140 then Nothing

147 then Nothing

141 else Just results

148 else Just results

src/Reflex/Query/Base.hs+5−6

@@ -38,8 +38,7 @@ import Data.Map (Map)

38import qualified Data.Map as Map

39import Data.Monoid ((<>))

40import qualified Data.Semigroup as S

41−import Data.Some (Some)

41+import Data.Some (Some(Some))

42−import qualified Data.Some as Some

43import Data.These

42import Data.These

45import Reflex.Class

44import Reflex.Class

@@ -145,10 +144,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t

145 liftedResult' = fforCheap result' $ \(PatchDMap p) -> PatchDMap $

144 liftedResult' = fforCheap result' $ \(PatchDMap p) -> PatchDMap $

146 mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mr) -> k :=> ComposeMaybe (fmap (getQueryTLoweredResultValue . getCompose) mr)) p

145 mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mr) -> k :=> ComposeMaybe (fmap (getQueryTLoweredResultValue . getCompose) mr)) p

147 liftedBs0 :: Map (Some k) [Behavior t q]

146 liftedBs0 :: Map (Some k) [Behavior t q]

148− liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0

147+ liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0

149 liftedBs' :: Event t (PatchMap (Some k) [Behavior t q])

148 liftedBs' :: Event t (PatchMap (Some k) [Behavior t q])

150 liftedBs' = fforCheap result' $ \(PatchDMap p) -> PatchMap $

149 liftedBs' = fforCheap result' $ \(PatchDMap p) -> PatchMap $

151− Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some.This k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p

150+ Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p

152 sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q

151 sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q

153 sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty

152 sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty

154 accumBehaviors :: forall m'. MonadHold t m'

153 accumBehaviors :: forall m'. MonadHold t m'

@@ -189,10 +188,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t

189 let liftedResult0 = mapKeyValuePairsMonotonic (\(k :=> Compose r) -> k :=> getQueryTLoweredResultValue r) result0

188 let liftedResult0 = mapKeyValuePairsMonotonic (\(k :=> Compose r) -> k :=> getQueryTLoweredResultValue r) result0

190 liftedResult' = fforCheap result' $ mapPatchDMapWithMove (getQueryTLoweredResultValue . getCompose)

189 liftedResult' = fforCheap result' $ mapPatchDMapWithMove (getQueryTLoweredResultValue . getCompose)

191 liftedBs0 :: Map (Some k) [Behavior t q]

190 liftedBs0 :: Map (Some k) [Behavior t q]

192− liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0

191+ liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0

193 liftedBs' :: Event t (PatchMapWithMove (Some k) [Behavior t q])

192 liftedBs' :: Event t (PatchMapWithMove (Some k) [Behavior t q])

194 liftedBs' = fforCheap result' $ weakenPatchDMapWithMoveWith (getQueryTLoweredResultWritten . getCompose) {- \(PatchDMap p) -> PatchMapWithMove $

193 liftedBs' = fforCheap result' $ weakenPatchDMapWithMoveWith (getQueryTLoweredResultWritten . getCompose) {- \(PatchDMap p) -> PatchMapWithMove $

195− Map.fromDistinctAscList $ (\(k :=> mr) -> (Some.This k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}

194+ Map.fromDistinctAscList $ (\(k :=> mr) -> (Some k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}

196 sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q

195 sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q

197 sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty

196 sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty

198 accumBehaviors' :: forall m'. MonadHold t m'

197 accumBehaviors' :: forall m'. MonadHold t m'

src/Reflex/Query/Class.hs+24−4

@@ -6,6 +6,13 @@

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE TypeFamilies #-}

8{-# LANGUAGE UndecidableInstances #-}

9+-- |

10+-- Module:

11+-- Reflex.Query.Class

12+-- Description:

13+-- A class that ties together queries to some data source and their results,

14+-- providing methods for requesting data from the source and accumulating

15+-- streamed results.

9module Reflex.Query.Class

16module Reflex.Query.Class

10 ( Query (..)

17 ( Query (..)

11 , QueryMorphism (..)

18 , QueryMorphism (..)

@@ -32,6 +39,10 @@ import Foreign.Storable

33import Reflex.Class

40import Reflex.Class

42+-- | A 'Query' can be thought of as a declaration of interest in some set of data.

43+-- A 'QueryResult' is the set of data associated with that interest set.

44+-- The @crop@ function provides a way to determine what part of a given 'QueryResult'

45+-- is relevant to a given 'Query'.

35class (Monoid (QueryResult a), Semigroup (QueryResult a)) => Query a where

46class (Monoid (QueryResult a), Semigroup (QueryResult a)) => Query a where

36 type QueryResult a :: *

47 type QueryResult a :: *

37 crop :: a -> QueryResult a -> QueryResult a

48 crop :: a -> QueryResult a -> QueryResult a

@@ -40,8 +51,8 @@ instance (Ord k, Query v) => Query (MonoidalMap k v) where

40 type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)

51 type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)

41 crop q r = MonoidalMap.intersectionWith (flip crop) r q

52 crop q r = MonoidalMap.intersectionWith (flip crop) r q

43−-- | NB: QueryMorphism's must be group homomorphisms when acting on the query type

54+-- | QueryMorphism's must be group homomorphisms when acting on the query type

44−-- and compatible with the query relationship when acting on the query result

55+-- and compatible with the query relationship when acting on the query result.

45data QueryMorphism q q' = QueryMorphism

56data QueryMorphism q q' = QueryMorphism

46 { _queryMorphism_mapQuery :: q -> q'

57 { _queryMorphism_mapQuery :: q -> q'

47 , _queryMorphism_mapQueryResult :: QueryResult q' -> QueryResult q

58 , _queryMorphism_mapQueryResult :: QueryResult q' -> QueryResult q

@@ -54,13 +65,16 @@ instance Category QueryMorphism where

54 , _queryMorphism_mapQueryResult = mapQueryResult qm' . mapQueryResult qm

65 , _queryMorphism_mapQueryResult = mapQueryResult qm' . mapQueryResult qm

55 }

66 }

68+-- | Apply a 'QueryMorphism' to a 'Query'

57mapQuery :: QueryMorphism q q' -> q -> q'

69mapQuery :: QueryMorphism q q' -> q -> q'

58mapQuery = _queryMorphism_mapQuery

70mapQuery = _queryMorphism_mapQuery

72+-- | Map a 'QueryMorphism' to a 'QueryResult'

60mapQueryResult :: QueryMorphism q q' -> QueryResult q' -> QueryResult q

73mapQueryResult :: QueryMorphism q q' -> QueryResult q' -> QueryResult q

61mapQueryResult = _queryMorphism_mapQueryResult

74mapQueryResult = _queryMorphism_mapQueryResult

63−-- | This type keeps track of the multiplicity of elements of the view selector that are being used by the app

76+-- | This type can be used to track of the frequency of interest in a given 'Query'. See note on

77+-- 'combineSelectedCounts'

64newtype SelectedCount = SelectedCount { unSelectedCount :: Int }

78newtype SelectedCount = SelectedCount { unSelectedCount :: Int }

65 deriving (Eq, Ord, Show, Read, Integral, Num, Bounded, Enum, Real, Ix, Bits, FiniteBits, Storable, Data)

79 deriving (Eq, Ord, Show, Read, Integral, Num, Bounded, Enum, Real, Ix, Bits, FiniteBits, Storable, Data)

@@ -76,10 +90,14 @@ instance Group SelectedCount where

77instance Additive SelectedCount

91instance Additive SelectedCount

93+-- | The Semigroup/Monoid/Group instances for a Query containing 'SelectedCount's should use

79−-- | The Semigroup/Monoid/Group instances for a ViewSelector should use this function which returns Nothing if the result is 0. This allows the pruning of leaves that are no longer wanted.

94+-- this function which returns Nothing if the result is 0. This allows the pruning of leaves

95+-- of the 'Query' that are no longer wanted.

80combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount

96combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount

81combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j then Nothing else Just $ SelectedCount (i + j)

97combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j then Nothing else Just $ SelectedCount (i + j)

99+-- | A class that allows sending of 'Query's and retrieval of 'QueryResult's. See 'queryDyn' for a commonly

100+-- used interface.

83class (Group q, Additive q, Query q) => MonadQuery t q m | m -> q t where

101class (Group q, Additive q, Query q) => MonadQuery t q m | m -> q t where

84 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()

102 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()

85 askQueryResult :: m (Dynamic t (QueryResult q))

103 askQueryResult :: m (Dynamic t (QueryResult q))

@@ -90,9 +108,11 @@ instance (Monad m, MonadQuery t q m) => MonadQuery t q (ReaderT r m) where

90 askQueryResult = lift askQueryResult

108 askQueryResult = lift askQueryResult

91 queryIncremental = lift . queryIncremental

109 queryIncremental = lift . queryIncremental

110

111+-- | Produce and send an 'Incremental' 'Query' from a 'Dynamic' 'Query'.

93tellQueryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m ()

112tellQueryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m ()

94tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)

113tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)

114

115+-- | Retrieve 'Dynamic'ally updating 'QueryResult's for a 'Dynamic'ally updating 'Query'.

96queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

116queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

97queryDyn q = do

117queryDyn q = do

98 tellQueryDyn q

118 tellQueryDyn q

src/Reflex/Requester/Base.hs+2−3

@@ -66,8 +66,7 @@ import qualified Data.Map as Map

66import Data.Monoid ((<>))

67import Data.Proxy

68import qualified Data.Semigroup as S

69−import Data.Some (Some)

69+import Data.Some (Some(Some))

70−import qualified Data.Some as Some

71import Data.Type.Equality

70import Data.Type.Equality

72import Data.Unique.Tag

71import Data.Unique.Tag

@@ -441,7 +440,7 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN

441 pack = Entry

440 pack = Entry

442 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)

441 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)

443 f' k (Compose (n, v)) = do

442 f' k (Compose (n, v)) = do

444− (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))

443+ (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))

445 return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)

444 return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)

446 ndm' <- numberOccurrencesFrom 1 dm'

445 ndm' <- numberOccurrencesFrom 1 dm'

447 (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'

446 (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'

src/Reflex/Spider/Internal.hs+189−155

@@ -17,9 +17,13 @@

17{-# LANGUAGE TypeFamilies #-}

18{-# LANGUAGE TypeOperators #-}

19{-# LANGUAGE UndecidableInstances #-}

20+{-# LANGUAGE PolyKinds #-}

21+{-# LANGUAGE InstanceSigs #-}

22+

20#ifdef USE_REFLEX_OPTIMIZER

23#ifdef USE_REFLEX_OPTIMIZER

21{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

24{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

22#endif

25#endif

26+{-# OPTIONS_GHC -Wunused-binds #-}

23-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses

27-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses

24-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.

28-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.

25module Reflex.Spider.Internal (module Reflex.Spider.Internal) where

29module Reflex.Spider.Internal (module Reflex.Spider.Internal) where

@@ -49,6 +53,7 @@ import Data.GADT.Compare

49import Data.IntMap.Strict (IntMap)

53import Data.IntMap.Strict (IntMap)

50import qualified Data.IntMap.Strict as IntMap

54import qualified Data.IntMap.Strict as IntMap

51import Data.IORef

55import Data.IORef

56+import Data.Kind (Type)

52import Data.Maybe hiding (mapMaybe)

57import Data.Maybe hiding (mapMaybe)

53import Data.Monoid ((<>))

58import Data.Monoid ((<>))

54import Data.Proxy

59import Data.Proxy

@@ -74,9 +79,9 @@ import Data.Tree (Forest, Tree (..), drawForest)

74import Data.FastWeakBag (FastWeakBag)

79import Data.FastWeakBag (FastWeakBag)

75import qualified Data.FastWeakBag as FastWeakBag

80import qualified Data.FastWeakBag as FastWeakBag

76import Data.Reflection

81import Data.Reflection

77−import Data.Some (Some)

82+import Data.Some (Some(Some))

78−import qualified Data.Some as Some

79import Data.Type.Coercion

83import Data.Type.Coercion

84+import Data.Profunctor.Unsafe ((#.), (.#))

80import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)

85import Data.WeakBag (WeakBag, WeakBagTicket, _weakBag_children)

81import qualified Data.WeakBag as WeakBag

86import qualified Data.WeakBag as WeakBag

82import qualified Reflex.Class

87import qualified Reflex.Class

@@ -193,12 +198,6 @@ nextNodeIdRef = unsafePerformIO $ newIORef 1

193

198

194newNodeId :: IO Int

199newNodeId :: IO Int

195newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)

200newNodeId = atomicModifyIORef' nextNodeIdRef $ \n -> (succ n, n)

196−

197−{-# NOINLINE unsafeNodeId #-}

198−unsafeNodeId :: a -> Int

199−unsafeNodeId a = unsafePerformIO $ do

200− touch a

201− newNodeId

202#endif

201#endif

203

202

204--------------------------------------------------------------------------------

203--------------------------------------------------------------------------------

@@ -302,9 +301,10 @@ cacheEvent e =

302#else

301#else

303 Event $

302 Event $

304#endif

303#endif

304+ unsafePerformIO $ do

305− let mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))

305+ mSubscribedRef :: IORef (FastWeak (CacheSubscribed x a))

306− !mSubscribedRef = unsafeNewIORef e emptyFastWeak

306+ <- newIORef emptyFastWeak

307− in \sub -> {-# SCC "cacheEvent" #-} do

307+ pure $ \sub -> {-# SCC "cacheEvent" #-} do

308#ifdef DEBUG_TRACE_EVENTS

309 unless (BS8.null callSite) $ liftIO $ BS8.hPutStrLn stderr callSite

310#endif

@@ -370,7 +370,7 @@ eventRoot !k !r = Event $ wrap eventSubscribedRoot $ liftIO . getRootSubscribed

370eventNever :: Event x a

371eventNever = Event $ \_ -> return (EventSubscription (return ()) eventSubscribedNever, Nothing)

372

373−eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k -> Event x a

373+eventFan :: (GCompare k, HasSpiderTimeline x) => k a -> Fan x k v -> Event x (v a)

374eventFan !k !f = Event $ wrap eventSubscribedFan $ getFanSubscribed k f

375

376eventSwitch :: HasSpiderTimeline x => Switch x a -> Event x a

@@ -422,14 +422,14 @@ newSubscriberHold h = return $ Subscriber

422 , subscriberRecalculateHeight = \_ -> return ()

423 }

424

425−newSubscriberFan :: forall x k. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k -> IO (Subscriber x (DMap k Identity))

425+newSubscriberFan :: forall x k v. (HasSpiderTimeline x, GCompare k) => FanSubscribed x k v -> IO (Subscriber x (DMap k v))

426newSubscriberFan subscribed = return $ Subscriber

427 { subscriberPropagate = \a -> {-# SCC "traverseFan" #-} do

428 subs <- liftIO $ readIORef $ fanSubscribedSubscribers subscribed

429 tracePropagate (Proxy :: Proxy x) $ "SubscriberFan" <> showNodeId subscribed <> ": " ++ show (DMap.size subs) ++ " keys subscribed, " ++ show (DMap.size a) ++ " keys firing"

430 liftIO $ writeIORef (fanSubscribedOccurrence subscribed) $ Just a

431 scheduleClear $ fanSubscribedOccurrence subscribed

432− let f _ (Pair (Identity v) subsubs) = do

432+ let f _ (Pair v subsubs) = do

433 propagate v $ _fanSubscribedChildren_list subsubs

434 return $ Constant ()

435 _ <- DMap.traverseWithKey f $ DMap.intersectionWithKey (\_ -> Pair) a subs --TODO: Would be nice to have DMap.traverse_

@@ -577,12 +577,12 @@ eventSubscribedNever = EventSubscribed

577#endif

578 }

579

580−eventSubscribedFan :: FanSubscribed x k -> EventSubscribed x

580+eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x

581eventSubscribedFan !subscribed = EventSubscribed

582 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed

583 , eventSubscribedRetained = toAny subscribed

584#ifdef DEBUG_CYCLES

585− , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]

585+ , eventSubscribedGetParents = return [Some $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]

586 , eventSubscribedHasOwnHeightRef = False

587 , eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed

588#endif

@@ -595,7 +595,7 @@ eventSubscribedSwitch !subscribed = EventSubscribed

595#ifdef DEBUG_CYCLES

596 , eventSubscribedGetParents = do

597 s <- readIORef $ switchSubscribedCurrentParent subscribed

598− return [Some.This $ _eventSubscription_subscribed s]

598+ return [Some $ _eventSubscription_subscribed s]

599 , eventSubscribedHasOwnHeightRef = True

600 , eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed

601#endif

@@ -608,8 +608,8 @@ eventSubscribedCoincidence !subscribed = EventSubscribed

608#ifdef DEBUG_CYCLES

609 , eventSubscribedGetParents = do

610 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed

611− let outerParent = Some.This $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed

611+ let outerParent = Some $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed

612− innerParents = maybeToList $ fmap Some.This innerSubscription

612+ innerParents = maybeToList $ fmap Some innerSubscription

613 return $ outerParent : innerParents

614 , eventSubscribedHasOwnHeightRef = True

615 , eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed

@@ -625,13 +625,13 @@ whoCreatedEventSubscribed = eventSubscribedWhoCreated

625

626walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]

627walkInvalidHeightParents s0 = do

628− subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do

628+ subscribers <- flip execStateT mempty $ ($ Some s0) $ fix $ \loop (Some s) -> do

629 h <- liftIO $ readIORef $ eventSubscribedHeightRef s

630 when (h == invalidHeight) $ do

631 when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed

632− modify (Some.This s :)

632+ modify (Some s :)

633 mapM_ loop =<< liftIO (eventSubscribedGetParents s)

634− forM_ subscribers $ \(Some.This s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight

634+ forM_ subscribers $ \(Some s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight

635 return subscribers

636#endif

637

@@ -659,7 +659,7 @@ behaviorPull !p = Behavior $ do

659 val <- liftIO $ readIORef $ pullValue p

660 case val of

661 Just subscribed -> do

662− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))

662+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))

663 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))

664 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed

665 return $ pullSubscribedValue subscribed

@@ -678,7 +678,7 @@ behaviorPull !p = Behavior $ do

678 , pullSubscribedParents = parents

679 }

680 liftIO $ writeIORef (pullValue p) $ Just subscribed

681− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))

681+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))

682 return a

683

684behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)

@@ -689,7 +689,7 @@ readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)

689readHoldTracked h = do

690 result <- liftIO $ readIORef $ holdValue h

691 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))

692− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedHold h) :))

692+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedHold h)) :))

693 liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected

694 return result

695

@@ -705,7 +705,7 @@ readBehaviorUntracked b = do

705

706data Dynamic x p = Dynamic

707 { dynamicCurrent :: !(Behavior x (PatchTarget p))

708− , dynamicUpdated :: !(Event x p)

708+ , dynamicUpdated :: Event x p -- This must be lazy; see the comment on holdEvent --TODO: Would this let us eliminate `Dyn`?

709 }

710

711dynamicHold :: Hold x p -> Dynamic x p

@@ -782,9 +782,9 @@ data EventEnv x

782 , eventEnvDynInits :: !(IORef [SomeDynInit x])

783 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])

784 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe

785− , eventEnvClears :: !(IORef [SomeClear]) -- Needed for Subscribe

785+ , eventEnvClears :: !(IORef [Some Clear]) -- Needed for Subscribe

786− , eventEnvIntClears :: !(IORef [SomeIntClear])

786+ , eventEnvIntClears :: !(IORef [Some IntClear])

787− , eventEnvRootClears :: !(IORef [SomeRootClear])

787+ , eventEnvRootClears :: !(IORef [Some RootClear])

788 , eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe

789 , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe

790 , eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))

@@ -856,29 +856,29 @@ putCurrentHeight h = do

856 heightRef <- asksEventEnv eventEnvCurrentHeight

857 liftIO $ writeIORef heightRef $! h

858

859−instance HasSpiderTimeline x => Defer SomeClear (EventM x) where

859+instance HasSpiderTimeline x => Defer (Some Clear) (EventM x) where

860 {-# INLINE getDeferralQueue #-}

861 getDeferralQueue = asksEventEnv eventEnvClears

862

863{-# INLINE scheduleClear #-}

864−scheduleClear :: Defer SomeClear m => IORef (Maybe a) -> m ()

864+scheduleClear :: Defer (Some Clear) m => IORef (Maybe a) -> m ()

865−scheduleClear r = defer $ SomeClear r

865+scheduleClear r = defer $ Some $ Clear r

866

867−instance HasSpiderTimeline x => Defer SomeIntClear (EventM x) where

867+instance HasSpiderTimeline x => Defer (Some IntClear) (EventM x) where

868 {-# INLINE getDeferralQueue #-}

869 getDeferralQueue = asksEventEnv eventEnvIntClears

870

871{-# INLINE scheduleIntClear #-}

872−scheduleIntClear :: Defer SomeIntClear m => IORef (IntMap a) -> m ()

872+scheduleIntClear :: Defer (Some IntClear) m => IORef (IntMap a) -> m ()

873−scheduleIntClear r = defer $ SomeIntClear r

873+scheduleIntClear r = defer $ Some $ IntClear r

874

875−instance HasSpiderTimeline x => Defer SomeRootClear (EventM x) where

875+instance HasSpiderTimeline x => Defer (Some RootClear) (EventM x) where

876 {-# INLINE getDeferralQueue #-}

877 getDeferralQueue = asksEventEnv eventEnvRootClears

878

879{-# INLINE scheduleRootClear #-}

880−scheduleRootClear :: Defer SomeRootClear m => IORef (DMap k Identity) -> m ()

880+scheduleRootClear :: Defer (Some RootClear) m => IORef (DMap k Identity) -> m ()

881−scheduleRootClear r = defer $ SomeRootClear r

881+scheduleRootClear r = defer $ Some $ RootClear r

882

883instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where

884 {-# INLINE getDeferralQueue #-}

@@ -951,7 +951,7 @@ data BehaviorSubscribed x a

951 = forall p. BehaviorSubscribedHold (Hold x p)

952 | BehaviorSubscribedPull (PullSubscribed x a)

953

954−data SomeBehaviorSubscribed x = forall a. SomeBehaviorSubscribed (BehaviorSubscribed x a)

954+newtype SomeBehaviorSubscribed x = SomeBehaviorSubscribed (Some (BehaviorSubscribed x))

955

956--type role PullSubscribed representational

957data PullSubscribed x a

@@ -986,7 +986,7 @@ data RootSubscribed x a = forall k. GCompare k => RootSubscribed

986#endif

987 }

988

989−data Root x (k :: * -> *)

989+data Root x k

990 = Root { rootOccurrence :: !(IORef (DMap k Identity)) -- The currently-firing occurrence of this event

991 , rootSubscribed :: !(IORef (DMap k (RootSubscribed x)))

992 , rootInit :: !(forall a. k a -> RootTrigger x a -> IO (IO ()))

@@ -1056,25 +1056,25 @@ heightBagVerify b@(HeightBag s c) = if

1056heightBagVerify = id

1057#endif

1058

1059−data FanSubscribedChildren (x :: *) k a = FanSubscribedChildren

1059+data FanSubscribedChildren x k v a = FanSubscribedChildren

1060− { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x a))

1060+ { _fanSubscribedChildren_list :: !(WeakBag (Subscriber x (v a)))

1061− , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k)

1061+ , _fanSubscribedChildren_self :: {-# NOUNPACK #-} !(k a, FanSubscribed x k v)

1062− , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k)))

1062+ , _fanSubscribedChildren_weakSelf :: !(IORef (Weak (k a, FanSubscribed x k v)))

1063 }

1064

1065−data FanSubscribed (x :: *) k

1065+data FanSubscribed x k v

1066− = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k)))

1066+ = FanSubscribed { fanSubscribedCachedSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))

1067− , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k Identity)))

1067+ , fanSubscribedOccurrence :: !(IORef (Maybe (DMap k v)))

1068− , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k))) -- This DMap should never be empty

1068+ , fanSubscribedSubscribers :: !(IORef (DMap k (FanSubscribedChildren x k v))) -- This DMap should never be empty

1069 , fanSubscribedParent :: !(EventSubscription x)

1070#ifdef DEBUG_NODEIDS

1071 , fanSubscribedNodeId :: Int

1072#endif

1073 }

1074

1075−data Fan x k

1075+data Fan x k v

1076− = Fan { fanParent :: !(Event x (DMap k Identity))

1076+ = Fan { fanParent :: !(Event x (DMap k v))

1077− , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k)))

1077+ , fanSubscribed :: !(IORef (Maybe (FanSubscribed x k v)))

1078 }

1079

1080data SwitchSubscribed x a

@@ -1133,13 +1133,17 @@ instance HasSpiderTimeline x => Filterable (Event x) where

1133

1134instance HasSpiderTimeline x => Align (Event x) where

1135 nil = eventNever

1136+#if MIN_VERSION_these(0, 8, 0)

1137+instance HasSpiderTimeline x => Semialign (Event x) where

1138+#endif

1139+ align ea eb = mapMaybe dmapToThese $ mergeG coerce $ dynamicConst $

1136− align ea eb = mapMaybe dmapToThese $ merge $ dynamicConst $ DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

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

1137

1141

1138data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)

1142data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)

1139 | BuildDyn !(EventM x (PatchTarget p), Event x p)

1143 | BuildDyn !(EventM x (PatchTarget p), Event x p)

1140 | HoldDyn !(Hold x p)

1144 | HoldDyn !(Hold x p)

1141

1145

1142−newtype Dyn x p = Dyn { unDyn :: IORef (DynType x p) }

1146+newtype Dyn (x :: Type) p = Dyn { unDyn :: IORef (DynType x p) }

1143

1147

1144newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1148newMapDyn :: HasSpiderTimeline x => (a -> b) -> Dynamic x (Identity a) -> Dynamic x (Identity b)

1145newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

1149newMapDyn f d = dynamicDynIdentity $ unsafeBuildDynamic (fmap f $ readBehaviorTracked $ dynamicCurrent d) (Identity . f . runIdentity <$> dynamicUpdated d)

@@ -1168,18 +1172,12 @@ buildDynamic readV0 v' = do

1168 return d

1172 return d

1169

1173

1170unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p

1174unsafeBuildDynamic :: BehaviorM x (PatchTarget p) -> Event x p -> Dyn x p

1171−unsafeBuildDynamic readV0 v' = Dyn $ unsafeNewIORef x $ UnsafeDyn x

1175+unsafeBuildDynamic readV0 v' =

1172− where x = (readV0, v')

1176+ Dyn $ unsafePerformIO $ newIORef $ UnsafeDyn (readV0, v')

1173

1177

1174-- ResultM can read behaviors and events

1178-- ResultM can read behaviors and events

1175type ResultM = EventM

1179type ResultM = EventM

1176

1180

1177−{-# NOINLINE unsafeNewIORef #-}

1178−unsafeNewIORef :: a -> b -> IORef b

1179−unsafeNewIORef a b = unsafePerformIO $ do

1180− touch a

1181− newIORef b

1182−

1183instance HasSpiderTimeline x => Functor (Event x) where

1181instance HasSpiderTimeline x => Functor (Event x) where

1184 fmap f = push $ return . Just . f

1182 fmap f = push $ return . Just . f

1185

1183

@@ -1192,26 +1190,35 @@ push f e = cacheEvent (pushCheap f e)

1192

1190

1193{-# INLINABLE pull #-}

1191{-# INLINABLE pull #-}

1194pull :: BehaviorM x a -> Behavior x a

1192pull :: BehaviorM x a -> Behavior x a

1195−pull a = behaviorPull $ Pull

1193+pull a = unsafePerformIO $ do

1196− { pullCompute = a

1194+ ref <- newIORef Nothing

1197− , pullValue = unsafeNewIORef a Nothing

1198#ifdef DEBUG_NODEIDS

1195#ifdef DEBUG_NODEIDS

1199− , pullNodeId = unsafeNodeId a

1196+ nid <- newNodeId

1200#endif

1197#endif

1198+ pure $ behaviorPull $ Pull

1199+ { pullCompute = a

1200+ , pullValue = ref

1201+#ifdef DEBUG_NODEIDS

1202+ , pullNodeId = nid

1203+#endif

1201− }

1204+ }

1202

1205

1203{-# INLINABLE switch #-}

1206{-# INLINABLE switch #-}

1204switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a

1207switch :: HasSpiderTimeline x => Behavior x (Event x a) -> Event x a

1208+switch a = unsafePerformIO $ do

1209+ ref <- newIORef Nothing

1205−switch a = eventSwitch $ Switch

1210+ pure $ eventSwitch $ Switch

1206− { switchParent = a

1211+ { switchParent = a

1207− , switchSubscribed = unsafeNewIORef a Nothing

1212+ , switchSubscribed = ref

1208− }

1213+ }

1209

1214

1210coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a

1215coincidence :: HasSpiderTimeline x => Event x (Event x a) -> Event x a

1216+coincidence a = unsafePerformIO $ do

1217+ ref <- newIORef Nothing

1211−coincidence a = eventCoincidence $ Coincidence

1218+ pure $ eventCoincidence $ Coincidence

1212− { coincidenceParent = a

1219+ { coincidenceParent = a

1213− , coincidenceSubscribed = unsafeNewIORef a Nothing

1220+ , coincidenceSubscribed = ref

1214− }

1221+ }

1215

1222

1216-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors

1223-- Propagate the given event occurrence; before cleaning up, run the given action, which may read the state of events and behaviors

1217run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b

1224run :: forall x b. HasSpiderTimeline x => [DSum (RootTrigger x) Identity] -> ResultM x b -> SpiderHost x b

@@ -1256,11 +1263,11 @@ scheduleMerge' initialHeight heightRef a = scheduleMerge initialHeight $ do

1256 GT -> scheduleMerge' height heightRef a -- The height has been increased (by a coincidence event; TODO: is this the only way?)

1263 GT -> scheduleMerge' height heightRef a -- The height has been increased (by a coincidence event; TODO: is this the only way?)

1257 EQ -> a

1264 EQ -> a

1258

1265

1259−data SomeClear = forall a. SomeClear {-# UNPACK #-} !(IORef (Maybe a))

1266+newtype Clear a = Clear (IORef (Maybe a))

1260

1267

1261−data SomeIntClear = forall a. SomeIntClear {-# UNPACK #-} !(IORef (IntMap a))

1268+newtype IntClear a = IntClear (IORef (IntMap a))

1262

1269

1263−data SomeRootClear = forall k. SomeRootClear {-# UNPACK #-} !(IORef (DMap k Identity))

1270+newtype RootClear k = RootClear (IORef (DMap k Identity))

1264

1271

1265data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a

1272data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a

1266

1273

@@ -1415,6 +1422,9 @@ getRootSubscribed k r sub = do

1415 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"

1422 when debugPropagate $ putStrLn $ "getRootSubscribed: calling rootInit"

1416 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)

1423 uninit <- rootInit r k $ RootTrigger (subs, rootOccurrence r, k)

1417 writeIORef uninitRef $! uninit

1424 writeIORef uninitRef $! uninit

1425+#ifdef DEBUG_NODEIDS

1426+ nid <- newNodeId

1427+#endif

1418 let !subscribed = RootSubscribed

1428 let !subscribed = RootSubscribed

1419 { rootSubscribedKey = k

1429 { rootSubscribedKey = k

1420 , rootSubscribedCachedSubscribed = cached

1430 , rootSubscribedCachedSubscribed = cached

@@ -1423,7 +1433,7 @@ getRootSubscribed k r sub = do

1423 , rootSubscribedUninit = uninit

1433 , rootSubscribedUninit = uninit

1424 , rootSubscribedWeakSelf = weakSelf

1434 , rootSubscribedWeakSelf = weakSelf

1425#ifdef DEBUG_NODEIDS

1435#ifdef DEBUG_NODEIDS

1426− , rootSubscribedNodeId = unsafeNodeId (k, r, subs)

1436+ , rootSubscribedNodeId = nid

1427#endif

1437#endif

1428 }

1438 }

1429 -- If we die at the same moment that all our children die, they will

1439 -- If we die at the same moment that all our children die, they will

@@ -1472,16 +1482,10 @@ newFanInt = do

1472 , _fanInt_occRef = occRef

1482 , _fanInt_occRef = occRef

1473 }

1483 }

1474

1484

1475−{-# NOINLINE unsafeNewFanInt #-}

1476−unsafeNewFanInt :: b -> FanInt x a

1477−unsafeNewFanInt b = unsafePerformIO $ do

1478− touch b

1479− newFanInt

1480−

1481fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a

1485fanInt :: HasSpiderTimeline x => Event x (IntMap a) -> EventSelectorInt x a

1482−fanInt p =

1486+fanInt p = unsafePerformIO $ do

1483− let self = unsafeNewFanInt p

1487+ self <- newFanInt

1484− in EventSelectorInt $ \k -> Event $ \sub -> do

1488+ pure $ EventSelectorInt $ \k -> Event $ \sub -> do

1485 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)

1489 isEmpty <- liftIO $ FastMutableIntMap.isEmpty (_fanInt_subscribers self)

1486 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input

1490 when isEmpty $ do -- This is the first subscriber, so we need to subscribe to our input

1487 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber

1491 (subscription, parentOcc) <- subscribeAndRead p $ Subscriber

@@ -1517,7 +1521,7 @@ fanInt p =

1517 return (EventSubscription (FastWeakBag.remove t) $! EventSubscribed heightRef $! toAny (_fanInt_subscriptionRef self, t), IntMap.lookup k currentOcc)

1521 return (EventSubscription (FastWeakBag.remove t) $! EventSubscribed heightRef $! toAny (_fanInt_subscriptionRef self, t), IntMap.lookup k currentOcc)

1518

1522

1519{-# INLINABLE getFanSubscribed #-}

1523{-# INLINABLE getFanSubscribed #-}

1520−getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k -> Subscriber x a -> EventM x (WeakBagTicket, FanSubscribed x k, Maybe a)

1524+getFanSubscribed :: (HasSpiderTimeline x, GCompare k) => k a -> Fan x k v -> Subscriber x (v a) -> EventM x (WeakBagTicket, FanSubscribed x k v, Maybe (v a))

1521getFanSubscribed k f sub = do

1525getFanSubscribed k f sub = do

1522 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

1526 mSubscribed <- liftIO $ readIORef $ fanSubscribed f

1523 case mSubscribed of

1527 case mSubscribed of

@@ -1535,13 +1539,16 @@ getFanSubscribed k f sub = do

1535 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"

1539 subscribersRef <- liftIO $ newIORef $ error "getFanSubscribed: subscribersRef not yet initialized"

1536 occRef <- liftIO $ newIORef parentOcc

1540 occRef <- liftIO $ newIORef parentOcc

1537 when (isJust parentOcc) $ scheduleClear occRef

1541 when (isJust parentOcc) $ scheduleClear occRef

1542+#ifdef DEBUG_NODEIDS

1543+ nid <- liftIO newNodeId

1544+#endif

1538 let subscribed = FanSubscribed

1545 let subscribed = FanSubscribed

1539 { fanSubscribedCachedSubscribed = fanSubscribed f

1546 { fanSubscribedCachedSubscribed = fanSubscribed f

1540 , fanSubscribedOccurrence = occRef

1547 , fanSubscribedOccurrence = occRef

1541 , fanSubscribedParent = subscription

1548 , fanSubscribedParent = subscription

1542 , fanSubscribedSubscribers = subscribersRef

1549 , fanSubscribedSubscribers = subscribersRef

1543#ifdef DEBUG_NODEIDS

1550#ifdef DEBUG_NODEIDS

1544− , fanSubscribedNodeId = unsafeNodeId f

1551+ , fanSubscribedNodeId = nid

1545#endif

1552#endif

1546 }

1553 }

1547 let !self = (k, subscribed)

1554 let !self = (k, subscribed)

@@ -1551,7 +1558,7 @@ getFanSubscribed k f sub = do

1551 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed

1558 liftIO $ writeIORef (fanSubscribed f) $ Just subscribed

1552 return (slnForSub, subscribed, coerce $ DMap.lookup k =<< parentOcc)

1559 return (slnForSub, subscribed, coerce $ DMap.lookup k =<< parentOcc)

1553

1560

1554−cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k) -> IO ()

1561+cleanupFanSubscribed :: GCompare k => (k a, FanSubscribed x k v) -> IO ()

1555cleanupFanSubscribed (k, subscribed) = do

1562cleanupFanSubscribed (k, subscribed) = do

1556 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1563 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1557 let reducedSubscribers = DMap.delete k subscribers

1564 let reducedSubscribers = DMap.delete k subscribers

@@ -1563,7 +1570,7 @@ cleanupFanSubscribed (k, subscribed) = do

1563 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers

1570 else writeIORef (fanSubscribedSubscribers subscribed) $! reducedSubscribers

1564

1571

1565{-# INLINE subscribeFanSubscribed #-}

1572{-# INLINE subscribeFanSubscribed #-}

1566−subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k -> Subscriber x a -> IO WeakBagTicket

1573+subscribeFanSubscribed :: GCompare k => k a -> FanSubscribed x k v -> Subscriber x (v a) -> IO WeakBagTicket

1567subscribeFanSubscribed k subscribed sub = do

1574subscribeFanSubscribed k subscribed sub = do

1568 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1575 subscribers <- readIORef $ fanSubscribedSubscribers subscribed

1569 case DMap.lookup k subscribers of

1576 case DMap.lookup k subscribers of

@@ -1601,6 +1608,9 @@ getSwitchSubscribed s sub = do

1601 when (isJust parentOcc) $ scheduleClear occRef

1608 when (isJust parentOcc) $ scheduleClear occRef

1602 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"

1609 weakSelf <- liftIO $ newIORef $ error "getSwitchSubscribed: weakSelf not yet initialized"

1603 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed

1610 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupSwitchSubscribed

1611+#ifdef DEBUG_NODEIDS

1612+ nid <- liftIO newNodeId

1613+#endif

1604 let !subscribed = SwitchSubscribed

1614 let !subscribed = SwitchSubscribed

1605 { switchSubscribedCachedSubscribed = switchSubscribed s

1615 { switchSubscribedCachedSubscribed = switchSubscribed s

1606 , switchSubscribedOccurrence = occRef

1616 , switchSubscribedOccurrence = occRef

@@ -1613,7 +1623,7 @@ getSwitchSubscribed s sub = do

1613 , switchSubscribedCurrentParent = subscriptionRef

1623 , switchSubscribedCurrentParent = subscriptionRef

1614 , switchSubscribedWeakSelf = weakSelf

1624 , switchSubscribedWeakSelf = weakSelf

1615#ifdef DEBUG_NODEIDS

1625#ifdef DEBUG_NODEIDS

1616− , switchSubscribedNodeId = unsafeNodeId s

1626+ , switchSubscribedNodeId = nid

1617#endif

1627#endif

1618 }

1628 }

1619 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"

1629 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "switchSubscribedWeakSelf"

@@ -1658,6 +1668,9 @@ getCoincidenceSubscribed c sub = do

1658 scheduleClear innerSubdRef

1668 scheduleClear innerSubdRef

1659 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"

1669 weakSelf <- liftIO $ newIORef $ error "getCoincidenceSubscribed: weakSelf not yet implemented"

1660 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed

1670 (subs, slnForSub) <- liftIO $ WeakBag.singleton sub weakSelf cleanupCoincidenceSubscribed

1671+#ifdef DEBUG_NODEIDS

1672+ nid <- liftIO newNodeId

1673+#endif

1661 let subscribed = CoincidenceSubscribed

1674 let subscribed = CoincidenceSubscribed

1662 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c

1675 { coincidenceSubscribedCachedSubscribed = coincidenceSubscribed c

1663 , coincidenceSubscribedOccurrence = occRef

1676 , coincidenceSubscribedOccurrence = occRef

@@ -1668,7 +1681,7 @@ getCoincidenceSubscribed c sub = do

1668 , coincidenceSubscribedInnerParent = innerSubdRef

1681 , coincidenceSubscribedInnerParent = innerSubdRef

1669 , coincidenceSubscribedWeakSelf = weakSelf

1682 , coincidenceSubscribedWeakSelf = weakSelf

1670#ifdef DEBUG_NODEIDS

1683#ifdef DEBUG_NODEIDS

1671− , coincidenceSubscribedNodeId = unsafeNodeId c

1684+ , coincidenceSubscribedNodeId = nid

1672#endif

1685#endif

1673 }

1686 }

1674 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"

1687 liftIO $ writeIORef weakSelf =<< evaluate =<< mkWeakPtrWithDebug subscribed "CoincidenceSubscribed"

@@ -1685,26 +1698,34 @@ cleanupCoincidenceSubscribed subscribed = do

1685subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket

1698subscribeCoincidenceSubscribed :: CoincidenceSubscribed x a -> Subscriber x a -> IO WeakBagTicket

1686subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

1699subscribeCoincidenceSubscribed subscribed sub = WeakBag.insert sub (coincidenceSubscribedSubscribers subscribed) (coincidenceSubscribedWeakSelf subscribed) cleanupCoincidenceSubscribed

1687

1700

1688−{-# INLINE merge #-}

1701+{-# INLINE mergeG #-}

1689−merge :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)

1702+mergeG :: forall k q x v. (HasSpiderTimeline x, GCompare k)

1703+ => (forall a. q a -> Event x (v a))

1704+ -> Dynamic x (PatchDMap k q) -> Event x (DMap k v)

1690−merge d = cacheEvent (mergeCheap d)

1705+mergeG nt d = cacheEvent (mergeCheap nt d)

1691

1706

1692{-# INLINE mergeWithMove #-}

1707{-# INLINE mergeWithMove #-}

1693−mergeWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)

1708+mergeWithMove :: forall k v q x. (HasSpiderTimeline x, GCompare k)

1709+ => (forall a. q a -> Event x (v a))

1710+ -> Dynamic x (PatchDMapWithMove k q) -> Event x (DMap k v)

1694−mergeWithMove d = cacheEvent (mergeCheapWithMove d)

1711+mergeWithMove nt d = cacheEvent (mergeCheapWithMove nt d)

1695

1712

1696{-# INLINE [1] mergeCheap #-}

1713{-# INLINE [1] mergeCheap #-}

1714+mergeCheap

1697−mergeCheap :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMap k (Event x)) -> Event x (DMap k Identity)

1715+ :: forall k x q v. (HasSpiderTimeline x, GCompare k)

1716+ => (forall a. q a -> Event x (v a))

1717+ -> Dynamic x (PatchDMap k q)

1718+ -> Event x (DMap k v)

1698−mergeCheap = mergeCheap' getInitialSubscribers updateMe destroy

1719+mergeCheap nt = mergeGCheap' getInitialSubscribers updateMe destroy

1699 where

1720 where

1700− updateMe :: MergeUpdateFunc k x (PatchDMap k (Event x)) (MergeSubscribedParent x)

1721+ updateMe :: MergeUpdateFunc k v x (PatchDMap k q) (MergeSubscribedParent x)

1701 updateMe subscriber heightBagRef oldParents (PatchDMap p) = do

1722 updateMe subscriber heightBagRef oldParents (PatchDMap p) = do

1702 let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do

1723 let f (subscriptionsToKill, ps) (k :=> ComposeMaybe me) = do

1703 (mOldSubd, newPs) <- case me of

1724 (mOldSubd, newPs) <- case me of

1704 Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps

1725 Nothing -> return $ DMap.updateLookupWithKey (\_ _ -> Nothing) k ps

1705 Just e -> do

1726 Just e -> do

1706 let s = subscriber $ return k

1727 let s = subscriber $ return k

1707− subscription@(EventSubscription _ subd) <- subscribe e s

1728+ subscription@(EventSubscription _ subd) <- subscribe (nt e) s

1708 newParentHeight <- liftIO $ getEventSubscribedHeight subd

1729 newParentHeight <- liftIO $ getEventSubscribedHeight subd

1709 let newParent = MergeSubscribedParent subscription

1730 let newParent = MergeSubscribedParent subscription

1710 liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight

1731 liftIO $ modifyIORef' heightBagRef $ heightBagAdd newParentHeight

@@ -1714,28 +1735,33 @@ mergeCheap = mergeCheap' getInitialSubscribers updateMe destroy

1714 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight

1735 liftIO $ modifyIORef heightBagRef $ heightBagRemove oldHeight

1715 return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)

1736 return (maybeToList (unMergeSubscribedParent <$> mOldSubd) ++ subscriptionsToKill, newPs)

1716 foldM f ([], oldParents) $ DMap.toList p

1737 foldM f ([], oldParents) $ DMap.toList p

1738+

1717− getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParent x)

1739+ getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParent x)

1718 getInitialSubscribers initialParents subscriber = do

1740 getInitialSubscribers initialParents subscriber = do

1719 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1741 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1720 let s = subscriber $ return k

1742 let s = subscriber $ return k

1721− (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s

1743+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s

1722 height <- liftIO $ getEventSubscribedHeight parentSubd

1744 height <- liftIO $ getEventSubscribedHeight parentSubd

1723− return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParent subscription)

1745+ return (fmap (\x -> k :=> x) parentOcc, height, k :=> MergeSubscribedParent subscription)

1724 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1746 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1725 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1747 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1726 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1748 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1727 )

1749 )

1750+

1728 destroy :: MergeDestroyFunc k (MergeSubscribedParent x)

1751 destroy :: MergeDestroyFunc k (MergeSubscribedParent x)

1729 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParent sub) -> unsubscribe sub

1752 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParent sub) -> unsubscribe sub

1730

1753

1731{-# INLINE [1] mergeCheapWithMove #-}

1754{-# INLINE [1] mergeCheapWithMove #-}

1732−mergeCheapWithMove :: forall k x. (HasSpiderTimeline x, GCompare k) => Dynamic x (PatchDMapWithMove k (Event x)) -> Event x (DMap k Identity)

1755+mergeCheapWithMove :: forall k x v q. (HasSpiderTimeline x, GCompare k)

1756+ => (forall a. q a -> Event x (v a))

1757+ -> Dynamic x (PatchDMapWithMove k q)

1758+ -> Event x (DMap k v)

1733−mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy

1759+mergeCheapWithMove nt = mergeGCheap' getInitialSubscribers updateMe destroy

1734 where

1760 where

1735− updateMe :: MergeUpdateFunc k x (PatchDMapWithMove k (Event x)) (MergeSubscribedParentWithMove x k)

1761+ updateMe :: MergeUpdateFunc k v x (PatchDMapWithMove k q) (MergeSubscribedParentWithMove x k)

1736 updateMe subscriber heightBagRef oldParents p = do

1762 updateMe subscriber heightBagRef oldParents p = do

1737 -- Prepare new parents for insertion

1763 -- Prepare new parents for insertion

1738− let subscribeParent :: forall a. k a -> Event x a -> EventM x (MergeSubscribedParentWithMove x k a)

1764+ let subscribeParent :: forall a. k a -> Event x (v a) -> EventM x (MergeSubscribedParentWithMove x k a)

1739 subscribeParent k e = do

1765 subscribeParent k e = do

1740 keyRef <- liftIO $ newIORef k

1766 keyRef <- liftIO $ newIORef k

1741 let s = subscriber $ liftIO $ readIORef keyRef

1767 let s = subscriber $ liftIO $ readIORef keyRef

@@ -1744,9 +1770,9 @@ mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy

1744 newParentHeight <- getEventSubscribedHeight subd

1770 newParentHeight <- getEventSubscribedHeight subd

1745 modifyIORef' heightBagRef $ heightBagAdd newParentHeight

1771 modifyIORef' heightBagRef $ heightBagAdd newParentHeight

1746 return $ MergeSubscribedParentWithMove subscription keyRef

1772 return $ MergeSubscribedParentWithMove subscription keyRef

1747− p' <- PatchDMapWithMove.traversePatchDMapWithMoveWithKey subscribeParent p

1773+ p' <- PatchDMapWithMove.traversePatchDMapWithMoveWithKey (\k q -> subscribeParent k (nt q)) p

1748 -- Collect old parents for deletion and update the keys of moved parents

1774 -- Collect old parents for deletion and update the keys of moved parents

1749− let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k (Event x) a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a

1775+ let moveOrDelete :: forall a. k a -> PatchDMapWithMove.NodeInfo k q a -> MergeSubscribedParentWithMove x k a -> Constant (EventM x (Maybe (EventSubscription x))) a

1750 moveOrDelete _ ni parent = Constant $ case getComposeMaybe $ PatchDMapWithMove._nodeInfo_to ni of

1776 moveOrDelete _ ni parent = Constant $ case getComposeMaybe $ PatchDMapWithMove._nodeInfo_to ni of

1751 Nothing -> do

1777 Nothing -> do

1752 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ _mergeSubscribedParentWithMove_subscription parent

1778 oldHeight <- liftIO $ getEventSubscribedHeight $ _eventSubscription_subscribed $ _mergeSubscribedParentWithMove_subscription parent

@@ -1757,46 +1783,47 @@ mergeCheapWithMove = mergeCheap' getInitialSubscribers updateMe destroy

1757 return Nothing

1783 return Nothing

1758 toDelete <- fmap catMaybes $ mapM (\(_ :=> v) -> getConstant v) $ DMap.toList $ DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents

1784 toDelete <- fmap catMaybes $ mapM (\(_ :=> v) -> getConstant v) $ DMap.toList $ DMap.intersectionWithKey moveOrDelete (unPatchDMapWithMove p) oldParents

1759 return (toDelete, applyAlways p' oldParents)

1785 return (toDelete, applyAlways p' oldParents)

1760− getInitialSubscribers :: MergeInitFunc k x (MergeSubscribedParentWithMove x k)

1786+ getInitialSubscribers :: MergeInitFunc k v q x (MergeSubscribedParentWithMove x k)

1761 getInitialSubscribers initialParents subscriber = do

1787 getInitialSubscribers initialParents subscriber = do

1762 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1788 subscribers <- forM (DMap.toList initialParents) $ \(k :=> e) -> do

1763 keyRef <- liftIO $ newIORef k

1789 keyRef <- liftIO $ newIORef k

1764 let s = subscriber $ liftIO $ readIORef keyRef

1790 let s = subscriber $ liftIO $ readIORef keyRef

1765− (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead e s

1791+ (subscription@(EventSubscription _ parentSubd), parentOcc) <- subscribeAndRead (nt e) s

1766 height <- liftIO $ getEventSubscribedHeight parentSubd

1792 height <- liftIO $ getEventSubscribedHeight parentSubd

1767− return (fmap (\x -> k :=> Identity x) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)

1793+ return (fmap (\x -> k :=> x) parentOcc, height, k :=> MergeSubscribedParentWithMove subscription keyRef)

1768 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1794 return ( DMap.fromDistinctAscList $ mapMaybe (\(x, _, _) -> x) subscribers

1769 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1795 , fmap (\(_, h, _) -> h) subscribers --TODO: Assert that there's no invalidHeight in here

1770 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1796 , DMap.fromDistinctAscList $ map (\(_, _, x) -> x) subscribers

1771 )

1797 )

1798+

1772 destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)

1799 destroy :: MergeDestroyFunc k (MergeSubscribedParentWithMove x k)

1773 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParentWithMove sub _) -> unsubscribe sub

1800 destroy s = forM_ (DMap.toList s) $ \(_ :=> MergeSubscribedParentWithMove sub _) -> unsubscribe sub

1774

1801

1775−type MergeUpdateFunc k x p s

1802+type MergeUpdateFunc k v x p s

1776− = (forall a. EventM x (k a) -> Subscriber x a)

1803+ = (forall a. EventM x (k a) -> Subscriber x (v a))

1777 -> IORef HeightBag

1804 -> IORef HeightBag

1778 -> DMap k s

1805 -> DMap k s

1779 -> p

1806 -> p

1780 -> EventM x ([EventSubscription x], DMap k s)

1807 -> EventM x ([EventSubscription x], DMap k s)

1781

1808

1782−type MergeInitFunc k x s

1809+type MergeInitFunc k v q x s

1783− = DMap k (Event x)

1810+ = DMap k q

1784− -> (forall a. EventM x (k a) -> Subscriber x a)

1811+ -> (forall a. EventM x (k a) -> Subscriber x (v a))

1785− -> EventM x (DMap k Identity, [Height], DMap k s)

1812+ -> EventM x (DMap k v, [Height], DMap k s)

1786

1813

1787type MergeDestroyFunc k s

1814type MergeDestroyFunc k s

1788 = DMap k s

1815 = DMap k s

1789 -> IO ()

1816 -> IO ()

1790

1817

1791−data Merge x k s = Merge

1818+data Merge x k v s = Merge

1792 { _merge_parentsRef :: {-# UNPACK #-} !(IORef (DMap k s))

1819 { _merge_parentsRef :: {-# UNPACK #-} !(IORef (DMap k s))

1793 , _merge_heightBagRef :: {-# UNPACK #-} !(IORef HeightBag)

1820 , _merge_heightBagRef :: {-# UNPACK #-} !(IORef HeightBag)

1794 , _merge_heightRef :: {-# UNPACK #-} !(IORef Height)

1821 , _merge_heightRef :: {-# UNPACK #-} !(IORef Height)

1795− , _merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k Identity))

1822+ , _merge_sub :: {-# UNPACK #-} !(Subscriber x (DMap k v))

1796− , _merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k Identity))

1823+ , _merge_accumRef :: {-# UNPACK #-} !(IORef (DMap k v))

1797 }

1824 }

1798

1825

1799−invalidateMergeHeight :: Merge x k s -> IO ()

1826+invalidateMergeHeight :: Merge x k v s -> IO ()

1800invalidateMergeHeight m = invalidateMergeHeight' (_merge_heightRef m) (_merge_sub m)

1827invalidateMergeHeight m = invalidateMergeHeight' (_merge_heightRef m) (_merge_sub m)

1801

1828

1802invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()

1829invalidateMergeHeight' :: IORef Height -> Subscriber x a -> IO ()

@@ -1806,8 +1833,7 @@ invalidateMergeHeight' heightRef sub = do

1806 writeIORef heightRef $! invalidHeight

1833 writeIORef heightRef $! invalidHeight

1807 subscriberInvalidateHeight sub oldHeight

1834 subscriberInvalidateHeight sub oldHeight

1808

1835

1809−

1810−revalidateMergeHeight :: Merge x k s -> IO ()

1836+revalidateMergeHeight :: Merge x k v s -> IO ()

1811revalidateMergeHeight m = do

1837revalidateMergeHeight m = do

1812 currentHeight <- readIORef $ _merge_heightRef m

1838 currentHeight <- readIORef $ _merge_heightRef m

1813 when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check

1839 when (currentHeight == invalidHeight) $ do -- revalidateMergeHeight may be called multiple times; perhaps the's a way to finesse it to avoid this check

@@ -1823,19 +1849,19 @@ revalidateMergeHeight m = do

1823 subscriberRecalculateHeight (_merge_sub m) height

1849 subscriberRecalculateHeight (_merge_sub m) height

1824 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"

1850 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"

1825

1851

1826−scheduleMergeSelf :: HasSpiderTimeline x => Merge x k s -> Height -> EventM x ()

1852+scheduleMergeSelf :: HasSpiderTimeline x => Merge x k v s -> Height -> EventM x ()

1827scheduleMergeSelf m height = scheduleMerge' height (_merge_heightRef m) $ do

1853scheduleMergeSelf m height = scheduleMerge' height (_merge_heightRef m) $ do

1828 vals <- liftIO $ readIORef $ _merge_accumRef m

1854 vals <- liftIO $ readIORef $ _merge_accumRef m

1829 liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us, it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers

1855 liftIO $ writeIORef (_merge_accumRef m) $! DMap.empty -- Once we're done with this, we can clear it immediately, because if there's a cacheEvent in front of us, it'll handle subsequent subscribers, and if not, we won't get subsequent subscribers

1830 --TODO: Assert that m is not empty

1856 --TODO: Assert that m is not empty

1831 subscriberPropagate (_merge_sub m) vals

1857 subscriberPropagate (_merge_sub m) vals

1832

1858

1833−mergeSubscriber :: forall x k s a. (HasSpiderTimeline x, GCompare k) => Merge x k s -> EventM x (k a) -> Subscriber x a

1859+mergeSubscriber :: forall x k v s a. (HasSpiderTimeline x, GCompare k) => Merge x k v s -> EventM x (k a) -> Subscriber x (v a)

1834mergeSubscriber m getKey = Subscriber

1860mergeSubscriber m getKey = Subscriber

1835 { subscriberPropagate = \a -> do

1861 { subscriberPropagate = \a -> do

1836 oldM <- liftIO $ readIORef $ _merge_accumRef m

1862 oldM <- liftIO $ readIORef $ _merge_accumRef m

1837 k <- getKey

1863 k <- getKey

1838− let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k (Identity a) oldM

1864+ let newM = DMap.insertWith (error $ "Same key fired multiple times for Merge") k a oldM

1839 tracePropagate (Proxy :: Proxy x) $ " DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)

1865 tracePropagate (Proxy :: Proxy x) $ " DMap.size oldM = " <> show (DMap.size oldM) <> "; DMap.size newM = " <> show (DMap.size newM)

1840 liftIO $ writeIORef (_merge_accumRef m) $! newM

1866 liftIO $ writeIORef (_merge_accumRef m) $! newM

1841 when (DMap.null oldM) $ do -- Only schedule the firing once

1867 when (DMap.null oldM) $ do -- Only schedule the firing once

@@ -1850,7 +1876,7 @@ mergeSubscriber m getKey = Subscriber

1850 else liftIO $ do

1876 else liftIO $ do

1851#ifdef DEBUG_CYCLES

1877#ifdef DEBUG_CYCLES

1852 nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed

1878 nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed

1853− stacks <- forM nodesInvolvedInCycle $ \(Some.This es) -> whoCreatedEventSubscribed es

1879+ stacks <- forM nodesInvolvedInCycle $ \(Some es) -> whoCreatedEventSubscribed es

1854 let cycleInfo = ":\n" <> drawForest (listsToForest stacks)

1880 let cycleInfo = ":\n" <> drawForest (listsToForest stacks)

1855#else

1881#else

1856 let cycleInfo = ""

1882 let cycleInfo = ""

@@ -1866,7 +1892,7 @@ mergeSubscriber m getKey = Subscriber

1866 }

1892 }

1867

1893

1868--TODO: Be able to run as much of this as possible promptly

1894--TODO: Be able to run as much of this as possible promptly

1869−updateMerge :: (HasSpiderTimeline x, GCompare k) => Merge x k s -> MergeUpdateFunc k x p s -> p -> SomeMergeUpdate x

1895+updateMerge :: (HasSpiderTimeline x, GCompare k) => Merge x k v s -> MergeUpdateFunc k v x p s -> p -> SomeMergeUpdate x

1870updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m) (revalidateMergeHeight m)

1896updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m) (revalidateMergeHeight m)

1871 where updateMe = do

1897 where updateMe = do

1872 oldParents <- liftIO $ readIORef $ _merge_parentsRef m

1898 oldParents <- liftIO $ readIORef $ _merge_parentsRef m

@@ -1874,9 +1900,10 @@ updateMerge m updateFunc p = SomeMergeUpdate updateMe (invalidateMergeHeight m)

1874 liftIO $ writeIORef (_merge_parentsRef m) $! newParents

1900 liftIO $ writeIORef (_merge_parentsRef m) $! newParents

1875 return subscriptionsToKill

1901 return subscriptionsToKill

1876

1902

1877−{-# INLINE mergeCheap' #-}

1903+{-# INLINE mergeGCheap' #-}

1904+mergeGCheap' :: forall k v x p s q. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k q)

1878−mergeCheap' :: forall k x p s. (HasSpiderTimeline x, GCompare k, PatchTarget p ~ DMap k (Event x)) => MergeInitFunc k x s -> MergeUpdateFunc k x p s -> MergeDestroyFunc k s -> Dynamic x p -> Event x (DMap k Identity)

1905+ => MergeInitFunc k v q x s -> MergeUpdateFunc k v x p s -> MergeDestroyFunc k s -> Dynamic x p -> Event x (DMap k v)

1879−mergeCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do

1906+mergeGCheap' getInitialSubscribers updateFunc destroy d = Event $ \sub -> do

1880 initialParents <- readBehaviorUntracked $ dynamicCurrent d

1907 initialParents <- readBehaviorUntracked $ dynamicCurrent d

1881 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"

1908 accumRef <- liftIO $ newIORef $ error "merge: accumRef not yet initialized"

1882 heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"

1909 heightRef <- liftIO $ newIORef $ error "merge: heightRef not yet initialized"

@@ -2025,14 +2052,16 @@ mergeIntCheap d = Event $ \sub -> do

2025 )

2052 )

2026

2053

2027newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a }

2054newtype EventSelector x k = EventSelector { select :: forall a. k a -> Event x a }

2055+newtype EventSelectorG x k v = EventSelectorG { selectG :: forall a. k a -> Event x (v a) }

2028

2056

2029−fan :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k Identity) -> EventSelector x k

2057+fanG :: (HasSpiderTimeline x, GCompare k) => Event x (DMap k v) -> EventSelectorG x k v

2030−fan e =

2058+fanG e = unsafePerformIO $ do

2059+ ref <- newIORef Nothing

2031 let f = Fan

2060 let f = Fan

2032 { fanParent = e

2061 { fanParent = e

2033− , fanSubscribed = unsafeNewIORef e Nothing

2062+ , fanSubscribed = ref

2034 }

2063 }

2035− in EventSelector $ \k -> eventFan k f

2064+ pure $ EventSelectorG $ \k -> eventFan k f

2036

2065

2037runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()

2066runHoldInits :: HasSpiderTimeline x => IORef [SomeHoldInit x] -> IORef [SomeDynInit x] -> IORef [SomeMergeInit x] -> EventM x ()

2038runHoldInits holdInitRef dynInitRef mergeInitRef = do

2067runHoldInits holdInitRef dynInitRef mergeInitRef = do

@@ -2093,11 +2122,11 @@ runFrame a = SpiderHost $ do

2093 return result

2122 return result

2094 result <- runEventM go

2123 result <- runEventM go

2095 toClear <- readIORef $ eventEnvClears env

2124 toClear <- readIORef $ eventEnvClears env

2096− forM_ toClear $ \(SomeClear ref) -> {-# SCC "clear" #-} writeIORef ref Nothing

2125+ forM_ toClear $ \(Some (Clear ref)) -> {-# SCC "clear" #-} writeIORef ref Nothing

2097 toClearInt <- readIORef $ eventEnvIntClears env

2126 toClearInt <- readIORef $ eventEnvIntClears env

2098− forM_ toClearInt $ \(SomeIntClear ref) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty

2127+ forM_ toClearInt $ \(Some (IntClear ref)) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty

2099 toClearRoot <- readIORef $ eventEnvRootClears env

2128 toClearRoot <- readIORef $ eventEnvRootClears env

2100− forM_ toClearRoot $ \(SomeRootClear ref) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty

2129+ forM_ toClearRoot $ \(Some (RootClear ref)) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty

2101 toAssign <- readIORef $ eventEnvAssignments env

2130 toAssign <- readIORef $ eventEnvAssignments env

2102 toReconnectRef <- newIORef []

2131 toReconnectRef <- newIORef []

2103 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env

2132 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env

@@ -2457,9 +2486,9 @@ unsafeNewSpiderTimelineEnv = do

2457

2486

2458-- | Create a new SpiderTimelineEnv

2487-- | Create a new SpiderTimelineEnv

2459newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2488newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2460−newSpiderTimeline = withSpiderTimeline (pure . Some.This)

2489+newSpiderTimeline = withSpiderTimeline (pure . Some)

2461

2490

2462−data LocalSpiderTimeline x s

2491+data LocalSpiderTimeline (x :: Type) s

2463

2492

2464instance Reifies s (SpiderTimelineEnv x) =>

2493instance Reifies s (SpiderTimelineEnv x) =>

2465 HasSpiderTimeline (LocalSpiderTimeline x s) where

2494 HasSpiderTimeline (LocalSpiderTimeline x s) where

@@ -2477,11 +2506,11 @@ withSpiderTimeline k = do

2477 env <- unsafeNewSpiderTimelineEnv

2506 env <- unsafeNewSpiderTimelineEnv

2478 reify env $ \s -> k $ localSpiderTimeline s env

2507 reify env $ \s -> k $ localSpiderTimeline s env

2479

2508

2480−newtype SpiderPullM x a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2509+newtype SpiderPullM (x :: Type) a = SpiderPullM (BehaviorM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2481

2510

2482type ComputeM = EventM

2511type ComputeM = EventM

2483

2512

2484−newtype SpiderPushM x a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2513+newtype SpiderPushM (x :: Type) a = SpiderPushM (ComputeM x a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)

2485

2514

2486instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2515instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2487 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}

2516 {-# SPECIALIZE instance R.Reflex (SpiderTimeline Global) #-}

@@ -2501,10 +2530,15 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2501 pushCheap f = SpiderEvent . pushCheap (coerce f) . unSpiderEvent

2530 pushCheap f = SpiderEvent . pushCheap (coerce f) . unSpiderEvent

2502 {-# INLINABLE pull #-}

2531 {-# INLINABLE pull #-}

2503 pull = SpiderBehavior . pull . coerce

2532 pull = SpiderBehavior . pull . coerce

2504− {-# INLINABLE merge #-}

2533+ {-# INLINABLE fanG #-}

2505− merge = SpiderEvent . merge . dynamicConst . (coerce :: DMap k (R.Event (SpiderTimeline x)) -> DMap k (Event x))

2506− {-# INLINABLE fan #-}

2507− fan e = R.EventSelector $ SpiderEvent . select (fan (unSpiderEvent e))

2534+ fanG e = R.EventSelectorG $ SpiderEvent . selectG (fanG (unSpiderEvent e))

2535+ {-# INLINABLE mergeG #-}

2536+ mergeG

2537+ :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k

2538+ => (forall a. q a -> R.Event (SpiderTimeline x) (v a))

2539+ -> DMap k q

2540+ -> R.Event (SpiderTimeline x) (DMap k v)

2541+ mergeG nt = SpiderEvent . mergeG (unSpiderEvent #. nt) . dynamicConst

2508 {-# INLINABLE switch #-}

2542 {-# INLINABLE switch #-}

2509 switch = SpiderEvent . switch . (coerce :: Behavior x (R.Event (SpiderTimeline x) a) -> Behavior x (Event x a)) . unSpiderBehavior

2543 switch = SpiderEvent . switch . (coerce :: Behavior x (R.Event (SpiderTimeline x) a) -> Behavior x (Event x a)) . unSpiderBehavior

2510 {-# INLINABLE coincidence #-}

2544 {-# INLINABLE coincidence #-}

@@ -2517,10 +2551,10 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2517 unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'

2551 unsafeBuildDynamic readV0 v' = SpiderDynamic $ dynamicDynIdentity $ unsafeBuildDynamic (coerce readV0) $ coerce $ unSpiderEvent v'

2518 {-# INLINABLE unsafeBuildIncremental #-}

2552 {-# INLINABLE unsafeBuildIncremental #-}

2519 unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv

2553 unsafeBuildIncremental readV0 dv = SpiderIncremental $ dynamicDyn $ unsafeBuildDynamic (coerce readV0) $ unSpiderEvent dv

2520− {-# INLINABLE mergeIncremental #-}

2554+ {-# INLINABLE mergeIncrementalG #-}

2521− mergeIncremental = SpiderEvent . merge . (unsafeCoerce :: Dynamic x (PatchDMap k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMap k (Event x))) . unSpiderIncremental

2555+ mergeIncrementalG nt = SpiderEvent #. mergeG (coerce #. nt) .# unSpiderIncremental

2522− {-# INLINABLE mergeIncrementalWithMove #-}

2556+ {-# INLINABLE mergeIncrementalWithMoveG #-}

2523− mergeIncrementalWithMove = SpiderEvent . mergeWithMove . (unsafeCoerce :: Dynamic x (PatchDMapWithMove k (R.Event (SpiderTimeline x))) -> Dynamic x (PatchDMapWithMove k (Event x))) . unSpiderIncremental

2557+ mergeIncrementalWithMoveG nt = SpiderEvent #. mergeWithMove (coerce #. nt) .# unSpiderIncremental

2524 {-# INLINABLE currentIncremental #-}

2558 {-# INLINABLE currentIncremental #-}

2525 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental

2559 currentIncremental = SpiderBehavior . dynamicCurrent . unSpiderIncremental

2526 {-# INLINABLE updatedIncremental #-}

2560 {-# INLINABLE updatedIncremental #-}

@@ -2558,7 +2592,7 @@ instance MonadAtomicRef (EventM x) where

2558 atomicModifyRef r f = liftIO $ atomicModifyRef r f

2592 atomicModifyRef r f = liftIO $ atomicModifyRef r f

2559

2593

2560-- | The monad for actions that manipulate a Spider timeline identified by @x@

2594-- | The monad for actions that manipulate a Spider timeline identified by @x@

2561−newtype SpiderHost x a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2595+newtype SpiderHost (x :: Type) a = SpiderHost { unSpiderHost :: IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2562

2596

2563instance Monad (SpiderHost x) where

2597instance Monad (SpiderHost x) where

2564 {-# INLINABLE (>>=) #-}

2598 {-# INLINABLE (>>=) #-}

@@ -2580,7 +2614,7 @@ runSpiderHost (SpiderHost a) = a

2580runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a

2614runSpiderHostForTimeline :: SpiderHost x a -> SpiderTimelineEnv x -> IO a

2581runSpiderHostForTimeline (SpiderHost a) _ = a

2615runSpiderHostForTimeline (SpiderHost a) _ = a

2582

2616

2583−newtype SpiderHostFrame x a = SpiderHostFrame { runSpiderHostFrame :: EventM x a }

2617+newtype SpiderHostFrame (x :: Type) a = SpiderHostFrame { runSpiderHostFrame :: EventM x a }

2584 deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2618 deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)

2585

2619

2586instance Monad (SpiderHostFrame x) where

2620instance Monad (SpiderHostFrame x) where

src/Reflex/Workflow.hs+1−1

@@ -41,7 +41,7 @@ workflowView w0 = do

41 eReplace <- fmap switch $ hold never $ fmap snd eResult

42 return $ fmap fst eResult

44−-- | Map a function over a 'Workflow', possibly changing the resturn type.

44+-- | Map a function over a 'Workflow', possibly changing the return type.

45mapWorkflow :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

46mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)

test/GC.hs+4−3

@@ -27,6 +27,7 @@ import qualified Reflex.Spider.Internal as S

28import System.Exit

29import System.Mem

30+import Data.Coerce

31main :: IO ()

32main :: IO ()

32main = do

33main = do

@@ -46,7 +47,7 @@ hostPerf ref = S.runSpiderHost $ do

46 eventToPerform <- Host.runHostFrame $ do

47 eventToPerform <- Host.runHostFrame $ do

47 (reqMap :: S.Event S.Global (DMap (Const2 Int (DMap Tell (S.SpiderHostFrame S.Global))) Identity))

48 (reqMap :: S.Event S.Global (DMap (Const2 Int (DMap Tell (S.SpiderHostFrame S.Global))) Identity))

48 <- S.SpiderHostFrame

49 <- S.SpiderHostFrame

49− $ fmap ( S.merge

50+ $ fmap ( S.mergeG coerce

50 . S.dynamicHold)

51 . S.dynamicHold)

51 $ S.hold DMap.empty

52 $ S.hold DMap.empty

52 -- Construct a new heap object for the subscriber, invalidating any weak references to the subscriber if they are not retained

53 -- Construct a new heap object for the subscriber, invalidating any weak references to the subscriber if they are not retained

@@ -55,8 +56,8 @@ hostPerf ref = S.runSpiderHost $ do

55 { S.subscriberPropagate = S.subscriberPropagate sub

56 { S.subscriberPropagate = S.subscriberPropagate sub

56 }

57 }

57 return (s, o))

58 return (s, o))

58− $ runIdentity <$> S.select

59+ $ runIdentity . runIdentity <$> S.selectG

59− (S.fan $ S.pushCheap (return . Just . mapKeyValuePairsMonotonic (\(t :=> e) -> WrapArg t :=> Identity e)) response)

60+ (S.fanG $ S.pushCheap (return . Just . mapKeyValuePairsMonotonic (\(t :=> e) -> WrapArg t :=> Identity e)) response)

60 (WrapArg Request)

61 (WrapArg Request)

61 return $ alignWith (mergeThese (<>))

62 return $ alignWith (mergeThese (<>))

62 (flip S.pushCheap eadd $ \_ -> return $ Just $ DMap.singleton Request $ do

63 (flip S.pushCheap eadd $ \_ -> return $ Just $ DMap.singleton Request $ do