3c5d146 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

Merge commit 'bccbe42' into patchmapwithmove2

3c5d146Ryan Trinkle7 years ago

ChangeLog.md+3−2

compare with develop

unifiedsplit

@@ -1,9 +1,10 @@

1# Revision history for reflex

3−## Unreleased

3+## 0.6.2.0

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

6* Add `Reflex.Query.Base.mapQueryT`. See that module for documentation

5* Add `Reflex.Query.Base.mapQueryT`. See that module for documentation

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

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

8## 0.6.1.0

9## 0.6.1.0

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.0";

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

16 libraryHaskellDepends = [

17 base bifunctors containers dependent-map dependent-sum

reflex.cabal+6−6

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

1Name: reflex

2−Version: 0.6.1

2+Version: 0.6.2.0

3Synopsis: Higher-order Functional Reactive Programming

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

5License: BSD3

@@ -44,10 +44,10 @@ library

44 base >= 4.9 && < 4.13,

45 bifunctors >= 5.2 && < 5.6,

46 comonad,

47− constraints-extras,

47+ constraints-extras >= 0.2,

48 containers >= 0.5 && < 0.7,

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

50− dependent-map >= 0.2.4 && < 0.4,

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

51 exception-transformers == 0.4.*,

52 lens >= 4.7 && < 5,

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

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

135 if flag(use-template-haskell)

136 cpp-options: -DUSE_TEMPLATE_HASKELL

137 build-depends:

138− dependent-sum >= 0.3 && < 0.7,

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

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

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

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

141 template-haskell >= 2.9 && < 2.15

142 exposed-modules:

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

144 other-extensions: TemplateHaskell

145 else

146 build-depends:

147− dependent-sum >= 0.4 && < 0.7

147+ dependent-sum == 0.6.*

148

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

150 cpp-options: -DGHCJS_FAST_WEAK

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

@@ -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)

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

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

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

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

123weakenDMapWith :: (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'

124−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

125

124

126--------------------------------------------------------------------------------

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

127-- WrapArg

126-- WrapArg

src/Reflex/Class.hs+8−9

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

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

194import Data.Map (Map)

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

196−import Data.Some (Some)

196+import Data.Some (Some(Some))

197−import qualified Data.Some as Some

198import Data.String

197import Data.String

199import Data.These

198import Data.These

200import Data.Type.Coercion

199import Data.Type.Coercion

@@ -257,10 +256,10 @@ class ( MonadHold t (PushM t)

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

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

258 -- that are occurring simultaneously

257 -- that are occurring simultaneously

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

258 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

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

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

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

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

262− -- child events

261+ -- 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

262+ fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k

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

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

265 -- 'Event' occurs

264 -- 'Event' occurs

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

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

@@ -1155,9 +1154,9 @@ factorEvent

1155 -> Event t (DSum k v)

1154 -> Event t (DSum k v)

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

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

1157factorEvent k0 kv' = do

1156factorEvent k0 kv' = do

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

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

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

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

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

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

1161 Just Refl -> return Nothing

1160 Just Refl -> return Nothing

1162 Nothing -> do

1161 Nothing -> do

1163 newInner <- filterEventKey newKey kv'

1162 newInner <- filterEventKey newKey kv'

@@ -1367,7 +1366,7 @@ mapAccumMaybeB

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

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

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

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

1369

1368

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

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

1371{-# INLINE mapAccumMaybeMB #-}

1370{-# INLINE mapAccumMaybeMB #-}

1372mapAccumMaybeMB :: (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)

1371mapAccumMaybeMB :: (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)

1373mapAccumMaybeMB f z e = do

1372mapAccumMaybeMB f z e = do

src/Reflex/Patch/DMapWithMove.hs+5−8

@@ -22,7 +22,6 @@ import qualified Reflex.Patch.MapWithMove as MapWithMove

22import Data.Constraint.Extras

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

24import qualified Data.Dependent.Map as DMap

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

26import Data.Functor.Constant

25import Data.Functor.Constant

27import Data.Functor.Misc

26import Data.Functor.Misc

28import Data.Functor.Product

27import Data.Functor.Product

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

31import qualified Data.Map as Map

30import qualified Data.Map as Map

32import Data.Maybe

31import Data.Maybe

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

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

34−import Data.Some (Some)

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

35−import qualified Data.Some as Some

36import Data.These

34import Data.These

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

@@ -106,9 +104,8 @@ validationErrorsForPatchDMapWithMove m =

106 unbalancedMove _ = Nothing

104 unbalancedMove _ = Nothing

107

105

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

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

109−-- TODO: Get rid of EqTag constraint once dependent-map > 0.2.4.0, which drops this requirement, is released

110−instance (GEq k, Has' Eq k (NodeInfo k v), 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

111− PatchDMapWithMove a == PatchDMapWithMove b = a == b

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

112

109

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

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

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

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

313 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of

310 { MapWithMove._nodeInfo_from = case _nodeInfo_from ni of

314 From_Insert v -> MapWithMove.From_Insert $ f v

311 From_Insert v -> MapWithMove.From_Insert $ f v

315 From_Delete -> MapWithMove.From_Delete

312 From_Delete -> MapWithMove.From_Delete

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

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

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

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

318 }

315 }

319

316

320-- |"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/Query/Base.hs+5−6

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

39import qualified Data.Map as Map

40import Data.Monoid ((<>))

41import qualified Data.Semigroup as S

42−import Data.Some (Some)

42+import Data.Some (Some(Some))

43−import qualified Data.Some as Some

44import Data.These

43import Data.These

46import Reflex.Class

45import Reflex.Class

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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+32−33

@@ -74,8 +74,7 @@ import Data.Tree (Forest, Tree (..), drawForest)

74import Data.FastWeakBag (FastWeakBag)

75import qualified Data.FastWeakBag as FastWeakBag

76import Data.Reflection

77−import Data.Some (Some)

77+import Data.Some (Some(Some))

78−import qualified Data.Some as Some

79import Data.Type.Coercion

78import Data.Type.Coercion

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

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

81import qualified Data.WeakBag as WeakBag

80import qualified Data.WeakBag as WeakBag

@@ -582,7 +581,7 @@ eventSubscribedFan !subscribed = EventSubscribed

582 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed

581 { eventSubscribedHeightRef = eventSubscribedHeightRef $ _eventSubscription_subscribed $ fanSubscribedParent subscribed

583 , eventSubscribedRetained = toAny subscribed

582 , eventSubscribedRetained = toAny subscribed

584#ifdef DEBUG_CYCLES

583#ifdef DEBUG_CYCLES

585− , eventSubscribedGetParents = return [Some.This $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]

584+ , eventSubscribedGetParents = return [Some $ _eventSubscription_subscribed $ fanSubscribedParent subscribed]

586 , eventSubscribedHasOwnHeightRef = False

585 , eventSubscribedHasOwnHeightRef = False

587 , eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed

586 , eventSubscribedWhoCreated = whoCreatedIORef $ fanSubscribedCachedSubscribed subscribed

588#endif

587#endif

@@ -595,7 +594,7 @@ eventSubscribedSwitch !subscribed = EventSubscribed

595#ifdef DEBUG_CYCLES

594#ifdef DEBUG_CYCLES

596 , eventSubscribedGetParents = do

595 , eventSubscribedGetParents = do

597 s <- readIORef $ switchSubscribedCurrentParent subscribed

596 s <- readIORef $ switchSubscribedCurrentParent subscribed

598− return [Some.This $ _eventSubscription_subscribed s]

597+ return [Some $ _eventSubscription_subscribed s]

599 , eventSubscribedHasOwnHeightRef = True

598 , eventSubscribedHasOwnHeightRef = True

600 , eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed

599 , eventSubscribedWhoCreated = whoCreatedIORef $ switchSubscribedCachedSubscribed subscribed

601#endif

600#endif

@@ -608,8 +607,8 @@ eventSubscribedCoincidence !subscribed = EventSubscribed

608#ifdef DEBUG_CYCLES

607#ifdef DEBUG_CYCLES

609 , eventSubscribedGetParents = do

608 , eventSubscribedGetParents = do

610 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed

609 innerSubscription <- readIORef $ coincidenceSubscribedInnerParent subscribed

611− let outerParent = Some.This $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed

610+ let outerParent = Some $ _eventSubscription_subscribed $ coincidenceSubscribedOuterParent subscribed

612− innerParents = maybeToList $ fmap Some.This innerSubscription

611+ innerParents = maybeToList $ fmap Some innerSubscription

613 return $ outerParent : innerParents

612 return $ outerParent : innerParents

614 , eventSubscribedHasOwnHeightRef = True

613 , eventSubscribedHasOwnHeightRef = True

615 , eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed

614 , eventSubscribedWhoCreated = whoCreatedIORef $ coincidenceSubscribedCachedSubscribed subscribed

@@ -625,13 +624,13 @@ whoCreatedEventSubscribed = eventSubscribedWhoCreated

625

624

626walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]

625walkInvalidHeightParents :: EventSubscribed x -> IO [Some (EventSubscribed x)]

627walkInvalidHeightParents s0 = do

626walkInvalidHeightParents s0 = do

628− subscribers <- flip execStateT mempty $ ($ Some.This s0) $ fix $ \loop (Some.This s) -> do

627+ subscribers <- flip execStateT mempty $ ($ Some s0) $ fix $ \loop (Some s) -> do

629 h <- liftIO $ readIORef $ eventSubscribedHeightRef s

628 h <- liftIO $ readIORef $ eventSubscribedHeightRef s

630 when (h == invalidHeight) $ do

629 when (h == invalidHeight) $ do

631 when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed

630 when (eventSubscribedHasOwnHeightRef s) $ liftIO $ writeIORef (eventSubscribedHeightRef s) $! invalidHeightBeingTraversed

632− modify (Some.This s :)

631+ modify (Some s :)

633 mapM_ loop =<< liftIO (eventSubscribedGetParents s)

632 mapM_ loop =<< liftIO (eventSubscribedGetParents s)

634− forM_ subscribers $ \(Some.This s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight

633+ forM_ subscribers $ \(Some s) -> writeIORef (eventSubscribedHeightRef s) $! invalidHeight

635 return subscribers

634 return subscribers

636#endif

635#endif

637

636

@@ -659,7 +658,7 @@ behaviorPull !p = Behavior $ do

659 val <- liftIO $ readIORef $ pullValue p

658 val <- liftIO $ readIORef $ pullValue p

660 case val of

659 case val of

661 Just subscribed -> do

660 Just subscribed -> do

662− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))

661+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))

663 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))

662 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (pullSubscribedInvalidators subscribed) (wi:))

664 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed

663 liftIO $ touch $ pullSubscribedOwnInvalidator subscribed

665 return $ pullSubscribedValue subscribed

664 return $ pullSubscribedValue subscribed

@@ -678,7 +677,7 @@ behaviorPull !p = Behavior $ do

678 , pullSubscribedParents = parents

677 , pullSubscribedParents = parents

679 }

678 }

680 liftIO $ writeIORef (pullValue p) $ Just subscribed

679 liftIO $ writeIORef (pullValue p) $ Just subscribed

681− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedPull subscribed) :))

680+ askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (Some (BehaviorSubscribedPull subscribed)) :))

682 return a

681 return a

683

682

684behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)

683behaviorDyn :: Patch p => Dyn x p -> Behavior x (PatchTarget p)

@@ -689,7 +688,7 @@ readHoldTracked :: Hold x p -> BehaviorM x (PatchTarget p)

689readHoldTracked h = do

688readHoldTracked h = do

690 result <- liftIO $ readIORef $ holdValue h

689 result <- liftIO $ readIORef $ holdValue h

691 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))

690 askInvalidator >>= mapM_ (\wi -> liftIO $ modifyIORef' (holdInvalidators h) (wi:))

692− askParentsRef >>= mapM_ (\r -> liftIO $ modifyIORef' r (SomeBehaviorSubscribed (BehaviorSubscribedHold h) :))

691+ 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

692 liftIO $ touch h -- Otherwise, if this gets inlined enough, the hold's parent reference may get collected

694 return result

693 return result

695

694

@@ -782,9 +781,9 @@ data EventEnv x

782 , eventEnvDynInits :: !(IORef [SomeDynInit x])

781 , eventEnvDynInits :: !(IORef [SomeDynInit x])

783 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])

782 , eventEnvMergeUpdates :: !(IORef [SomeMergeUpdate x])

784 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe

783 , eventEnvMergeInits :: !(IORef [SomeMergeInit x]) -- Needed for Subscribe

785− , eventEnvClears :: !(IORef [SomeClear]) -- Needed for Subscribe

784+ , eventEnvClears :: !(IORef [Some Clear]) -- Needed for Subscribe

786− , eventEnvIntClears :: !(IORef [SomeIntClear])

785+ , eventEnvIntClears :: !(IORef [Some IntClear])

787− , eventEnvRootClears :: !(IORef [SomeRootClear])

786+ , eventEnvRootClears :: !(IORef [Some RootClear])

788 , eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe

787 , eventEnvCurrentHeight :: !(IORef Height) -- Needed for Subscribe

789 , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe

788 , eventEnvResetCoincidences :: !(IORef [SomeResetCoincidence x]) -- Needed for Subscribe

790 , eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))

789 , eventEnvDelayedMerges :: !(IORef (IntMap [EventM x ()]))

@@ -856,29 +855,29 @@ putCurrentHeight h = do

856 heightRef <- asksEventEnv eventEnvCurrentHeight

855 heightRef <- asksEventEnv eventEnvCurrentHeight

857 liftIO $ writeIORef heightRef $! h

856 liftIO $ writeIORef heightRef $! h

858

857

859−instance HasSpiderTimeline x => Defer SomeClear (EventM x) where

858+instance HasSpiderTimeline x => Defer (Some Clear) (EventM x) where

860 {-# INLINE getDeferralQueue #-}

859 {-# INLINE getDeferralQueue #-}

861 getDeferralQueue = asksEventEnv eventEnvClears

860 getDeferralQueue = asksEventEnv eventEnvClears

862

861

863{-# INLINE scheduleClear #-}

862{-# INLINE scheduleClear #-}

864−scheduleClear :: Defer SomeClear m => IORef (Maybe a) -> m ()

863+scheduleClear :: Defer (Some Clear) m => IORef (Maybe a) -> m ()

865−scheduleClear r = defer $ SomeClear r

864+scheduleClear r = defer $ Some $ Clear r

866

865

867−instance HasSpiderTimeline x => Defer SomeIntClear (EventM x) where

866+instance HasSpiderTimeline x => Defer (Some IntClear) (EventM x) where

868 {-# INLINE getDeferralQueue #-}

867 {-# INLINE getDeferralQueue #-}

869 getDeferralQueue = asksEventEnv eventEnvIntClears

868 getDeferralQueue = asksEventEnv eventEnvIntClears

870

869

871{-# INLINE scheduleIntClear #-}

870{-# INLINE scheduleIntClear #-}

872−scheduleIntClear :: Defer SomeIntClear m => IORef (IntMap a) -> m ()

871+scheduleIntClear :: Defer (Some IntClear) m => IORef (IntMap a) -> m ()

873−scheduleIntClear r = defer $ SomeIntClear r

872+scheduleIntClear r = defer $ Some $ IntClear r

874

873

875−instance HasSpiderTimeline x => Defer SomeRootClear (EventM x) where

874+instance HasSpiderTimeline x => Defer (Some RootClear) (EventM x) where

876 {-# INLINE getDeferralQueue #-}

875 {-# INLINE getDeferralQueue #-}

877 getDeferralQueue = asksEventEnv eventEnvRootClears

876 getDeferralQueue = asksEventEnv eventEnvRootClears

878

877

879{-# INLINE scheduleRootClear #-}

878{-# INLINE scheduleRootClear #-}

880−scheduleRootClear :: Defer SomeRootClear m => IORef (DMap k Identity) -> m ()

879+scheduleRootClear :: Defer (Some RootClear) m => IORef (DMap k Identity) -> m ()

881−scheduleRootClear r = defer $ SomeRootClear r

880+scheduleRootClear r = defer $ Some $ RootClear r

882

881

883instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where

882instance HasSpiderTimeline x => Defer (SomeResetCoincidence x) (EventM x) where

884 {-# INLINE getDeferralQueue #-}

883 {-# INLINE getDeferralQueue #-}

@@ -951,7 +950,7 @@ data BehaviorSubscribed x a

951 = forall p. BehaviorSubscribedHold (Hold x p)

950 = forall p. BehaviorSubscribedHold (Hold x p)

952 | BehaviorSubscribedPull (PullSubscribed x a)

951 | BehaviorSubscribedPull (PullSubscribed x a)

953

952

954−data SomeBehaviorSubscribed x = forall a. SomeBehaviorSubscribed (BehaviorSubscribed x a)

953+newtype SomeBehaviorSubscribed x = SomeBehaviorSubscribed (Some (BehaviorSubscribed x))

955

954

956--type role PullSubscribed representational

955--type role PullSubscribed representational

957data PullSubscribed x a

956data PullSubscribed x a

@@ -1259,11 +1258,11 @@ scheduleMerge' initialHeight heightRef a = scheduleMerge initialHeight $ do

1259 GT -> scheduleMerge' height heightRef a -- The height has been increased (by a coincidence event; TODO: is this the only way?)

1258 GT -> scheduleMerge' height heightRef a -- The height has been increased (by a coincidence event; TODO: is this the only way?)

1260 EQ -> a

1259 EQ -> a

1261

1260

1262−data SomeClear = forall a. SomeClear {-# UNPACK #-} !(IORef (Maybe a))

1261+newtype Clear a = Clear (IORef (Maybe a))

1263

1262

1264−data SomeIntClear = forall a. SomeIntClear {-# UNPACK #-} !(IORef (IntMap a))

1263+newtype IntClear a = IntClear (IORef (IntMap a))

1265

1264

1266−data SomeRootClear = forall k. SomeRootClear {-# UNPACK #-} !(IORef (DMap k Identity))

1265+newtype RootClear k = RootClear (IORef (DMap k Identity))

1267

1266

1268data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a

1267data SomeAssignment x = forall a. SomeAssignment {-# UNPACK #-} !(IORef a) {-# UNPACK #-} !(IORef [Weak (Invalidator x)]) a

1269

1268

@@ -1853,7 +1852,7 @@ mergeSubscriber m getKey = Subscriber

1853 else liftIO $ do

1852 else liftIO $ do

1854#ifdef DEBUG_CYCLES

1853#ifdef DEBUG_CYCLES

1855 nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed

1854 nodesInvolvedInCycle <- walkInvalidHeightParents $ eventSubscribedMerge subscribed

1856− stacks <- forM nodesInvolvedInCycle $ \(Some.This es) -> whoCreatedEventSubscribed es

1855+ stacks <- forM nodesInvolvedInCycle $ \(Some es) -> whoCreatedEventSubscribed es

1857 let cycleInfo = ":\n" <> drawForest (listsToForest stacks)

1856 let cycleInfo = ":\n" <> drawForest (listsToForest stacks)

1858#else

1857#else

1859 let cycleInfo = ""

1858 let cycleInfo = ""

@@ -2096,11 +2095,11 @@ runFrame a = SpiderHost $ do

2096 return result

2095 return result

2097 result <- runEventM go

2096 result <- runEventM go

2098 toClear <- readIORef $ eventEnvClears env

2097 toClear <- readIORef $ eventEnvClears env

2099− forM_ toClear $ \(SomeClear ref) -> {-# SCC "clear" #-} writeIORef ref Nothing

2098+ forM_ toClear $ \(Some (Clear ref)) -> {-# SCC "clear" #-} writeIORef ref Nothing

2100 toClearInt <- readIORef $ eventEnvIntClears env

2099 toClearInt <- readIORef $ eventEnvIntClears env

2101− forM_ toClearInt $ \(SomeIntClear ref) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty

2100+ forM_ toClearInt $ \(Some (IntClear ref)) -> {-# SCC "intClear" #-} writeIORef ref $! IntMap.empty

2102 toClearRoot <- readIORef $ eventEnvRootClears env

2101 toClearRoot <- readIORef $ eventEnvRootClears env

2103− forM_ toClearRoot $ \(SomeRootClear ref) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty

2102+ forM_ toClearRoot $ \(Some (RootClear ref)) -> {-# SCC "rootClear" #-} writeIORef ref $! DMap.empty

2104 toAssign <- readIORef $ eventEnvAssignments env

2103 toAssign <- readIORef $ eventEnvAssignments env

2105 toReconnectRef <- newIORef []

2104 toReconnectRef <- newIORef []

2106 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env

2105 coincidenceInfos <- readIORef $ eventEnvResetCoincidences env

@@ -2460,7 +2459,7 @@ unsafeNewSpiderTimelineEnv = do

2460

2459

2461-- | Create a new SpiderTimelineEnv

2460-- | Create a new SpiderTimelineEnv

2462newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2461newSpiderTimeline :: IO (Some SpiderTimelineEnv)

2463−newSpiderTimeline = withSpiderTimeline (pure . Some.This)

2462+newSpiderTimeline = withSpiderTimeline (pure . Some)

2464

2463

2465data LocalSpiderTimeline x s

2464data LocalSpiderTimeline x s

2466

2465

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)