git.iko.soy/reflex
on develop help sign in
Massive documentation and naming cleanup
7050e5aRyan Trinkle
src/Data/Functor/Misc.hs+103−33
compare with develop
unifiedsplit
@@ -8,7 +8,27 @@
8{-# LANGUAGE RankNTypes #-}
8{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE StandaloneDeriving #-}
10{-# LANGUAGE StandaloneDeriving #-}
11+-- | This module provides types and functions with no particular theme, but
12+-- which are relevant to the use of 'Functor'-based datastructures like
13+-- 'Data.Dependent.Map.DMap'.
11−module Data.Functor.Misc where
14+module Data.Functor.Misc
15+ ( -- * Const2
16+ Const2 (..)
17+ , dmapToMap
18+ , mapToDMap
19+ -- * WrapArg
20+ , WrapArg (..)
21+ -- * Convenience functions for DMap
22+ , mapWithFunctorToDMap
23+ , combineDMapsWithKey
24+ -- * Deprecated functions
25+ , sequenceDmap
26+ , wrapDMap
27+ , rewrapDMap
28+ , unwrapDMap
29+ , unwrapDMapMaybe
30+ , extractFunctorDMap
31+ ) where
12
32
13import Control.Applicative ((<$>))
33import Control.Applicative ((<$>))
14import Control.Monad.Identity
34import Control.Monad.Identity
@@ -22,19 +42,13 @@ import qualified Data.Map as Map
22import Data.These
42import Data.These
23import Data.Typeable hiding (Refl)
43import Data.Typeable hiding (Refl)
24
44
25−data WrapArg :: (k -> *) -> (k -> *) -> * -> * where
45+--------------------------------------------------------------------------------
26− WrapArg :: f a -> WrapArg g f (g a)
46+-- Const2
27−
47+--------------------------------------------------------------------------------
28−instance GEq f => GEq (WrapArg g f) where
29− geq (WrapArg a) (WrapArg b) = (\Refl -> Refl) <$> geq a b
30−
31−instance GCompare f => GCompare (WrapArg g f) where
32− gcompare (WrapArg a) (WrapArg b) = case gcompare a b of
33− GLT -> GLT
34− GEQ -> GEQ
35− GGT -> GGT
36
48
49+-- | 'Const2' stores a value of a given type 'k' and ensures that a particular
50+-- type 'v' is always given for the last type parameter
37−data Const2 :: * -> * -> * -> * where
51+data Const2 :: * -> x -> x -> * where
38 Const2 :: k -> Const2 k v v
52 Const2 :: k -> Const2 k v v
39 deriving (Typeable)
53 deriving (Typeable)
40
54
@@ -58,13 +72,57 @@ instance Ord k => GCompare (Const2 k v) where
58 EQ -> GEQ
72 EQ -> GEQ
59 GT -> GGT
73 GT -> GGT
60
74
61−{-# INLINE sequenceDmap #-}
75+-- | Convert a 'DMap' to a regular 'Map'
62−sequenceDmap :: (Monad m, GCompare f) => DMap f m -> m (DMap f Identity)
76+dmapToMap :: DMap (Const2 k v) Identity -> Map k v
63−sequenceDmap = DMap.foldrWithKey (\k mv mx -> mx >>= \x -> mv >>= \v -> return $ DMap.insert k (Identity v) x)
77+dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
64− (return DMap.empty)
78+
79+-- | Convert a regular 'Map' to a 'DMap'
80+mapToDMap :: Map k v -> DMap (Const2 k v) Identity
81+mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v) . Map.toAscList
82+
83+-- | Convert a regular 'Map', where the values are already wrapped in a functor,
84+-- to a 'DMap'
85+mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f
86+mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
87+
88+--------------------------------------------------------------------------------
89+-- WrapArg
90+--------------------------------------------------------------------------------
91+
92+-- | 'WrapArg' can be used to tag a value in one functor with a type
93+-- representing another functor. This was primarily used with dependent-map <
94+-- 0.2, in which the value type was not wrapped in a separate functor.
95+data WrapArg :: (k -> *) -> (k -> *) -> * -> * where
96+ WrapArg :: f a -> WrapArg g f (g a)
97+
98+instance GEq f => GEq (WrapArg g f) where
99+ geq (WrapArg a) (WrapArg b) = (\Refl -> Refl) <$> geq a b
100+
101+instance GCompare f => GCompare (WrapArg g f) where
102+ gcompare (WrapArg a) (WrapArg b) = case gcompare a b of
103+ GLT -> GLT
104+ GEQ -> GEQ
105+ GGT -> GGT
106+
107+--------------------------------------------------------------------------------
108+-- Convenience functions for DMap
109+--------------------------------------------------------------------------------
110+
111+-- | Map over all key/value pairs in a 'DMap', potentially altering the key as
112+-- well as the value. The provided function MUST preserve the ordering of the
113+-- keys, or the resulting 'DMap' will be malformed.
114+mapKeyValuePairsMonotonic :: (DSum k v -> DSum k' v') -> DMap k v -> DMap k' v'
115+mapKeyValuePairsMonotonic f = DMap.fromDistinctAscList . map f . DMap.toAscList
65
116
66{-# INLINE combineDMapsWithKey #-}
117{-# INLINE combineDMapsWithKey #-}
118+-- | Union two 'DMap's of different types, yielding another type. Each key that
119+-- is present in either input map will be present in the output.
67−combineDMapsWithKey :: forall f g h i. GCompare f => (forall (a :: *). f a -> These (g a) (h a) -> i a) -> DMap f g -> DMap f h -> DMap f i
120+combineDMapsWithKey :: forall f g h i.
121+ GCompare f
122+ => (forall a. f a -> These (g a) (h a) -> i a)
123+ -> DMap f g
124+ -> DMap f h
125+ -> DMap f i
68combineDMapsWithKey f mg mh = DMap.fromList $ go (DMap.toList mg) (DMap.toList mh)
126combineDMapsWithKey f mg mh = DMap.fromList $ go (DMap.toList mg) (DMap.toList mh)
69 where go :: [DSum f g] -> [DSum f h] -> [DSum f i]
127 where go :: [DSum f g] -> [DSum f h] -> [DSum f i]
70 go [] hs = map (\(hk :=> hv) -> hk :=> f hk (That hv)) hs
128 go [] hs = map (\(hk :=> hv) -> hk :=> f hk (That hv)) hs
@@ -74,26 +132,38 @@ combineDMapsWithKey f mg mh = DMap.fromList $ go (DMap.toList mg) (DMap.toList m
74 GEQ -> (gk :=> f gk (These gv hv)) : go gs' hs'
132 GEQ -> (gk :=> f gk (These gv hv)) : go gs' hs'
75 GGT -> (hk :=> f hk (That hv)) : go gs hs'
133 GGT -> (hk :=> f hk (That hv)) : go gs hs'
76
134
135+--------------------------------------------------------------------------------
136+-- Deprecated functions
137+--------------------------------------------------------------------------------
138+
139+{-# INLINE sequenceDmap #-}
140+{-# DEPRECATED sequenceDmap "Use 'Data.Dependent.Map.traverseWithKey (\\_ t -> fmap Identity t)' instead" #-}
141+-- | Run the actions contained in the 'DMap'
142+sequenceDmap :: Applicative t => DMap f t -> t (DMap f Identity)
143+sequenceDmap = DMap.traverseWithKey $ \_ t -> Identity <$> t
144+
145+{-# DEPRECATED wrapDMap "Use 'Data.Dependent.Map.map (f . runIdentity)' instead" #-}
146+-- | Replace the 'Identity' functor for a 'DMap''s values with a different functor
77wrapDMap :: (forall a. a -> f a) -> DMap k Identity -> DMap k f
147wrapDMap :: (forall a. a -> f a) -> DMap k Identity -> DMap k f
78−wrapDMap f = DMap.mapWithKey $ \_ -> f . runIdentity
148+wrapDMap f = DMap.map $ f . runIdentity
79
149
150+{-# DEPRECATED rewrapDMap "Use 'Data.Dependent.Map.map' instead" #-}
151+-- | Replace one functor for a 'DMap''s values with a different functor
80rewrapDMap :: (forall (a :: *). f a -> g a) -> DMap k f -> DMap k g
152rewrapDMap :: (forall (a :: *). f a -> g a) -> DMap k f -> DMap k g
81−rewrapDMap f = DMap.mapWithKey $ \_ -> f
153+rewrapDMap = DMap.map
82
154
155+{-# DEPRECATED unwrapDMap "Use 'Data.Dependent.Map.map (Identity . f)' instead" #-}
156+-- | Replace one functor for a 'DMap''s values with the 'Identity' functor
83unwrapDMap :: (forall a. f a -> a) -> DMap k f -> DMap k Identity
157unwrapDMap :: (forall a. f a -> a) -> DMap k f -> DMap k Identity
84−unwrapDMap f = DMap.mapWithKey $ \_ -> Identity . f
158+unwrapDMap f = DMap.map $ Identity . f
85−
86−unwrapDMapMaybe :: (forall a. f a -> Maybe a) -> DMap k f -> DMap k Identity
87−unwrapDMapMaybe f m = DMap.fromDistinctAscList [k :=> Identity w | (k :=> v) <- DMap.toAscList m, Just w <- [f v]]
88
159
89−mapToDMap :: Map k v -> DMap (Const2 k v) Identity
160+{-# DEPRECATED unwrapDMapMaybe "Use 'Data.Dependent.Map.mapMaybeWithKey (\\_ a -> fmap Identity $ f a)' instead" #-}
90−mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> Identity v) . Map.toAscList
161+-- | Like 'unwrapDMap', but possibly delete some values from the DMap
91−
162+unwrapDMapMaybe :: GCompare k => (forall a. f a -> Maybe a) -> DMap k f -> DMap k Identity
92−mapWithFunctorToDMap :: Map k (f v) -> DMap (Const2 k v) f
163+unwrapDMapMaybe f = DMap.mapMaybeWithKey $ \_ a -> Identity <$> f a
93−mapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
94
164
165+{-# DEPRECATED extractFunctorDMap "Use 'mapKeyValuePairsMonotonic (\\(Const2 k :=> Identity v) -> Const2 k :=> v)' instead" #-}
166+-- | Eliminate the 'Identity' functor in a 'DMap' and replace it with the
167+-- underlying functor
95extractFunctorDMap :: DMap (Const2 k (f v)) Identity -> DMap (Const2 k v) f
168extractFunctorDMap :: DMap (Const2 k (f v)) Identity -> DMap (Const2 k v) f
96−extractFunctorDMap = DMap.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> Const2 k :=> v) . DMap.toAscList
169+extractFunctorDMap = mapKeyValuePairsMonotonic $ \(Const2 k :=> Identity v) -> Const2 k :=> v
97−
98−dmapToMap :: DMap (Const2 k v) Identity -> Map k v
99−dmapToMap = Map.fromDistinctAscList . map (\(Const2 k :=> Identity v) -> (k, v)) . DMap.toAscList
src/Data/WeakBag.hs+42−5
@@ -1,4 +1,16 @@
1−module Data.WeakBag (WeakBag, WeakBagTicket, empty, singleton, insert, Data.WeakBag.traverse, remove) where
1+-- | This module defines the 'WeakBag' type, which represents a mutable
2+-- collection of items that does not cause the items to be retained in memory.
3+-- This is useful for situations where a value needs to be inspected or modified
4+-- if it is still alive, but can be ignored if it is dead.
5+module Data.WeakBag
6+ ( WeakBag
7+ , WeakBagTicket
8+ , empty
9+ , singleton
10+ , insert
11+ , traverse
12+ , remove
13+ ) where
2
14
3import Control.Concurrent.STM
15import Control.Concurrent.STM
4import Control.Exception
16import Control.Exception
@@ -10,20 +22,37 @@ import qualified Data.IntMap.Strict as IntMap
10import Data.IORef
22import Data.IORef
11import System.Mem.Weak
23import System.Mem.Weak
12
24
13−import Prelude hiding (mapM_)
25+import Prelude hiding (mapM_, traverse)
14
26
27+-- | A @WeakBag a@ holds a set of values of type @a@, but does not retain them -
28+-- that is, they can still be garbage-collected. As long as the @a@s remain
29+-- alive, the 'WeakBag' will continue to refer to them.
15data WeakBag a = WeakBag
30data WeakBag a = WeakBag
16 { _weakBag_nextId :: {-# UNPACK #-} !(TVar Int) --TODO: what if this wraps around?
31 { _weakBag_nextId :: {-# UNPACK #-} !(TVar Int) --TODO: what if this wraps around?
17 , _weakBag_children :: {-# UNPACK #-} !(TVar (IntMap (Weak a)))
32 , _weakBag_children :: {-# UNPACK #-} !(TVar (IntMap (Weak a)))
18 }
33 }
19
34
35+-- | When inserting an item into a 'WeakBag', a 'WeakBagTicket' is returned. If
36+-- the caller retains the ticket, the item is guranteed to stay in memory (and
37+-- thus in the 'WeakBag'). The ticket can also be used to remove the item from
38+-- the 'WeakBag' prematurely (i.e. while it is still alive), using 'remove'.
20data WeakBagTicket a = WeakBagTicket
39data WeakBagTicket a = WeakBagTicket
21 { _weakBagTicket_weakItem :: {-# UNPACK #-} !(Weak a)
40 { _weakBagTicket_weakItem :: {-# UNPACK #-} !(Weak a)
22 , _weakBagTicket_item :: {-# NOUNPACK #-} !a
41 , _weakBagTicket_item :: {-# NOUNPACK #-} !a
23 }
42 }
24
43
44+-- | Insert an item into a 'WeakBag'.
25{-# INLINE insert #-}
45{-# INLINE insert #-}
26−insert :: a -> WeakBag a -> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBagTicket a)
46+insert :: a -- ^ The item
47+ -> WeakBag a -- ^ The 'WeakBag' to insert into
48+ -> IORef (Weak b) -- ^ An arbitrary value to be used in the following
49+ -- callback
50+ -> (b -> IO ()) -- ^ A callback to be invoked when the item is removed
51+ -- (whether automatically by the item being garbage
52+ -- collected or manually via 'remove')
53+ -> IO (WeakBagTicket a) -- ^ Returns a 'WeakBagTicket' that ensures the
54+ -- item is retained and allows the item to be
55+ -- removed.
27insert a (WeakBag nextId children) wbRef finalizer = do
56insert a (WeakBag nextId children) wbRef finalizer = do
28 a' <- evaluate a
57 a' <- evaluate a
29 wbRef' <- evaluate wbRef
58 wbRef' <- evaluate wbRef
@@ -50,6 +79,7 @@ insert a (WeakBag nextId children) wbRef finalizer = do
50 , _weakBagTicket_item = a'
79 , _weakBagTicket_item = a'
51 }
80 }
52
81
82+-- | Create an empty 'WeakBag'.
53{-# INLINE empty #-}
83{-# INLINE empty #-}
54empty :: IO (WeakBag a)
84empty :: IO (WeakBag a)
55empty = do
85empty = do
@@ -61,6 +91,8 @@ empty = do
61 }
91 }
62 return bag
92 return bag
63
93
94+-- | Create a 'WeakBag' with one item; equivalent to creating the 'WeakBag' with
95+-- 'empty', then using 'insert'.
64{-# INLINE singleton #-}
96{-# INLINE singleton #-}
65singleton :: a -> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket a)
97singleton :: a -> IORef (Weak b) -> (b -> IO ()) -> IO (WeakBag a, WeakBagTicket a)
66singleton a wbRef finalizer = do
98singleton a wbRef finalizer = do
@@ -69,8 +101,10 @@ singleton a wbRef finalizer = do
69 return (bag, ticket)
101 return (bag, ticket)
70
102
71{-# INLINE traverse #-}
103{-# INLINE traverse #-}
72−-- | Visit every node in the given list. If new nodes are appended during the traversal, they will not be visited.
104+-- | Visit every node in the given list. If new nodes are appended during the
105+-- traversal, they will not be visited. Every live node that was in the list
73−-- Every live node that was in the list when the traversal began will be visited exactly once; however, no guarantee is made about the order of the traversal.
106+-- when the traversal began will be visited exactly once; however, no guarantee
107+-- is made about the order of the traversal.
74traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
108traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
75traverse (WeakBag _ children) f = do
109traverse (WeakBag _ children) f = do
76 cs <- liftIO $ readTVarIO children
110 cs <- liftIO $ readTVarIO children
@@ -78,6 +112,9 @@ traverse (WeakBag _ children) f = do
78 ma <- liftIO $ deRefWeak c
112 ma <- liftIO $ deRefWeak c
79 mapM_ f ma
113 mapM_ f ma
80
114
115+-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times
116+-- on the same 'WeakBagTicket'.
81{-# INLINE remove #-}
117{-# INLINE remove #-}
82remove :: WeakBagTicket a -> IO ()
118remove :: WeakBagTicket a -> IO ()
83remove = finalize . _weakBagTicket_weakItem
119remove = finalize . _weakBagTicket_weakItem
120+--TODO: Should 'remove' also drop the reference to the item?
src/Reflex.hs+2
@@ -1,3 +1,5 @@
1+-- | This module exports all of the commonly-used functionality of Reflex; if
2+-- you are just getting started with Reflex, this is probably what you want.
1module Reflex (module X) where
3module Reflex (module X) where
2
4
3import Reflex.Class as X
5import Reflex.Class as X
src/Reflex/Class.hs+235−87
@@ -1,4 +1,3 @@
1−
2{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
3{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FlexibleInstances #-}
@@ -14,7 +13,71 @@
14{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE UndecidableInstances #-}
14{-# LANGUAGE UndecidableInstances #-}
16
15
16+-- | This module contains the Reflex interface, as well as a variety of
17+-- convenience functions for working with 'Event's, 'Behavior's, and other
18+-- signals.
17−module Reflex.Class where
19+module Reflex.Class
20+ ( -- * Primitives
21+ Reflex (..)
22+ , MonadSample (..)
23+ , MonadHold (..)
24+ -- ** 'fan'-related types
25+ , EventSelector (..)
26+ -- ** 'Incremental'-related types
27+ , Patch (..)
28+ , PatchDMap (..)
29+ -- * Convenience functions
30+ , constDyn
31+ , pushAlways
32+ -- ** Combining 'Event's
33+ , leftmost
34+ , mergeMap
35+ , mergeList
36+ , mergeWith
37+ -- ** Breaking up 'Event's
38+ , splitE
39+ , fanMap
40+ , dmapToThese
41+ , EitherTag (..)
42+ , eitherToDSum
43+ , dsumToEither
44+ -- ** Switching between 'Event's
45+ , switchPromptly
46+ -- ** Using 'Event's to sample 'Behavior's
47+ , tag
48+ , attach
49+ , attachWith
50+ , attachWithMaybe
51+ -- ** Blocking an 'Event' based on a 'Behavior'
52+ , gate
53+ -- ** Combining 'Dynamic's
54+ , distributeDMapOverDynPure
55+ , zipDyn
56+ , zipDynWith
57+ -- ** Accumulating state
58+ , Accumulator (..)
59+ , mapAccum_
60+ , mapAccumM_
61+ , mapAccumMaybeM_
62+ , zipListWithEvent
63+ , headE
64+ , tailE
65+ , switcher
66+ -- * Debugging functions
67+ , traceEvent
68+ , traceEventWith
69+ -- * Unsafe functions
70+ , unsafeDynamic
71+ -- * 'FunctorMaybe'
72+ , FunctorMaybe (..)
73+ , fforMaybe
74+ , ffilter
75+ -- * Miscellaneous convenience functions
76+ , ffor
77+ -- * Deprecated functions
78+ , onceE
79+ , appendEvents
80+ ) where
18
81
19import Control.Applicative
82import Control.Applicative
20import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
83import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)
@@ -52,54 +115,76 @@ import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
52
115
53import Debug.Trace (trace)
116import Debug.Trace (trace)
54
117
118+-- | The 'Reflex' class contains all the primitive functionality needed for
119+-- Functional Reactive Programming (FRP). The @t@ type parameter indicates
120+-- which "timeline" is in use. Timelines are fully-independent FRP contexts,
121+-- and the type of the timeline determines the FRP engine to be used. For most
122+-- purposes, the 'Reflex.Spider' implementation is recommended.
55class ( MonadHold t (PushM t)
123class ( MonadHold t (PushM t)
56 , MonadSample t (PullM t)
124 , MonadSample t (PullM t)
57 , MonadFix (PushM t)
125 , MonadFix (PushM t)
58 , Functor (Event t)
126 , Functor (Event t)
59 , Functor (Behavior t)
127 , Functor (Behavior t)
60 , Functor (Dynamic t)
128 , Functor (Dynamic t)
61− , Applicative (Dynamic t) -- Necessary for GHC <=7.8
129+ , Applicative (Dynamic t) -- Necessary for GHC <= 7.8
62 , Monad (Dynamic t)
130 , Monad (Dynamic t)
63 ) => Reflex t where
131 ) => Reflex t where
132+ -- | A container for a value that can change over time. 'Behavior's can be
64− -- | A container for a value that can change over time. Behaviors can be sampled at will, but it is not possible to be notified when they change
133+ -- sampled at will, but it is not possible to be notified when they change
65 data Behavior t :: * -> *
134 data Behavior t :: * -> *
135+ -- | A stream of occurrences. During any given frame, an 'Event' is either
66− -- | A stream of occurrences. During any given frame, an Event is either occurring or not occurring; if it is occurring, it will contain a value of the given type (its "occurrence type")
136+ -- occurring or not occurring; if it is occurring, it will contain a value of
137+ -- the given type (its "occurrence type")
67 data Event t :: * -> *
138 data Event t :: * -> *
68− -- | A container for a value that can change over time and allows notifications on changes.
139+ -- | A container for a value that can change over time and allows
69− -- Basically a combination of a 'Behavior' and an 'Event', with a rule that the Behavior will
140+ -- notifications on changes. Basically a combination of a 'Behavior' and an
141+ -- 'Event', with a rule that the 'Behavior' will change if and only if the
70− -- change if and only if the Event fires.
142+ -- 'Event' fires.
71 data Dynamic t :: * -> *
143 data Dynamic t :: * -> *
72− -- | A container for a value that can change over time and allows notifications on changes.
144+ -- | A container for a value that can change over time and allows
73− -- Basically a combination of a 'Behavior' and an 'Event', with a rule that the Behavior will
145+ -- notifications on changes. Basically a combination of a 'Behavior' and an
146+ -- 'Event', with a rule that the 'Behavior' will change if and only if the
74− -- change if and only if the Event fires.
147+ -- 'Event' fires.
75 data Incremental t :: (* -> *) -> * -> *
148 data Incremental t :: (* -> *) -> * -> *
76− -- | An Event with no occurrences
149+ -- | An 'Event' with no occurrences
77 never :: Event t a
150 never :: Event t a
78− -- | Create a Behavior that always has the given value
151+ -- | Create a 'Behavior' that always has the given value
79− constant :: a -> Behavior t a --TODO: Refactor to use 'pure' from Applicative instead; however, we need to make sure that encouraging Applicative-style use of Behaviors doesn't have a negative performance impact
152+ constant :: a -> Behavior t a --TODO: Refactor to use 'pure' from Applicative instead; however, we need to make sure that encouraging Applicative-style use of 'Behavior's doesn't have a negative performance impact
80− -- | Create an Event from another Event; the provided function can sample Behaviors and hold Events, and use the results to produce a occurring (Just) or non-occurring (Nothing) result
153+ -- | Create an 'Event' from another 'Event'; the provided function can sample
154+ -- 'Behavior's and hold 'Event's, and use the results to produce a occurring
155+ -- (Just) or non-occurring (Nothing) result
81 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
156 push :: (a -> PushM t (Maybe b)) -> Event t a -> Event t b
82 -- | A monad for doing complex push-based calculations efficiently
157 -- | A monad for doing complex push-based calculations efficiently
83 type PushM t :: * -> *
158 type PushM t :: * -> *
84− -- | Create a Behavior by reading from other Behaviors; the result will be recomputed whenever any of the read Behaviors changes
159+ -- | Create a 'Behavior' by reading from other 'Behavior's; the result will be
160+ -- recomputed whenever any of the read 'Behavior's changes
85 pull :: PullM t a -> Behavior t a
161 pull :: PullM t a -> Behavior t a
86 -- | A monad for doing complex pull-based calculations efficiently
162 -- | A monad for doing complex pull-based calculations efficiently
87 type PullM t :: * -> *
163 type PullM t :: * -> *
164+ -- | Merge a collection of events; the resulting 'Event' will only occur if at
88− -- | Merge a collection of events; the resulting Event will only occur if at least one input event is occuring, and will contain all of the input keys that are occurring simultaneously
165+ -- least one input event is occuring, and will contain all of the input keys
166+ -- that are occurring simultaneously
89 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
167 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
90− -- | Efficiently fan-out an event to many destinations. This function should be partially applied, and then the result applied repeatedly to create child events
168+ -- | Efficiently fan-out an event to many destinations. This function should
169+ -- be partially applied, and then the result applied repeatedly to create
170+ -- child events
91 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
171 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
92− -- | Create an Event that will occur whenever the currently-selected input Event occurs
172+ -- | Create an 'Event' that will occur whenever the currently-selected input
173+ -- 'Event' occurs
93 switch :: Behavior t (Event t a) -> Event t a
174 switch :: Behavior t (Event t a) -> Event t a
94− -- | Create an Event that will occur whenever the input event is occurring and its occurrence value, another Event, is also occurring
175+ -- | Create an 'Event' that will occur whenever the input event is occurring
176+ -- and its occurrence value, another 'Event', is also occurring
95 coincidence :: Event t (Event t a) -> Event t a
177 coincidence :: Event t (Event t a) -> Event t a
96 -- | Extract the 'Behavior' of a 'Dynamic'.
178 -- | Extract the 'Behavior' of a 'Dynamic'.
97 current :: Dynamic t a -> Behavior t a
179 current :: Dynamic t a -> Behavior t a
98 -- | Extract the 'Event' of the 'Dynamic'.
180 -- | Extract the 'Event' of the 'Dynamic'.
99 updated :: Dynamic t a -> Event t a
181 updated :: Dynamic t a -> Event t a
100− -- | Create a new 'Dynamic'. The given PullM must always return the most recent firing of the given Event, if any.
182+ -- | Create a new 'Dynamic'. The given 'PullM' must always return the most
183+ -- recent firing of the given 'Event', if any.
101 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
184 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a
185+ -- | Create a new 'Incremental'. The given 'PullM''s value must always change
102− -- | Create a new 'Incremental'. The given PullM's value must always change in the same way that the accumulated application of patches would change that value.
186+ -- in the same way that the accumulated application of patches would change
187+ -- that value.
103 unsafeBuildIncremental :: Patch p => PullM t a -> Event t (p a) -> Incremental t p a
188 unsafeBuildIncremental :: Patch p => PullM t a -> Event t (p a) -> Incremental t p a
104 -- | Create a merge whose parents can change over time
189 -- | Create a merge whose parents can change over time
105 mergeIncremental :: GCompare k => Incremental t PatchDMap (DMap k (Event t)) -> Event t (DMap k Identity)
190 mergeIncremental :: GCompare k => Incremental t PatchDMap (DMap k (Event t)) -> Event t (DMap k Identity)
@@ -110,12 +195,16 @@ class ( MonadHold t (PushM t)
110 -- | Convert an 'Incremental' to a 'Dynamic'
195 -- | Convert an 'Incremental' to a 'Dynamic'
111 incrementalToDynamic :: Patch p => Incremental t p a -> Dynamic t a
196 incrementalToDynamic :: Patch p => Incremental t p a -> Dynamic t a
112
197
198+-- | A 'Patch' type represents a kind of change made to a datastructure.
113class Patch p where
199class Patch p where
114− apply :: p a -> a -> Maybe a -- Return Nothing if no change is necessary
200+ -- | Apply the patch @p a@ to the value @a@. If no change is needed, return
201+ -- 'Nothing'.
202+ apply :: p a -> a -> Maybe a
115
203
116instance Patch Identity where
204instance Patch Identity where
117 apply (Identity a) _ = Just a
205 apply (Identity a) _ = Just a
118
206
207+-- | A set of changes to a 'DMap'. Only DMap types are allowed for @a@.
119data PatchDMap a where
208data PatchDMap a where
120 PatchDMap :: GCompare k => DMap k (Compose Maybe v) -> PatchDMap (DMap k v)
209 PatchDMap :: GCompare k => DMap k (Compose Maybe v) -> PatchDMap (DMap k v)
121
210
@@ -143,27 +232,55 @@ instance Patch PatchDMap where
143 Nothing -> Just $ Constant ()
232 Nothing -> Just $ Constant ()
144 Just _ -> Nothing
233 Just _ -> Nothing
145
234
235+-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
236+-- _must_ change when and only when the 'Event' fires, such that the
237+-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
238+-- if this is not the case, the resulting 'Dynamic' will behave
239+-- nondeterministically.
146unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
240unsafeDynamic :: Reflex t => Behavior t a -> Event t a -> Dynamic t a
147unsafeDynamic = unsafeBuildDynamic . sample
241unsafeDynamic = unsafeBuildDynamic . sample
148
242
243+-- | Construct a 'Dynamic' value that never changes
149constDyn :: Reflex t => a -> Dynamic t a
244constDyn :: Reflex t => a -> Dynamic t a
150constDyn = pure
245constDyn = pure
151
246
247+-- | 'MonadSample' designates monads that can read the current value of a
248+-- 'Behavior'. This includes both 'PullM' and 'PushM'.
152class (Applicative m, Monad m) => MonadSample t m | m -> t where
249class (Applicative m, Monad m) => MonadSample t m | m -> t where
153− -- | Get the current value in the Behavior
250+ -- | Get the current value in the 'Behavior'
154 sample :: Behavior t a -> m a
251 sample :: Behavior t a -> m a
155
252
253+-- | 'MonadHold' designates monads that can create new 'Behavior's based on
254+-- 'Event's; usually this will be 'PushM' or a monad based on it. 'MonadHold'
255+-- is required to create any stateful computations with Reflex.
156class MonadSample t m => MonadHold t m where
256class MonadSample t m => MonadHold t m where
157− -- | Create a new Behavior whose value will initially be equal to the given value and will be updated whenever the given Event occurs. The update takes effect immediately after the Event occurs; if the occurrence that sets the Behavior (or one that is simultaneous with it) is used to sample the Behavior, it will see the *old* value of the Behavior, not the new one.
257+ -- | Create a new 'Behavior' whose value will initially be equal to the given
258+ -- value and will be updated whenever the given 'Event' occurs. The update
259+ -- takes effect immediately after the 'Event' occurs; if the occurrence that
260+ -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample
261+ -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new
262+ -- one.
158 hold :: a -> Event t a -> m (Behavior t a)
263 hold :: a -> Event t a -> m (Behavior t a)
159 -- | Create a 'Dynamic' value using the given initial value that changes every
264 -- | Create a 'Dynamic' value using the given initial value that changes every
160 -- time the 'Event' occurs.
265 -- time the 'Event' occurs.
161 holdDyn :: a -> Event t a -> m (Dynamic t a)
266 holdDyn :: a -> Event t a -> m (Dynamic t a)
162− -- | Create an 'Incremental' value using the given initial value that changes every
267+ -- | Create an 'Incremental' value using the given initial value that changes
163− -- time the 'Event' occurs.
268+ -- every time the 'Event' occurs.
164 holdIncremental :: Patch p => a -> Event t (p a) -> m (Incremental t p a)
269 holdIncremental :: Patch p => a -> Event t (p a) -> m (Incremental t p a)
165
270
271+-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a
272+-- key. This is much more efficient than filtering for each key with
273+-- 'fmapMaybe'.
166−newtype EventSelector t k = EventSelector { select :: forall a. k a -> Event t a }
274+newtype EventSelector t k = EventSelector
275+ { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
276+ -- determined by the type of the key, so this can be used to fan-out
277+ -- 'Event's whose sub-'Event's have different types.
278+ --
279+ -- Using 'EventSelector's and the 'fan' primitive is far more efficient than
280+ -- (but equivalent to) using 'fmapMaybe' to select only the relevant
281+ -- occurrences of an 'Event'.
282+ select :: forall a. k a -> Event t a
283+ }
167
284
168--------------------------------------------------------------------------------
285--------------------------------------------------------------------------------
169-- Instances
286-- Instances
@@ -221,8 +338,8 @@ instance MonadHold t m => MonadHold t (ContT r m) where
221-- Convenience functions
338-- Convenience functions
222--------------------------------------------------------------------------------
339--------------------------------------------------------------------------------
223
340
224−-- | Create an Event from another Event.
341+-- | Create an 'Event' from another 'Event'. The provided function can sample
225−-- The provided function can sample 'Behavior's and hold 'Event's.
342+-- 'Behavior's and hold 'Event's.
226pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
343pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
227pushAlways f = push (fmap Just . f)
344pushAlways f = push (fmap Just . f)
228
345
@@ -255,7 +372,7 @@ instance (Reflex t, IsString a) => IsString (Behavior t a) where
255
372
256instance Reflex t => Monad (Behavior t) where
373instance Reflex t => Monad (Behavior t) where
257 a >>= f = pull $ sample a >>= sample . f
374 a >>= f = pull $ sample a >>= sample . f
258− -- Note: it is tempting to write (_ >> b = b); however, this would result in (fail x >> return y) succeeding (returning y), which violates the law that (a >> b = a >>= \_ -> b), since the implementation of (>>=) above actually will fail. Since we can't examine Behaviors other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above.
375+ -- Note: it is tempting to write (_ >> b = b); however, this would result in (fail x >> return y) succeeding (returning y), which violates the law that (a >> b = a >>= \_ -> b), since the implementation of (>>=) above actually will fail. Since we can't examine 'Behavior's other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above.
259 return = constant
376 return = constant
260 fail = error "Monad (Behavior t) does not support fail"
377 fail = error "Monad (Behavior t) does not support fail"
261
378
@@ -305,11 +422,11 @@ ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
305instance Reflex t => Alt (Event t) where
422instance Reflex t => Alt (Event t) where
306 ev1 <!> ev2 = leftmost [ev1, ev2]
423 ev1 <!> ev2 = leftmost [ev1, ev2]
307
424
308−-- | Event intersection (convenient interface to 'coincidence').
425+-- | 'Event' intersection (convenient interface to 'coincidence').
309instance Reflex t => Apply (Event t) where
426instance Reflex t => Apply (Event t) where
310 evf <.> evx = coincidence (fmap (<$> evx) evf)
427 evf <.> evx = coincidence (fmap (<$> evx) evf)
311
428
312−-- | Event intersection (convenient interface to 'coincidence').
429+-- | 'Event' intersection (convenient interface to 'coincidence').
313instance Reflex t => Bind (Event t) where
430instance Reflex t => Bind (Event t) where
314 evx >>- f = coincidence (f <$> evx)
431 evx >>- f = coincidence (f <$> evx)
315 join = coincidence
432 join = coincidence
@@ -329,27 +446,23 @@ instance Reflex t => Plus (Event t) where
329tag :: Reflex t => Behavior t b -> Event t a -> Event t b
446tag :: Reflex t => Behavior t b -> Event t a -> Event t b
330tag b = pushAlways $ \_ -> sample b
447tag b = pushAlways $ \_ -> sample b
331
448
332−-- | Create a new 'Event' that combines occurences of supplied 'Event'
449+-- | Create a new 'Event' that combines occurences of supplied 'Event' with the
333−-- with the current value of the 'Behavior'.
450+-- current value of the 'Behavior'.
334attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
451attach :: Reflex t => Behavior t a -> Event t b -> Event t (a, b)
335attach = attachWith (,)
452attach = attachWith (,)
336
453
337−-- | Create a new 'Event' that occurs when the supplied 'Event' occurs
454+-- | Create a new 'Event' that occurs when the supplied 'Event' occurs by
338−-- by combining it with the current value of the 'Behavior'.
455+-- combining it with the current value of the 'Behavior'.
339attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
456attachWith :: Reflex t => (a -> b -> c) -> Behavior t a -> Event t b -> Event t c
340attachWith f = attachWithMaybe $ \a b -> Just $ f a b
457attachWith f = attachWithMaybe $ \a b -> Just $ f a b
341
458
342−-- | Create a new 'Event' by combining each occurence with the current
459+-- | Create a new 'Event' by combining each occurence with the current value of
343−-- value of the 'Behavior'. The occurrence is discarded if the combining function
460+-- the 'Behavior'. The occurrence is discarded if the combining function returns
344−-- returns Nothing
461+-- Nothing
345attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
462attachWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Behavior t a -> Event t b -> Event t c
346attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
463attachWithMaybe f b e = flip push e $ \o -> (`f` o) <$> sample b
347
464
348−-- | Alias for 'headE'
349−onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
350−onceE = headE
351−
352−-- | Create a new 'Event' that only occurs on the first occurence of
465+-- | Create a new 'Event' that only occurs only once, on the first occurence of
353-- the supplied 'Event'.
466-- the supplied 'Event'.
354headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
467headE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
355headE e = do
468headE e = do
@@ -358,38 +471,38 @@ headE e = do
358 e' `seq` return ()
471 e' `seq` return ()
359 return e'
472 return e'
360
473
361−-- | Create a new 'Event' that occurs on all but the first occurence
474+-- | Create a new 'Event' that occurs on all but the first occurence of the
362−-- of the supplied 'Event'.
475+-- supplied 'Event'.
363tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
476tailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
364tailE e = snd <$> headTailE e
477tailE e = snd <$> headTailE e
365
478
366−-- | Create a tuple of two 'Event's with the first one occuring only
479+-- | Create a tuple of two 'Event's with the first one occuring only the first
367−-- the first time the supplied 'Event' occurs and the second occuring
480+-- time the supplied 'Event' occurs and the second occuring on all but the first
368−-- on all but the first occurence.
481+-- occurence.
369headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
482headTailE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a, Event t a)
370headTailE e = do
483headTailE e = do
371 eHead <- headE e
484 eHead <- headE e
372 be <- hold never $ fmap (const e) eHead
485 be <- hold never $ fmap (const e) eHead
373 return (eHead, switch be)
486 return (eHead, switch be)
374
487
375−-- | Split the supplied 'Event' into two individual 'Event's occuring
488+-- | Split the supplied 'Event' into two individual 'Event's occuring at the
376−-- at the same time with the respective values from the tuple.
489+-- same time with the respective values from the tuple.
377splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
490splitE :: Reflex t => Event t (a, b) -> (Event t a, Event t b)
378splitE e = (fmap fst e, fmap snd e)
491splitE e = (fmap fst e, fmap snd e)
379
492
380-- | Print the supplied 'String' and the value of the 'Event' on each
493-- | Print the supplied 'String' and the value of the 'Event' on each
381-- occurence. This should /only/ be used for debugging.
494-- occurence. This should /only/ be used for debugging.
382--
495--
383−-- Note: As with Debug.Trace.trace, the message will only be printed if
496+-- Note: As with Debug.Trace.trace, the message will only be printed if the
384−-- the 'Event' is actually used.
497+-- 'Event' is actually used.
385traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
498traceEvent :: (Reflex t, Show a) => String -> Event t a -> Event t a
386traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
499traceEvent s = traceEventWith $ \x -> s <> ": " <> show x
387
500
388−-- | Print the output of the supplied function on each occurence of
501+-- | Print the output of the supplied function on each occurence of the
389−-- the 'Event'. This should /only/ be used for debugging.
502+-- 'Event'. This should /only/ be used for debugging.
390--
503--
391−-- Note: As with Debug.Trace.trace, the message will only be printed if
504+-- Note: As with Debug.Trace.trace, the message will only be printed if the
392−-- the 'Event' is actually used.
505+-- 'Event' is actually used.
393traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
506traceEventWith :: Reflex t => (a -> String) -> Event t a -> Event t a
394traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
507traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
395
508
@@ -441,12 +554,6 @@ dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
441 (Nothing, Just (Identity b)) -> Just $ That b
554 (Nothing, Just (Identity b)) -> Just $ That b
442 (Just (Identity a), Just (Identity b)) -> Just $ These a b
555 (Just (Identity a), Just (Identity b)) -> Just $ These a b
443
556
444−-- | Create a new 'Event' that occurs if at least one of the supplied
445−-- 'Event's occurs. If both occur at the same time they are combined
446−-- using 'mappend'.
447−appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
448−appendEvents e1 e2 = mergeThese mappend <$> align e1 e2
449−
450{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
557{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
451{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
558{-# ANN sequenceThese "HLint: ignore Use fmap" #-}
452sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
559sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
@@ -469,9 +576,9 @@ instance (Semigroup a, Reflex t) => Monoid (Event t a) where
469 mappend = (<>)
576 mappend = (<>)
470 mconcat = fmap sconcat . mergeList
577 mconcat = fmap sconcat . mergeList
471
578
472−-- | Create a new 'Event' that occurs if at least one of the 'Event's
579+-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
473−-- in the list occurs. If multiple occur at the same time they are
580+-- list occurs. If multiple occur at the same time they are folded from the left
474−-- folded from the left with the given function.
581+-- with the given function.
475mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
582mergeWith :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
476mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
583mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList)
477 . merge
584 . merge
@@ -479,31 +586,32 @@ mergeWith f es = fmap (Prelude.foldl1 f . map (\(Const2 _ :=> Identity v) -> v)
479 . map (\(k, v) -> Const2 k :=> v)
586 . map (\(k, v) -> Const2 k :=> v)
480 $ zip [0 :: Int ..] es
587 $ zip [0 :: Int ..] es
481
588
482−-- | Create a new 'Event' that occurs if at least one of the 'Event's
589+-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
483−-- in the list occurs. If multiple occur at the same time the value is
590+-- list occurs. If multiple occur at the same time the value is the value of the
484−-- the value of the leftmost event.
591+-- leftmost event.
485leftmost :: Reflex t => [Event t a] -> Event t a
592leftmost :: Reflex t => [Event t a] -> Event t a
486leftmost = mergeWith const
593leftmost = mergeWith const
487
594
488−-- | Create a new 'Event' that occurs if at least one of the 'Event's
595+-- | Create a new 'Event' that occurs if at least one of the 'Event's in the
489−-- in the list occurs and has a list of the values of all 'Event's
596+-- list occurs and has a list of the values of all 'Event's occuring at that
490−-- occuring at that time.
597+-- time.
491mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
598mergeList :: Reflex t => [Event t a] -> Event t (NonEmpty a)
492mergeList [] = never
599mergeList [] = never
493mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
600mergeList es = mergeWith (<>) $ map (fmap (:|[])) es
494
601
495−-- | Create a new 'Event' combining the map of 'Event's into an
602+-- | Create a new 'Event' combining the map of 'Event's into an 'Event' that
496−-- 'Event' that occurs if at least one of them occurs and has a map of
603+-- occurs if at least one of them occurs and has a map of values of all 'Event's
497−-- values of all 'Event's occuring at that time.
604+-- occuring at that time.
498mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
605mergeMap :: (Reflex t, Ord k) => Map k (Event t a) -> Event t (Map k a)
499mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
606mergeMap = fmap dmapToMap . merge . mapWithFunctorToDMap
500
607
501−-- | Split the event into an 'EventSelector' that allows efficient
608+-- | Split the event into an 'EventSelector' that allows efficient selection of
502−-- selection of the individual 'Event's.
609+-- the individual 'Event's.
503fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
610fanMap :: (Reflex t, Ord k) => Event t (Map k a) -> EventSelector t (Const2 k a)
504fanMap = fan . fmap mapToDMap
611fanMap = fan . fmap mapToDMap
505
612
506−-- | Switches to the new event whenever it receives one; the new event is used immediately, on the same frame that it is switched to
613+-- | Switches to the new event whenever it receives one; the new event is used
614+-- immediately, on the same frame that it is switched to
507switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
615switchPromptly :: forall t m a. (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)
508switchPromptly ea0 eea = do
616switchPromptly ea0 eea = do
509 bea <- hold ea0 eea
617 bea <- hold ea0 eea
@@ -515,17 +623,24 @@ instance Reflex t => Align (Event t) where
515 nil = never
623 nil = never
516 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
624 align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
517
625
518−-- | Create a new 'Event' that only occurs if the supplied 'Event'
626+-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
519−-- occurs and the 'Behavior' is true at the time of occurence.
627+-- the 'Behavior' is true at the time of occurence.
520gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
628gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
521gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
629gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
522
630
523−-- | Create a new behavior given a starting behavior and switch to a the
631+-- | Create a new behavior given a starting behavior and switch to a the behvior
524−-- behvior carried by the event when it fires.
632+-- carried by the event when it fires.
525switcher :: (Reflex t, MonadHold t m)
633switcher :: (Reflex t, MonadHold t m)
526 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
634 => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
527switcher b eb = pull . (sample <=< sample) <$> hold b eb
635switcher b eb = pull . (sample <=< sample) <$> hold b eb
528
636
637+-- | Combine two 'Dynamic's. The result will change whenever either (or both)
638+-- input 'Dynamic' changes. Equivalent to @zipDynWith (,)@.
639+zipDyn :: Reflex t => Dynamic t a -> Dynamic t b -> Dynamic t (a, b)
640+zipDyn = zipDynWith (,)
641+
642+-- | Combine two 'Dynamic's with a combining function. The result will change
643+-- whenever either (or both) input 'Dynamic' changes.
529zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
644zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
530zipDynWith f da db =
645zipDynWith f da db =
531 let eab = align (updated da) (updated db)
646 let eab = align (updated da) (updated db)
@@ -546,18 +661,27 @@ instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
546 mempty = constDyn mempty
661 mempty = constDyn mempty
547 mappend = zipDynWith mappend
662 mappend = zipDynWith mappend
548
663
664+-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
665+-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
666+-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.
549distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
667distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
550distributeDMapOverDynPure dm = case DMap.toList dm of
668distributeDMapOverDynPure dm = case DMap.toList dm of
551 [] -> constDyn DMap.empty
669 [] -> constDyn DMap.empty
552 [k :=> v] -> fmap (DMap.singleton k . Identity) v
670 [k :=> v] -> fmap (DMap.singleton k . Identity) v
553 _ ->
671 _ ->
554 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
672 let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
555− edmPre = merge $ rewrapDMap updated dm
673+ edmPre = merge $ DMap.map updated dm
556 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
674 result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
557 olds <- sample $ current result
675 olds <- sample $ current result
558 return $ DMap.unionWithKey (\_ _ new -> new) olds news
676 return $ DMap.unionWithKey (\_ _ new -> new) olds news
559 in result
677 in result
560
678
679+--------------------------------------------------------------------------------
680+-- Accumulator
681+--------------------------------------------------------------------------------
682+
683+-- | An 'Accumulator' type can be built by accumulating occurrences of an
684+-- 'Event'.
561class Reflex t => Accumulator t f | f -> t where
685class Reflex t => Accumulator t f | f -> t where
562 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
686 accum :: (MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (f a)
563 accum f = accumMaybe $ \v o -> Just $ f v o
687 accum f = accumMaybe $ \v o -> Just $ f v o
@@ -574,21 +698,30 @@ class Reflex t => Accumulator t f | f -> t where
574 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
698 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o
575 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
699 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)
576
700
701+-- | Accumulate occurrences of an 'Event', producing an output occurrence each
702+-- time. Discard the underlying 'Accumulator'.
577mapAccum_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
703mapAccum_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Event t c)
578mapAccum_ f z e = do
704mapAccum_ f z e = do
579 (_ :: Behavior t a, result) <- mapAccum f z e
705 (_ :: Behavior t a, result) <- mapAccum f z e
580 return result
706 return result
581
707
708+-- | Accumulate occurrences of an 'Event', possibly producing an output
709+-- occurrence each time. Discard the underlying 'Accumulator'.
582mapAccumMaybe_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
710mapAccumMaybe_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
583mapAccumMaybe_ f z e = do
711mapAccumMaybe_ f z e = do
584 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
712 (_ :: Behavior t a, result) <- mapAccumMaybe f z e
585 return result
713 return result
586
714
715+-- | Accumulate occurrences of an 'Event', using a 'PushM' action and producing
716+-- an output occurrence each time. Discard the underlying 'Accumulator'.
587mapAccumM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
717mapAccumM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Event t c)
588mapAccumM_ f z e = do
718mapAccumM_ f z e = do
589 (_ :: Behavior t a, result) <- mapAccumM f z e
719 (_ :: Behavior t a, result) <- mapAccumM f z e
590 return result
720 return result
591
721
722+-- | Accumulate occurrences of an 'Event', using a 'PushM' action and possibly
723+-- producing an output occurrence each time. Discard the underlying
724+-- 'Accumulator'.
592mapAccumMaybeM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
725mapAccumMaybeM_ :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Event t c)
593mapAccumMaybeM_ f z e = do
726mapAccumMaybeM_ f z e = do
594 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
727 (_ :: Behavior t a, result) <- mapAccumMaybeM f z e
@@ -619,12 +752,27 @@ instance Reflex t => Accumulator t (Event t) where
619 accumMaybeM f z e = updated <$> accumMaybeM f z e
752 accumMaybeM f z e = updated <$> accumMaybeM f z e
620 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
753 mapAccumMaybeM f z e = first updated <$> mapAccumMaybeM f z e
621
754
622−-- | Create a new 'Event' by combining each occurence with the next value
755+-- | Create a new 'Event' by combining each occurence with the next value of the
623−-- of the list using the supplied function. If the list runs out of items,
756+-- list using the supplied function. If the list runs out of items, all
624−-- all subsequent 'Event' occurrences will be ignored.
757+-- subsequent 'Event' occurrences will be ignored.
625zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
758zipListWithEvent :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> c) -> [a] -> Event t b -> m (Event t c)
626zipListWithEvent f l e = do
759zipListWithEvent f l e = do
627 let f' a b = case a of
760 let f' a b = case a of
628 h:t -> (Just t, Just $ f h b)
761 h:t -> (Just t, Just $ f h b)
629 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
762 _ -> (Nothing, Nothing) --TODO: Unsubscribe the event?
630 mapAccumMaybe_ f' l e
763 mapAccumMaybe_ f' l e
764+
765+--------------------------------------------------------------------------------
766+-- Deprecated functions
767+--------------------------------------------------------------------------------
768+
769+-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's
770+-- occurs. If both occur at the same time they are combined using 'mappend'.
771+{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}
772+appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
773+appendEvents = alignWith $ mergeThese mappend
774+
775+-- | Alias for 'headE'
776+{-# DEPRECATED onceE "Use 'headE' instead" #-}
777+onceE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)
778+onceE = headE
src/Reflex/Dynamic.hs+277−192
@@ -12,46 +12,61 @@
12{-# LANGUAGE TypeFamilies #-}
12{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE TypeOperators #-}
13{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE UndecidableInstances #-}
14{-# LANGUAGE UndecidableInstances #-}
15+-- | This module contains various functions for working with 'Dynamic' values.
16+-- 'Dynamic' and its primitives have been moved to the 'Reflex' class.
17+module Reflex.Dynamic
18+ ( -- * Basics
15−module Reflex.Dynamic ( Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update
19+ Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update
16− , current
20+ , current
17− , updated
21+ , updated
22+ , holdDyn
18− , constDyn
23+ , constDyn
19− , holdDyn
24+ , uniqDyn
20− , nubDyn
25+ , uniqDynBy
21− , count
26+ , count
22− , toggle
27+ , toggle
23− , switchPromptlyDyn
28+ , switchPromptlyDyn
24− , tagDyn
29+ , tagPromptlyDyn
25− , attachDyn
30+ , attachPromptlyDyn
26− , attachDynWith
31+ , attachPromptlyDynWith
27− , attachDynWithMaybe
32+ , attachPromptlyDynWithMaybe
28− , mapDyn
29− , forDyn
30− , foldDyn
33+ , foldDyn
31− , foldDynM
34+ , foldDynM
32− , foldDynMaybe
35+ , foldDynMaybe
33− , foldDynMaybeM
36+ , foldDynMaybeM
34− , combineDyn
35− , apDyn
36− , collectDyn
37− , mconcatDyn
38− , distributeDMapOverDyn
39− , joinDyn
40− , joinDynThroughMap
37+ , joinDynThroughMap
41− , traceDyn
38+ , traceDyn
42− , traceDynWith
39+ , traceDynWith
43− , splitDyn
44− , splitDynPure
40+ , splitDynPure
41+ , distributeDMapOverDynPure
45− , Demux
42+ , Demux
46− , demux
43+ , demux
47− , getDemuxed
44+ , demuxed
48− -- Things that probably aren't very useful:
45+ -- Things that probably aren't very useful:
49− , HList (..)
46+ , HList (..)
50− , FHList (..)
47+ , FHList (..)
51− , distributeFHListOverDyn
48+ , collectDynPure
49+ , distributeFHListOverDynPure
52− -- Unsafe
50+ -- Unsafe
53− , unsafeDynamic
51+ , unsafeDynamic
52+ -- * Deprecated functions
53+ , apDyn
54+ , attachDyn
55+ , attachDynWith
56+ , attachDynWithMaybe
57+ , collectDyn
58+ , combineDyn
59+ , distributeDMapOverDyn
60+ , distributeFHListOverDyn
61+ , forDyn
62+ , getDemuxed
63+ , joinDyn
64+ , mapDyn
65+ , mconcatDyn
66+ , nubDyn
67+ , splitDyn
68+ , tagDyn
54− ) where
69+ ) where
55
70
56import Prelude hiding (mapM, mapM_)
71import Prelude hiding (mapM, mapM_)
57
72
@@ -73,67 +88,41 @@ import Data.These
73
88
74import Debug.Trace
89import Debug.Trace
75
90
76−data HList (l::[*]) where
77− HNil :: HList '[]
78− HCons :: e -> HList l -> HList (e ': l)
79−
80−infixr 2 `HCons`
81−
82−type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
83−type instance HRevApp '[] l = l
84−type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
85−
86−hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
87−hRevApp HNil l = l
88−hRevApp (HCons x l) l' = hRevApp l (HCons x l')
89−
90−hReverse :: HList l -> HList (HRevApp l '[])
91−hReverse l = hRevApp l HNil
92−
93−hBuild :: (HBuild' '[] r) => r
94−hBuild = hBuild' HNil
95−
96−class HBuild' l r where
97− hBuild' :: HList l -> r
98−
99−instance (l' ~ HRevApp l '[])
100− => HBuild' l (HList l') where
101− hBuild' = hReverse
102−
103−instance HBuild' (a ': l) r
104− => HBuild' l (a->r) where
105− hBuild' l x = hBuild' (HCons x l)
106−
107−-- | Create a new 'Dynamic' that only signals changes if the values
91+-- | Create a new 'Dynamic' that only signals changes if the values actually
108−-- actually changed.
92+-- changed.
109−nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
93+uniqDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
110−nubDyn d =
94+uniqDyn = uniqDynBy (==)
95+
96+-- | Create a new 'Dynamic' that changes only when the underlying 'Dynamic'
97+-- changes and the given function returns 'False' when given both the old and
98+-- the new values.
99+uniqDynBy :: Reflex t => (a -> a -> Bool) -> Dynamic t a -> Dynamic t a
100+uniqDynBy eq d =
111− let e' = attachWithMaybe (\x x' -> if x' == x then Nothing else Just x') (current d) (updated d)
101+ let e' = attachWithMaybe (\x x' -> if x' `eq` x then Nothing else Just x') (current d) (updated d)
112− in unsafeDynamic (current d) e' --TODO: Avoid invalidating the outgoing Behavior
102+ in unsafeDynamic (current d) e'
113−
103+
114−-- | Map a function over a 'Dynamic'.
115−mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)
116−mapDyn f = return . fmap f
117−
118−-- | Flipped version of 'mapDyn'.
119−forDyn :: (Reflex t, Monad m) => Dynamic t a -> (a -> b) -> m (Dynamic t b)
120−forDyn = flip mapDyn
121−
122−-- | Create a 'Dynamic' using the initial value and change it each
104+-- | Create a 'Dynamic' using the initial value and change it each time the
123−-- time the 'Event' occurs using a folding function on the previous
105+-- 'Event' occurs using a folding function on the previous value and the value
124−-- value and the value of the 'Event'.
106+-- of the 'Event'.
125foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
107foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
126foldDyn = accum . flip
108foldDyn = accum . flip
127
109
128−-- | Create a 'Dynamic' using the initial value and change it each
110+-- | Like 'foldDyn', but the combining function is a 'PushM' action, so it
129−-- time the 'Event' occurs using a monadic folding function on the
111+-- can 'sample' existing 'Behaviors' and 'hold' new ones.
130−-- previous value and the value of the 'Event'.
131foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
112foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
132foldDynM = accumM . flip
113foldDynM = accumM . flip
133
114
115+-- | Create a 'Dynamic' using the provided initial value and change it each time
116+-- the provided 'Event' occurs, using a function to combine the old value with
117+-- the 'Event''s value. If the function returns 'Nothing', the value is not
118+-- changed; this is distinct from returning 'Just' the old value, since the
119+-- 'Dynamic''s 'updated' 'Event' will fire in the 'Just' case, and will not fire
120+-- in the 'Nothing' case.
134foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
121foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
135foldDynMaybe = accumMaybe . flip
122foldDynMaybe = accumMaybe . flip
136
123
124+-- | Like 'foldDynMaybe', but the combining function is a 'PushM' action, so it
125+-- can 'sample' existing 'Behaviors' and 'hold' new ones.
137foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
126foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
138foldDynMaybeM = accumMaybeM . flip
127foldDynMaybeM = accumMaybeM . flip
139
128
@@ -146,78 +135,30 @@ count e = holdDyn 0 =<< zipListWithEvent const (iterate (+1) 1) e
146toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
135toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
147toggle = foldDyn (const not)
136toggle = foldDyn (const not)
148
137
149−-- | Switches to the new 'Event' whenever it receives one. Switching
138+-- | Switches to the new 'Event' whenever it receives one. Switching occurs
150−-- occurs *before* the inner 'Event' fires - so if the 'Dynamic' changes and both the old and new
139+-- *before* the inner 'Event' fires - so if the 'Dynamic' changes and both the
151−-- inner Events fire simultaneously, the output will fire with the value of the *new* 'Event'.
140+-- old and new inner Events fire simultaneously, the output will fire with the
141+-- value of the *new* 'Event'.
152switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
142switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
153switchPromptlyDyn de =
143switchPromptlyDyn de =
154 let eLag = switch $ current de
144 let eLag = switch $ current de
155 eCoincidences = coincidence $ updated de
145 eCoincidences = coincidence $ updated de
156 in leftmost [eCoincidences, eLag]
146 in leftmost [eCoincidences, eLag]
157
147
158−{-
159−
160−mergeEventsWith :: Reflex t m => (a -> a -> a) -> Event t a -> Event t a -> m (Event t a)
161−mergeEventsWith f ea eb = mapE (mergeThese f) =<< alignEvents ea eb
162−
163−firstE :: (Reflex t m) => [Event t a] -> m (Event t a)
164−firstE [] = return never
165−firstE (h:t) = mergeEventsLeftBiased h =<< firstE t
166−
167−concatEventsWith :: (Reflex t m) => (a -> a -> a) -> [Event t a] -> m (Event t a)
168−concatEventsWith _ [] = return never
169−concatEventsWith _ [e] = return e
170−concatEventsWith f es = mapEM (fmap (foldl1 f . map (\(Const2 _ :=> v) -> v) . DMap.toList) . sequenceDmap) <=< mergeEventDMap $ DMap.fromList $ map (\(k, v) -> WrapArg (Const2 k) :=> v) $ zip [0 :: Int ..] es
171−--concatEventsWith f (h:t) = mergeEventsWith f h =<< concatEventsWith f t
172−
173−mconcatE :: (Reflex t m, Monoid a) => [Event t a] -> m (Event t a)
174−mconcatE = concatEventsWith mappend
175−-}
176−
177−-- | Split the 'Dynamic' into two 'Dynamic's, each taking the
148+-- | Split a 'Dynamic' pair into a pair of 'Dynamic's
178−-- respective value of the tuple.
179−splitDyn :: (Reflex t, Monad m) => Dynamic t (a, b) -> m (Dynamic t a, Dynamic t b)
180−splitDyn = return . splitDynPure
181−
182splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
149splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
183splitDynPure d = (fmap fst d, fmap snd d)
150splitDynPure d = (fmap fst d, fmap snd d)
184
151
185−-- | Merge the 'Dynamic' values using their 'Monoid' instance.
186−mconcatDyn :: forall t m a. (Reflex t, Monad m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
187−mconcatDyn = return . mconcat
188−
189−-- | Create a 'Dynamic' with a 'DMap' of values out of a 'DMap' of
152+-- | Create a 'Dynamic' with a 'DMap' of values out of a 'DMap' of 'Dynamic'
190−-- Dynamic values.
153+-- values. The resulting 'Dynamic' will change whenever one of the input
191−distributeDMapOverDyn :: (Reflex t, Monad m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
154+-- 'Dynamic's changes.
192−distributeDMapOverDyn = return . distributeDMapOverDynPure
155+--
193−
156+-- This function's implementation is more efficient than simply using
157+-- 'zipDynWith' or applicative syntax to achieve the same result, especially for
158+-- maps with many elements.
194distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
159distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
195distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap
160distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap
196
161
197−-- | Merge two 'Dynamic's into a new one using the provided
198−-- function. The new 'Dynamic' changes its value each time one of the
199−-- original 'Dynamic's changes its value.
200−combineDyn :: forall t m a b c. (Reflex t, Monad m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
201−combineDyn f da db = return $ zipDynWith f da db
202−
203−-- | A psuedo applicative version of ap for 'Dynamic'. Example useage:
204−--
205−-- > do
206−-- > person <- Person `mapDyn` dynFirstName
207−-- > `apDyn` dynListName
208−-- > `apDyn` dynAge
209−-- > `apDyn` dynAddress
210−apDyn :: forall t m a b. (Reflex t, Monad m)
211− => m (Dynamic t (a -> b))
212− -> Dynamic t a
213− -> m (Dynamic t b)
214−apDyn m a = do
215− r <- m
216− return $ r <*> a
217−
218−joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a
219−joinDyn = join
220−
221--TODO: Generalize this to functors other than Maps
162--TODO: Generalize this to functors other than Maps
222-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
163-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'
223-- with the current values of the 'Dynamic's in a map.
164-- with the current values of the 'Dynamic's in a map.
@@ -249,37 +190,38 @@ traceDynWith f d =
249-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
190-- | Replace the value of the 'Event' with the current value of the 'Dynamic'
250-- each time the 'Event' occurs.
191-- each time the 'Event' occurs.
251--
192--
252−-- Note: `tagDyn d e` differs from `tag (current d) e` in the case that `e` is firing
193+-- Note: `tagPromptlyDyn d e` differs from `tag (current d) e` in the case that `e` is firing
253−-- at the same time that `d` is changing. With `tagDyn d e`, the *new* value of `d`
194+-- at the same time that `d` is changing. With `tagPromptlyDyn d e`, the *new* value of `d`
254-- will replace the value of `e`, whereas with `tag (current d) e`, the *old* value
195-- will replace the value of `e`, whereas with `tag (current d) e`, the *old* value
255-- will be used, since the 'Behavior' won't be updated until the end of the frame.
196-- will be used, since the 'Behavior' won't be updated until the end of the frame.
256-- Additionally, this means that the output 'Event' may not be used to directly change
197-- Additionally, this means that the output 'Event' may not be used to directly change
257-- the input 'Dynamic', because that would mean its value depends on itself. When creating
198-- the input 'Dynamic', because that would mean its value depends on itself. When creating
258-- cyclic data flows, generally `tag (current d) e` is preferred.
199-- cyclic data flows, generally `tag (current d) e` is preferred.
259−tagDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
200+tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
260−tagDyn = attachDynWith const
201+tagPromptlyDyn = attachPromptlyDynWith const
261
202
262-- | Attach the current value of the 'Dynamic' to the value of the
203-- | Attach the current value of the 'Dynamic' to the value of the
263-- 'Event' each time it occurs.
204-- 'Event' each time it occurs.
264--
205--
265−-- Note: `attachDyn d` is not the same as `attach (current d)`. See 'tagDyn' for details.
206+-- Note: `attachPromptlyDyn d` is not the same as `attach (current d)`. See 'tagPromptlyDyn' for details.
266−attachDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
207+attachPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
267−attachDyn = attachDynWith (,)
208+attachPromptlyDyn = attachPromptlyDynWith (,)
268
209
269-- | Combine the current value of the 'Dynamic' with the value of the
210-- | Combine the current value of the 'Dynamic' with the value of the
270-- 'Event' each time it occurs.
211-- 'Event' each time it occurs.
271--
212--
272−-- Note: `attachDynWith f d` is not the same as `attachWith f (current d)`. See 'tagDyn' for details.
213+-- Note: `attachPromptlyDynWith f d` is not the same as `attachWith f (current d)`. See 'tagPromptlyDyn' for details.
273−attachDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
214+attachPromptlyDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
274−attachDynWith f = attachDynWithMaybe $ \a b -> Just $ f a b
215+attachPromptlyDynWith f = attachPromptlyDynWithMaybe $ \a b -> Just $ f a b
275
216
276−-- | Create a new 'Event' by combining the value at each occurence
217+-- | Create a new 'Event' by combining the value at each occurence with the
277−-- with the current value of the 'Dynamic' value and possibly
218+-- current value of the 'Dynamic' value and possibly filtering if the combining
278−-- filtering if the combining function returns 'Nothing'.
219+-- function returns 'Nothing'.
279--
220--
280−-- Note: `attachDynWithMaybe f d` is not the same as `attachWithMaybe f (current d)`. See 'tagDyn' for details.
221+-- Note: `attachPromptlyDynWithMaybe f d` is not the same as `attachWithMaybe f
222+-- (current d)`. See 'tagPromptlyDyn' for details.
281−attachDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
223+attachPromptlyDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
282−attachDynWithMaybe f d e =
224+attachPromptlyDynWithMaybe f d e =
283 let e' = attach (current d) e
225 let e' = attach (current d) e
284 in fforMaybe (align e' $ updated d) $ \case
226 in fforMaybe (align e' $ updated d) $ \case
285 This (a, b) -> f a b -- Only the tagging event is firing, so use that
227 This (a, b) -> f a b -- Only the tagging event is firing, so use that
@@ -290,19 +232,23 @@ attachDynWithMaybe f d e =
290-- Demux
232-- Demux
291--------------------------------------------------------------------------------
233--------------------------------------------------------------------------------
292
234
293−-- | Represents a time changing value together with an 'EventSelector'
235+-- | Represents a time changing value together with an 'EventSelector' that can
294−-- that can efficiently detect when the underlying Dynamic has a particular value.
236+-- efficiently detect when the underlying 'Dynamic' has a particular value.
295−-- This is useful for representing data like the current selection of a long list.
237+-- This is useful for representing data like the current selection of a long
238+-- list.
296--
239--
297-- Semantically,
240-- Semantically,
241+--
298−-- > getDemuxed (demux d) k === mapDyn (== k) d
242+-- > demuxed (demux d) k === fmap (== k) d
243+--
299−-- However, the when getDemuxed is used multiple times, the complexity is only /O(log(n))/,
244+-- However, the when getDemuxed is used multiple times, the complexity is only
300−-- rather than /O(n)/ for mapDyn.
245+-- /O(log(n))/, rather than /O(n)/ for fmap.
301data Demux t k = Demux { demuxValue :: Behavior t k
246data Demux t k = Demux { demuxValue :: Behavior t k
302 , demuxSelector :: EventSelector t (Const2 k Bool)
247 , demuxSelector :: EventSelector t (Const2 k Bool)
303 }
248 }
304
249
250+-- | Demultiplex an input value to a 'Demux' with many outputs. At any given
305−-- | Demultiplex an input value to a 'Demux' with many outputs. At any given time, whichever output is indicated by the given 'Dynamic' will be 'True'.
251+-- time, whichever output is indicated by the given 'Dynamic' will be 'True'.
306demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
252demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
307demux k = Demux (current k)
253demux k = Demux (current k)
308 (fan $ attachWith (\k0 k1 -> if k0 == k1
254 (fan $ attachWith (\k0 k1 -> if k0 == k1
@@ -311,12 +257,9 @@ demux k = Demux (current k)
311 Const2 k1 :=> Identity True])
257 Const2 k1 :=> Identity True])
312 (current k) (updated k))
258 (current k) (updated k))
313
259
314−--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
315−-- | Select a particular output of the 'Demux'; this is equivalent to (but much faster than)
260+-- | Select a particular output of the 'Demux'; this is equivalent to (but much
316−-- mapping over the original 'Dynamic' and checking whether it is equal to the given key.
261+-- faster than) mapping over the original 'Dynamic' and checking whether it is
317−getDemuxed :: (Reflex t, Monad m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
262+-- equal to the given key.
318−getDemuxed d k = return $ demuxed d k
319−
320demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
263demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
321demuxed d k =
264demuxed d k =
322 let e = select (demuxSelector d) (Const2 k)
265 let e = select (demuxSelector d) (Const2 k)
@@ -328,6 +271,41 @@ demuxed d k =
328
271
329--TODO: This whole section is badly in need of cleanup
272--TODO: This whole section is badly in need of cleanup
330
273
274+-- | A heterogeneous list whose type and length are fixed statically. This is
275+-- reproduced from the 'HList' package due to integration issues, and because
276+-- very little other functionality from that library is needed.
277+data HList (l::[*]) where
278+ HNil :: HList '[]
279+ HCons :: e -> HList l -> HList (e ': l)
280+
281+infixr 2 `HCons`
282+
283+type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
284+type instance HRevApp '[] l = l
285+type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
286+
287+hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
288+hRevApp HNil l = l
289+hRevApp (HCons x l) l' = hRevApp l (HCons x l')
290+
291+hReverse :: HList l -> HList (HRevApp l '[])
292+hReverse l = hRevApp l HNil
293+
294+hBuild :: (HBuild' '[] r) => r
295+hBuild = hBuild' HNil
296+
297+class HBuild' l r where
298+ hBuild' :: HList l -> r
299+
300+instance (l' ~ HRevApp l '[])
301+ => HBuild' l (HList l') where
302+ hBuild' = hReverse
303+
304+instance HBuild' (a ': l) r
305+ => HBuild' l (a->r) where
306+ hBuild' l x = hBuild' (HCons x l)
307+
308+-- | Like 'HList', but with a functor wrapping each element.
331data FHList f l where
309data FHList f l where
332 FHNil :: FHList f '[]
310 FHNil :: FHList f '[]
333 FHCons :: f e -> FHList f l -> FHList f (e ': l)
311 FHCons :: f e -> FHList f l -> FHList f (e ': l)
@@ -378,9 +356,9 @@ instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
378dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
356dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
379dmapToHList = rebuildSortedHList . DMap.toList
357dmapToHList = rebuildSortedHList . DMap.toList
380
358
381−distributeFHListOverDyn :: forall t m l. (Reflex t, Monad m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
359+-- | Collect a hetereogeneous list whose elements are all 'Dynamic's into a
382−distributeFHListOverDyn = return . distributeFHListOverDynPure
360+-- single 'Dynamic' whose value represents the current values of all of the
383−
361+-- input 'Dynamic's.
384distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
362distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
385distributeFHListOverDynPure l = fmap dmapToHList $ distributeDMapOverDynPure $ fhlistToDMap l
363distributeFHListOverDynPure l = fmap dmapToHList $ distributeDMapOverDynPure $ fhlistToDMap l
386
364
@@ -407,14 +385,9 @@ instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
407#endif
385#endif
408 fromFHList (a `FHCons` b) = a `HCons` fromFHList b
386 fromFHList (a `FHCons` b) = a `HCons` fromFHList b
409
387
410−collectDyn :: ( RebuildSortedHList (HListElems b)
388+-- | Convert a datastructure whose constituent parts are all 'Dynamic's into a
411− , IsHList a, IsHList b
389+-- single 'Dynamic' whose value represents all the current values of the input's
412− , AllAreFunctors (Dynamic t) (HListElems b)
413− , Reflex t, Monad m
414− , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
415− ) => a -> m (Dynamic t b)
390+-- consitutent 'Dynamic's.
416−collectDyn = return . collectDynPure
417−
418collectDynPure :: ( RebuildSortedHList (HListElems b)
391collectDynPure :: ( RebuildSortedHList (HListElems b)
419 , IsHList a, IsHList b
392 , IsHList a, IsHList b
420 , AllAreFunctors (Dynamic t) (HListElems b)
393 , AllAreFunctors (Dynamic t) (HListElems b)
@@ -455,3 +428,115 @@ instance IsHList (a, b, c, d, e, f) where
455#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
428#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
456 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
429 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
457#endif
430#endif
431+
432+--------------------------------------------------------------------------------
433+-- Deprecated functions
434+--------------------------------------------------------------------------------
435+
436+-- | Map a function over a 'Dynamic'.
437+{-# DEPRECATED mapDyn "Use 'return . fmap f' instead of 'mapDyn f'; consider eliminating monadic style" #-}
438+mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)
439+mapDyn f = return . fmap f
440+
441+-- | Flipped version of 'mapDyn'.
442+{-# DEPRECATED forDyn "Use 'return . ffor a' instead of 'forDyn a'; consider eliminating monadic style" #-}
443+forDyn :: (Reflex t, Monad m) => Dynamic t a -> (a -> b) -> m (Dynamic t b)
444+forDyn a = return . ffor a
445+
446+-- | Split the 'Dynamic' into two 'Dynamic's, each taking the respective value
447+-- of the tuple.
448+{-# DEPRECATED splitDyn "Use 'return . splitDynPure' instead; consider eliminating monadic style" #-}
449+splitDyn :: (Reflex t, Monad m) => Dynamic t (a, b) -> m (Dynamic t a, Dynamic t b)
450+splitDyn = return . splitDynPure
451+
452+-- | Merge the 'Dynamic' values using their 'Monoid' instance.
453+{-# DEPRECATED mconcatDyn "Use 'return . mconcat' instead; consider eliminating monadic style" #-}
454+mconcatDyn :: forall t m a. (Reflex t, Monad m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)
455+mconcatDyn = return . mconcat
456+
457+-- | This function no longer needs to be monadic; see 'distributeMapOverDynPure'.
458+{-# DEPRECATED distributeDMapOverDyn "Use 'return . distributeDMapOverDynPure' instead; consider eliminating monadic style" #-}
459+distributeDMapOverDyn :: (Reflex t, Monad m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))
460+distributeDMapOverDyn = return . distributeDMapOverDynPure
461+
462+-- | Merge two 'Dynamic's into a new one using the provided function. The new
463+-- 'Dynamic' changes its value each time one of the original 'Dynamic's changes
464+-- its value.
465+{-# DEPRECATED combineDyn "Use 'return (zipDynWith f a b)' instead of 'combineDyn f a b'; consider eliminating monadic style" #-}
466+combineDyn :: forall t m a b c. (Reflex t, Monad m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)
467+combineDyn f a b = return $ zipDynWith f a b
468+
469+-- | A psuedo applicative version of ap for 'Dynamic'. Example useage:
470+--
471+-- > do
472+-- > person <- Person `mapDyn` dynFirstName
473+-- > `apDyn` dynListName
474+-- > `apDyn` dynAge
475+-- > `apDyn` dynAddress
476+{-# DEPRECATED apDyn "Use 'ffor m (<*> a)' instead of 'apDyn m a'; consider eliminating monadic style, since Dynamics are now Applicative and can be used with applicative style directly" #-}
477+apDyn :: forall t m a b. (Reflex t, Monad m)
478+ => m (Dynamic t (a -> b))
479+ -> Dynamic t a
480+ -> m (Dynamic t b)
481+apDyn m a = ffor m (<*> a)
482+
483+--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out
484+-- | This function no longer needs to be monadic, so it has been replaced by
485+-- 'demuxed', which is pure.
486+{-# DEPRECATED getDemuxed "Use 'return . demuxed d' instead of 'getDemuxed d'; consider eliminating monadic style" #-}
487+getDemuxed :: (Reflex t, Monad m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)
488+getDemuxed d = return . demuxed d
489+
490+-- | This function no longer needs to be monadic, so it has been replaced by
491+-- 'distributeFHListOverDynPure', which is pure.
492+{-# DEPRECATED distributeFHListOverDyn "Use 'return . distributeFHListOverDynPure' instead; consider eliminating monadic style" #-}
493+distributeFHListOverDyn :: forall t m l. (Reflex t, Monad m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))
494+distributeFHListOverDyn = return . distributeFHListOverDynPure
495+
496+-- | This function no longer needs to be monadic, so it has been replaced by
497+-- 'collectDynPure', which is pure.
498+{-# DEPRECATED collectDyn "Use 'return . collectDynPure' instead; consider eliminating monadic style" #-}
499+collectDyn :: ( RebuildSortedHList (HListElems b)
500+ , IsHList a, IsHList b
501+ , AllAreFunctors (Dynamic t) (HListElems b)
502+ , Reflex t, Monad m
503+ , HListElems a ~ FunctorList (Dynamic t) (HListElems b)
504+ ) => a -> m (Dynamic t b)
505+collectDyn = return . collectDynPure
506+
507+-- | This function has been renamed to 'tagPromptlyDyn' to clarify its
508+-- semantics.
509+{-# DEPRECATED tagDyn "Use 'tagPromptlyDyn' instead" #-}
510+tagDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
511+tagDyn = tagPromptlyDyn
512+
513+-- | This function has been renamed to 'attachPromptlyDyn' to clarify its
514+-- semantics.
515+{-# DEPRECATED attachDyn "Use 'attachPromptlyDyn' instead" #-}
516+attachDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
517+attachDyn = attachPromptlyDyn
518+
519+-- | This function has been renamed to 'attachPromptlyDynWith' to clarify its
520+-- semantics.
521+{-# DEPRECATED attachDynWith "Use 'attachPromptlyDynWith' instead" #-}
522+attachDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
523+attachDynWith = attachPromptlyDynWith
524+
525+-- | This function has been renamed to 'attachPromptlyDynWithMaybe' to clarify
526+-- its semantics.
527+{-# DEPRECATED attachDynWithMaybe "Use 'attachPromptlyDynWithMaybe' instead" #-}
528+attachDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
529+attachDynWithMaybe = attachPromptlyDynWithMaybe
530+
531+-- | Combine an inner and outer 'Dynamic' such that the resulting 'Dynamic''s
532+-- current value will always be equal to the current value's current value, and
533+-- will change whenever either the inner or the outer (or both) values change.
534+{-# DEPRECATED joinDyn "Use 'join' instead" #-}
535+joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a
536+joinDyn = join
537+
538+-- | 'nubDyn''s behavior is not quite analogous to 'nub''s behavior, so it has
539+-- been renamed to 'uniqDyn'
540+{-# DEPRECATED nubDyn "Use 'uniqDyn' instead" #-}
541+nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a
542+nubDyn = uniqDyn
src/Reflex/Dynamic/Nub.hs+44−6
@@ -1,6 +1,8 @@
1{-# LANGUAGE FlexibleInstances #-}
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE MagicHash #-}
2{-# LANGUAGE MagicHash #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE MultiParamTypeClasses #-}
4+-- | This module provides a variation of 'Dynamic' values that uses cheap
5+-- pointer equality checks to reduce the amount of signal propagation needed.
4module Reflex.Dynamic.Nub
6module Reflex.Dynamic.Nub
5 ( NubDynamic
7 ( NubDynamic
6 , nubDynamic
8 , nubDynamic
@@ -13,25 +15,61 @@ import GHC.Exts
13import Reflex.Class
15import Reflex.Class
14import Reflex.Dynamic
16import Reflex.Dynamic
15
17
18+-- | A 'Dynamic' whose 'updated' 'Event' will never fire with the same value as
19+-- the 'current' 'Behavior''s contents. In order to maintain this constraint,
20+-- the value inside a 'NubDynamic' is always evaluated to
21+-- <https://wiki.haskell.org/Weak_head_normal_form weak head normal form>.
22+--
23+-- Internally, 'NubDynamic' uses pointer equality as a heuristic to avoid
24+-- unnecessary update propagation; this is much more efficient than performing
25+-- full comparisons. However, when the 'NubDynamic' is converted back into a
26+-- regular 'Dynamic', a full comparison is performed.
16newtype NubDynamic t a = NubDynamic { unNubDynamic :: Dynamic t a }
27newtype NubDynamic t a = NubDynamic { unNubDynamic :: Dynamic t a }
17
28
29+-- | Construct a 'NubDynamic' by eliminating redundant updates from a 'Dynamic'.
18nubDynamic :: Reflex t => Dynamic t a -> NubDynamic t a
30nubDynamic :: Reflex t => Dynamic t a -> NubDynamic t a
19nubDynamic d = NubDynamic $ unsafeBuildDynamic (sample $ current d) $ flip push (updated d) $ \new -> do --TODO: It would be very nice if we had an uncached push here
31nubDynamic d = NubDynamic $ unsafeBuildDynamic (sample $ current d) $ flip push (updated d) $ \new -> do --TODO: It would be very nice if we had an uncached push here
20 old <- sample $ current d --TODO: Is it better to sample ourselves here?
32 old <- sample $ current d --TODO: Is it better to sample ourselves here?
21 return $ unsafeJustChanged old new
33 return $ unsafeJustChanged old new
22
34
35+-- | Retrieve a normal 'Dynamic' from a 'NubDynamic'. This will perform a final
36+-- check using the output type's 'Eq' instance to ensure deterministic behavior.
37+--
38+-- WARNING: If used with a type whose 'Eq' instance is not law-abiding -
39+-- specifically, if there are cases where @x /= x@, 'fromNubDynamic' may
40+-- eliminate more 'updated' occurrences than it should. For example, NaN values
41+-- of 'Double' and 'Float' are considered unequal to themselves by the 'Eq'
42+-- instance, but can be equal by pointer equality. This may cause 'NubDynamic'
43+-- to lose changes from NaN to NaN.
23fromNubDynamic :: (Reflex t, Eq a) => NubDynamic t a -> Dynamic t a
44fromNubDynamic :: (Reflex t, Eq a) => NubDynamic t a -> Dynamic t a
24−fromNubDynamic (NubDynamic d) = nubDyn d
45+fromNubDynamic (NubDynamic d) = uniqDynBy superEq d
46+ where
47+ -- Only consider values different if they fail both pointer equality /and/
48+ -- 'Eq' equality. This is to make things a bit more deterministic in the
49+ -- case of unlawful 'Eq' instances. However, it is still possible to
50+ -- achieve nondeterminism by constructing elements that are identical in
51+ -- value, unequal according to 'Eq', and nondeterministically equal or
52+ -- nonequal by pointer quality. I suspect that it is impossible to make the
53+ -- behavior deterministic in this case.
54+ superEq a b = a `unsafePtrEq` b || a == b
25
55
26−-- | Create a NubDynamic without nubbing it on creation
56+-- | Create a NubDynamic without nubbing it on creation. This will be slightly
57+-- faster than nubDynamic when used with a Dynamic whose values are always (or
58+-- nearly always) different from its previous values; if used with a Dynamic
27−-- This will be slightly faster than nubDynamic when used with a Dynamic whose values are always (or nearly always) different from its previous values; if used with a Dynamic whose values do not change frequently, it may be much slower than nubDynamic
59+-- whose values do not change frequently, it may be much slower than nubDynamic
28alreadyNubbedDynamic :: Dynamic t a -> NubDynamic t a
60alreadyNubbedDynamic :: Dynamic t a -> NubDynamic t a
29alreadyNubbedDynamic = NubDynamic
61alreadyNubbedDynamic = NubDynamic
30
62
63+unsafePtrEq :: a -> a -> Bool
64+unsafePtrEq a b = case a `seq` b `seq` reallyUnsafePtrEquality# a b of
65+ 0# -> False
66+ _ -> True
67+
31unsafeJustChanged :: a -> a -> Maybe a
68unsafeJustChanged :: a -> a -> Maybe a
32−unsafeJustChanged old new = case old `seq` new `seq` reallyUnsafePtrEquality# old new of
69+unsafeJustChanged old new =
33− 0# -> Just new
70+ if old `unsafePtrEq` new
34− _ -> Nothing
71+ then Nothing
72+ else Just new
35
73
36instance Reflex t => Accumulator t (NubDynamic t) where
74instance Reflex t => Accumulator t (NubDynamic t) where
37 accumMaybeM f z e = do
75 accumMaybeM f z e = do
src/Reflex/Dynamic/TH.hs+20−4
@@ -4,6 +4,7 @@
4{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE TemplateHaskell #-}
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
7+-- | Template Haskell helper functions for building complex 'Dynamic' values.
7module Reflex.Dynamic.TH (qDyn, unqDyn, mkDyn) where
8module Reflex.Dynamic.TH (qDyn, unqDyn, mkDyn) where
8
9
9import Reflex.Dynamic
10import Reflex.Dynamic
@@ -18,7 +19,9 @@ import Language.Haskell.TH
18import Language.Haskell.TH.Quote
19import Language.Haskell.TH.Quote
19import qualified Language.Haskell.TH.Syntax as TH
20import qualified Language.Haskell.TH.Syntax as TH
20
21
21−-- | Quote a Dynamic expression. Within the quoted expression, you can use '$(unqDyn [| x |])' to refer to any expression 'x' of type 'Dynamic t a'; the unquoted result will be of type 'a'
22+-- | Quote a 'Dynamic' expression. Within the quoted expression, you can use
23+-- @$(unqDyn [| x |])@ to refer to any expression @x@ of type @Dynamic t a@; the
24+-- unquoted result will be of type @a@
22qDyn :: Q Exp -> Q Exp
25qDyn :: Q Exp -> Q Exp
23qDyn qe = do
26qDyn qe = do
24 e <- qe
27 e <- qe
@@ -35,19 +38,32 @@ qDyn qe = do
35 let exprs = reverse exprsReversed
38 let exprs = reverse exprsReversed
36 arg = foldr (\a b -> ConE 'FHCons `AppE` a `AppE` b) (ConE 'FHNil) $ map snd exprs
39 arg = foldr (\a b -> ConE 'FHCons `AppE` a `AppE` b) (ConE 'FHNil) $ map snd exprs
37 param = foldr (\a b -> ConP 'HCons [VarP a, b]) (ConP 'HNil []) $ map fst exprs
40 param = foldr (\a b -> ConP 'HCons [VarP a, b]) (ConP 'HNil []) $ map fst exprs
38− [| mapDyn $(return $ LamE [param] e') =<< distributeFHListOverDyn $(return arg) |]
41+ [| return $ $(return $ LamE [param] e') $ distributeFHListOverDynPure $(return arg) |]
39
42
43+-- | Antiquote a 'Dynamic' expression. This can /only/ be used inside of a
44+-- 'qDyn' quotation.
40unqDyn :: Q Exp -> Q Exp
45unqDyn :: Q Exp -> Q Exp
41unqDyn e = [| unqMarker $e |]
46unqDyn e = [| unqMarker $e |]
42
47
43−-- | This type represents an occurrence of unqDyn before it has been processed by qDyn. If you see it in a type error, it probably means that unqDyn has been used outside of a qDyn context.
48+-- | This type represents an occurrence of unqDyn before it has been processed
49+-- by qDyn. If you see it in a type error, it probably means that unqDyn has
50+-- been used outside of a qDyn context.
44data UnqDyn
51data UnqDyn
45
52
46−-- unqMarker must not be exported; it is used only as a way of smuggling data from unqDyn to qDyn
53+-- unqMarker must not be exported; it is used only as a way of smuggling data
54+-- from unqDyn to qDyn
55+
47--TODO: It would be much nicer if the TH AST was extensible to support this kind of thing without trickery
56--TODO: It would be much nicer if the TH AST was extensible to support this kind of thing without trickery
48unqMarker :: a -> UnqDyn
57unqMarker :: a -> UnqDyn
49unqMarker = error "An unqDyn expression was used outside of a qDyn expression"
58unqMarker = error "An unqDyn expression was used outside of a qDyn expression"
50
59
60+-- | Create a 'Dynamic' value using other 'Dynamic's as inputs. The result is
61+-- sometimes more concise and readable than the equivalent 'Applicative'-based
62+-- expression. For example:
63+--
64+-- > [mkDyn| $x + $v * $t + 1/2 * $a * $t ^ 2 |]
65+--
66+-- would have a very cumbersome 'Applicative' encoding.
51mkDyn :: QuasiQuoter
67mkDyn :: QuasiQuoter
52mkDyn = QuasiQuoter
68mkDyn = QuasiQuoter
53 { quoteExp = mkDynExp
69 { quoteExp = mkDynExp
src/Reflex/Host/Class.hs+82−37
@@ -9,7 +9,20 @@
9{-# LANGUAGE ScopedTypeVariables #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE UndecidableInstances #-}
11{-# LANGUAGE UndecidableInstances #-}
12+-- | This module provides the interface for hosting 'Reflex' engines. This
13+-- should only be necessary if you're writing a binding or some other library
14+-- that provides a core event loop.
12−module Reflex.Host.Class where
15+module Reflex.Host.Class
16+ ( ReflexHost (..)
17+ , MonadSubscribeEvent (..)
18+ , MonadReadEvent (..)
19+ , MonadReflexCreateTrigger (..)
20+ , MonadReflexHost (..)
21+ , fireEvents
22+ , newEventWithTriggerRef
23+ , fireEventRef
24+ , fireEventRefAndRead
25+ ) where
13
26
14import Reflex.Class
27import Reflex.Class
15
28
@@ -33,33 +46,47 @@ import Data.Monoid
33-- Note: this import must come last to silence warnings from AMP
46-- Note: this import must come last to silence warnings from AMP
34import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
47import Prelude hiding (foldl, mapM, mapM_, sequence, sequence_)
35
48
36−-- | Framework implementation support class for the reflex implementation represented by @t@.
49+-- | Framework implementation support class for the reflex implementation
37−class (Reflex t, MonadReflexCreateTrigger t (HostFrame t), MonadSample t (HostFrame t), MonadHold t (HostFrame t), MonadFix (HostFrame t), MonadSubscribeEvent t (HostFrame t)) => ReflexHost t where
50+-- represented by @t@.
51+class ( Reflex t
52+ , MonadReflexCreateTrigger t (HostFrame t)
53+ , MonadSample t (HostFrame t)
54+ , MonadHold t (HostFrame t)
55+ , MonadFix (HostFrame t)
56+ , MonadSubscribeEvent t (HostFrame t)
57+ ) => ReflexHost t where
38 type EventTrigger t :: * -> *
58 type EventTrigger t :: * -> *
39 type EventHandle t :: * -> *
59 type EventHandle t :: * -> *
40 type HostFrame t :: * -> *
60 type HostFrame t :: * -> *
41
61
62+-- | Monad in which Events can be 'subscribed'. This forces all underlying
63+-- event sources to be initialized, so that the event will fire whenever it
42−-- | Monad in which Events can be 'subscribed'. This forces all underlying event sources to be initialized, so that the event will fire whenever it ought to. Events must be subscribed before they are read using readEvent
64+-- ought to. Events must be subscribed before they are read using readEvent
43class (Reflex t, Monad m) => MonadSubscribeEvent t m | m -> t where
65class (Reflex t, Monad m) => MonadSubscribeEvent t m | m -> t where
44 -- | Subscribe to an event and set it up if needed.
66 -- | Subscribe to an event and set it up if needed.
45 --
67 --
46− -- This function will create a new 'EventHandle' from an 'Event'. This handle may then be used via
68+ -- This function will create a new 'EventHandle' from an 'Event'. This handle
47− -- 'readEvent' in the read callback of 'fireEventsAndRead'.
69+ -- may then be used via 'readEvent' in the read callback of
70+ -- 'fireEventsAndRead'.
48 --
71 --
49− -- If the event wasn't subscribed to before (either manually or through a dependent event or behavior)
72+ -- If the event wasn't subscribed to before (either manually or through a
50− -- then this function will cause the event and all dependencies of this event to be set up.
73+ -- dependent event or behavior) then this function will cause the event and
74+ -- all dependencies of this event to be set up. For example, if the event was
51− -- For example, if the event was created by 'newEventWithTrigger', then it's callback will be executed.
75+ -- created by 'newEventWithTrigger', then it's callback will be executed.
52 --
76 --
53 -- It's safe to call this function multiple times.
77 -- It's safe to call this function multiple times.
54 subscribeEvent :: Event t a -> m (EventHandle t a)
78 subscribeEvent :: Event t a -> m (EventHandle t a)
55
79
56-- | Monad that allows to read events' values.
80-- | Monad that allows to read events' values.
57class (ReflexHost t, Applicative m, Monad m) => MonadReadEvent t m | m -> t where
81class (ReflexHost t, Applicative m, Monad m) => MonadReadEvent t m | m -> t where
58− -- | Read the value of an 'Event' from an 'EventHandle' (created by calling 'subscribeEvent').
82+ -- | Read the value of an 'Event' from an 'EventHandle' (created by calling
83+ -- 'subscribeEvent').
59 --
84 --
60− -- After event propagation is done, all events can be in two states: either they are firing with some value or they are not firing.
85+ -- After event propagation is done, all events can be in two states: either
86+ -- they are firing with some value or they are not firing. In the former
61− -- In the former case, this function returns @Just act@, where @act@ in an action to read the current value of
87+ -- case, this function returns @Just act@, where @act@ in an action to read
62− -- the event. In the latter case, the function returns @Nothing@.
88+ -- the current value of the event. In the latter case, the function returns
89+ -- @Nothing@.
63 --
90 --
64 -- This function is normally used in the calllback for 'fireEventsAndRead'.
91 -- This function is normally used in the calllback for 'fireEventsAndRead'.
65 readEvent :: EventHandle t a -> m (Maybe (m a))
92 readEvent :: EventHandle t a -> m (Maybe (m a))
@@ -68,42 +95,54 @@ class (ReflexHost t, Applicative m, Monad m) => MonadReadEvent t m | m -> t wher
68class (Applicative m, Monad m) => MonadReflexCreateTrigger t m | m -> t where
95class (Applicative m, Monad m) => MonadReflexCreateTrigger t m | m -> t where
69 -- | Creates a root 'Event' (one that is not based on any other event).
96 -- | Creates a root 'Event' (one that is not based on any other event).
70 --
97 --
71− -- When a subscriber first subscribes to an event (building another event
98+ -- When a subscriber first subscribes to an event (building another event that
72− -- that depends on the subscription) the given callback function is run and
99+ -- depends on the subscription) the given callback function is run and passed
73− -- passed a trigger. The callback function can then set up the event source in IO.
100+ -- a trigger. The callback function can then set up the event source in IO.
74− -- After this is done, the callback function must return an accompanying teardown action.
101+ -- After this is done, the callback function must return an accompanying
102+ -- teardown action.
75 --
103 --
76− -- Any time between setup and teardown the trigger can be used to fire
104+ -- Any time between setup and teardown the trigger can be used to fire the
77− -- the event, by passing it to 'fireEventsAndRead'.
105+ -- event, by passing it to 'fireEventsAndRead'.
78 --
106 --
79− -- Note: An event may be set up multiple times. So after the teardown action is executed, the event may still be set up again in the future.
107+ -- Note: An event may be set up multiple times. So after the teardown action
108+ -- is executed, the event may still be set up again in the future.
80 newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> m (Event t a)
109 newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> m (Event t a)
81 newFanEventWithTrigger :: GCompare k => (forall a. k a -> EventTrigger t a -> IO (IO ())) -> m (EventSelector t k)
110 newFanEventWithTrigger :: GCompare k => (forall a. k a -> EventTrigger t a -> IO (IO ())) -> m (EventSelector t k)
82
111
83−class (ReflexHost t, MonadReflexCreateTrigger t m, MonadSubscribeEvent t m, MonadReadEvent t (ReadPhase m), MonadSample t (ReadPhase m), MonadHold t (ReadPhase m)) => MonadReflexHost t m | m -> t where
112+-- | 'MonadReflexHost' designates monads that can run reflex frames.
113+class ( ReflexHost t
114+ , MonadReflexCreateTrigger t m
115+ , MonadSubscribeEvent t m
116+ , MonadReadEvent t (ReadPhase m)
117+ , MonadSample t (ReadPhase m)
118+ , MonadHold t (ReadPhase m)
119+ ) => MonadReflexHost t m | m -> t where
84 type ReadPhase m :: * -> *
120 type ReadPhase m :: * -> *
85 -- | Propagate some events firings and read the values of events afterwards.
121 -- | Propagate some events firings and read the values of events afterwards.
86 --
122 --
87− -- This function will create a new frame to fire the given events. It will then update all
123+ -- This function will create a new frame to fire the given events. It will
88− -- dependent events and behaviors. After that is done, the given callback is executed which
124+ -- then update all dependent events and behaviors. After that is done, the
125+ -- given callback is executed which allows to read the final values of events
89− -- allows to read the final values of events and check whether they have fired in this frame or
126+ -- and check whether they have fired in this frame or not.
90− -- not.
91 --
127 --
92 -- All events that are given are fired at the same time.
128 -- All events that are given are fired at the same time.
93 --
129 --
94− -- This function is typically used in the main loop of a reflex framework implementation.
130+ -- This function is typically used in the main loop of a reflex framework
95− -- The main loop waits for external events to happen (such as keyboard input or a mouse click)
131+ -- implementation. The main loop waits for external events to happen (such as
132+ -- keyboard input or a mouse click) and then fires the corresponding events
96− -- and then fires the corresponding events using this function. The read callback can be used
133+ -- using this function. The read callback can be used to read output events
97− -- to read output events and perform a corresponding response action to the external event.
134+ -- and perform a corresponding response action to the external event.
98 fireEventsAndRead :: [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m a
135 fireEventsAndRead :: [DSum (EventTrigger t) Identity] -> ReadPhase m a -> m a
99
136
100 -- | Run a frame without any events firing.
137 -- | Run a frame without any events firing.
101 --
138 --
102− -- This function should be used when you want to use 'sample' and 'hold' when no events are currently firing.
139+ -- This function should be used when you want to use 'sample' and 'hold' when
140+ -- no events are currently firing. Using this function in that case can
103− -- Using this function in that case can improve performance, since the implementation can assume that no events
141+ -- improve performance, since the implementation can assume that no events are
104− -- are firing when 'sample' or 'hold' are called.
142+ -- firing when 'sample' or 'hold' are called.
105 --
143 --
106− -- This function is commonly used to set up the basic event network when the application starts up.
144+ -- This function is commonly used to set up the basic event network when the
145+ -- application starts up.
107 runHostFrame :: HostFrame t a -> m a
146 runHostFrame :: HostFrame t a -> m a
108
147
109-- | Like 'fireEventsAndRead', but without reading any events.
148-- | Like 'fireEventsAndRead', but without reading any events.
@@ -113,10 +152,13 @@ fireEvents dm = fireEventsAndRead dm $ return ()
113
152
114-- | Create a new event and store its trigger in an 'IORef' while it's active.
153-- | Create a new event and store its trigger in an 'IORef' while it's active.
115--
154--
116−-- An event is only active between the set up (when it's first subscribed to) and the teardown phases (when noboby is subscribing the event anymore).
155+-- An event is only active between the set up (when it's first subscribed to)
156+-- and the teardown phases (when noboby is subscribing the event anymore). This
117−-- This function returns an Event and an 'IORef'. As long as the event is active, the 'IORef' will contain 'Just' the event trigger to
157+-- function returns an Event and an 'IORef'. As long as the event is active, the
158+-- 'IORef' will contain 'Just' the event trigger to trigger this event. When the
118−-- trigger this event. When the event is not active, the 'IORef' will contain 'Nothing'. This allows event sources to be more efficient,
159+-- event is not active, the 'IORef' will contain 'Nothing'. This allows event
119−-- since they don't need to produce events when nobody is listening.
160+-- sources to be more efficient, since they don't need to produce events when
161+-- nobody is listening.
120newEventWithTriggerRef :: (MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) => m (Event t a, Ref m (Maybe (EventTrigger t a)))
162newEventWithTriggerRef :: (MonadReflexCreateTrigger t m, MonadRef m, Ref m ~ Ref IO) => m (Event t a, Ref m (Maybe (EventTrigger t a)))
121newEventWithTriggerRef = do
163newEventWithTriggerRef = do
122 rt <- newRef Nothing
164 rt <- newRef Nothing
@@ -126,6 +168,7 @@ newEventWithTriggerRef = do
126 return (e, rt)
168 return (e, rt)
127{-# INLINE newEventWithTriggerRef #-}
169{-# INLINE newEventWithTriggerRef #-}
128
170
171+-- | Fire the given trigger if it is not 'Nothing'.
129fireEventRef :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> m ()
172fireEventRef :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> m ()
130fireEventRef mtRef input = do
173fireEventRef mtRef input = do
131 mt <- readRef mtRef
174 mt <- readRef mtRef
@@ -133,6 +176,8 @@ fireEventRef mtRef input = do
133 Nothing -> return ()
176 Nothing -> return ()
134 Just trigger -> fireEvents [trigger :=> Identity input]
177 Just trigger -> fireEvents [trigger :=> Identity input]
135
178
179+-- | Fire the given trigger if it is not 'Nothing', and read from the given
180+-- 'EventHandle'.
136fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)
181fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)
137fireEventRefAndRead mtRef input e = do
182fireEventRefAndRead mtRef input e = do
138 mt <- readRef mtRef
183 mt <- readRef mtRef
src/Reflex/Spider.hs+2
@@ -1,3 +1,5 @@
1+-- | This module exports all of the user-facing functionality of the 'Spider'
2+-- 'Reflex' engine
1module Reflex.Spider ( Spider
3module Reflex.Spider ( Spider
2 , SpiderEnv
4 , SpiderEnv
3 , Global
5 , Global
src/Reflex/Spider/Internal.hs+56−57
@@ -18,7 +18,17 @@
18{-# LANGUAGE TypeFamilies #-}
18{-# LANGUAGE TypeFamilies #-}
19{-# LANGUAGE TypeOperators #-}
19{-# LANGUAGE TypeOperators #-}
20{-# LANGUAGE UndecidableInstances #-}
20{-# LANGUAGE UndecidableInstances #-}
21−module Reflex.Spider.Internal (Spider, SpiderEnv (..), Global, SpiderHost, runSpiderHost, SpiderEventHandle (..), showSubscriberType, showEventType, ComputeM (..), MergeSubscribedParent (..), HasSpiderEnv (..), newSpiderEnv, SpiderPullM (..), SpiderPushM (..), ReadPhase (..)) where
21+-- | This module is the implementation of the 'Spider' 'Reflex' engine. It uses
22+-- a graph traversal algorithm to propagate 'Event's and 'Behavior's.
23+module Reflex.Spider.Internal
24+ ( Spider
25+ , SpiderEnv (..)
26+ , Global
27+ , SpiderHost
28+ , runSpiderHost
29+ , newSpiderEnv
30+ , askSpiderEnv
31+ ) where
22
32
23import Control.Applicative
33import Control.Applicative
24import Control.Concurrent
34import Control.Concurrent
@@ -116,6 +126,33 @@ instance HasNodeId (Pull a) where
116showNodeId :: HasNodeId a => a -> String
126showNodeId :: HasNodeId a => a -> String
117showNodeId = ("#"<>) . show . getNodeId
127showNodeId = ("#"<>) . show . getNodeId
118
128
129+showSubscriberType :: Subscriber a -> String
130+showSubscriberType = \case
131+ SubscriberPush _ _ -> "SubscriberPush"
132+ SubscriberMerge _ _ -> "SubscriberMerge"
133+ SubscriberFan _ -> "SubscriberFan"
134+ SubscriberMergeChange _ -> "SubscriberMergeChange"
135+ SubscriberHold _ -> "SubscriberHold"
136+ SubscriberHoldIdentity _ -> "SubscriberHoldIdentity"
137+ SubscriberSwitch _ -> "SubscriberSwitch"
138+ SubscriberCoincidenceOuter _ -> "SubscriberCoincidenceOuter"
139+ SubscriberCoincidenceInner _ -> "SubscriberCoincidenceInner"
140+ SubscriberHandle -> "SubscriberHandle"
141+
142+showEventType :: Event a -> String
143+showEventType = \case
144+ EventRoot _ _ -> "EventRoot"
145+ EventNever -> "EventNever"
146+ EventPush _ -> "EventPush"
147+ EventMerge _ -> "EventMerge"
148+ EventFan _ _ -> "EventFan"
149+ EventSwitch _ -> "EventSwitch"
150+ EventCoincidence _ -> "EventCoincidence"
151+ EventHold _ -> "EventHold"
152+ EventDyn _ -> "EventDyn"
153+ EventHoldIdentity _ -> "EventHoldIdentity"
154+ EventDynIdentity _ -> "EventDynIdentity"
155+
119#else
156#else
120
157
121debugPropagate = False
158debugPropagate = False
@@ -218,6 +255,7 @@ instance HasCurrentHeight (EventM x) where
218 liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [DelayedMerge subscribed]
255 liftIO $ modifyIORef' delayedRef $ IntMap.insertWith (++) (unHeight height) [DelayedMerge subscribed]
219
256
220class HasSpiderEnv x m | m -> x where
257class HasSpiderEnv x m | m -> x where
258+ -- | Retrieve the current SpiderEnv
221 askSpiderEnv :: m (SpiderEnv x)
259 askSpiderEnv :: m (SpiderEnv x)
222
260
223instance HasSpiderEnv x (EventM x) where
261instance HasSpiderEnv x (EventM x) where
@@ -275,12 +313,6 @@ hold v0 e = do
275 defer $ SomeHoldInit h
313 defer $ SomeHoldInit h
276 return h
314 return h
277
315
278−{-
279−mkWeakIORefKey :: IORef a -> b -> IO () -> IO (Weak b)
280−mkWeakIORefKey r@(IORef (STRef r#)) b (IO f) = IO $ \s ->
281− case mkWeak# r# b f s of (# s1, w #) -> (# s1, Weak w #)
282−-}
283−
284{-# INLINE getHoldEventSubscription #-}
316{-# INLINE getHoldEventSubscription #-}
285getHoldEventSubscription :: forall m p a x. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeClear m, R.Patch p, HasCurrentHeight m, Defer SomeMergeInit m, Defer SomeResetCoincidence m, HasSpiderEnv x m) => Hold p a -> m (EventSubscription (p a))
317getHoldEventSubscription :: forall m p a x. (Defer SomeAssignment m, Defer SomeHoldInit m, Defer SomeClear m, R.Patch p, HasCurrentHeight m, Defer SomeMergeInit m, Defer SomeResetCoincidence m, HasSpiderEnv x m) => Hold p a -> m (EventSubscription (p a))
286getHoldEventSubscription h = do
318getHoldEventSubscription h = do
@@ -289,20 +321,6 @@ getHoldEventSubscription h = do
289 Right subd -> return subd
321 Right subd -> return subd
290 Left e -> do
322 Left e -> do
291 subscriptionRef <- liftIO $ newIORef $ error "getHoldEventSubscription: subdRef uninitialized"
323 subscriptionRef <- liftIO $ newIORef $ error "getHoldEventSubscription: subdRef uninitialized"
292− {-
293− spiderEnv <- askSpiderEnv
294− weakSubscriptionRef <- liftIO $ mkWeakIORef subscriptionRef $ return ()
295− wh <- liftIO $ mkWeakIORefKey (holdValue h) h $ do
296− msr <- deRefWeak weakSubscriptionRef
297− forM_ msr $ \sr -> do
298− subscription <- readIORef sr
299− atomicModifyIORef (_spiderEnv_toUnsubscribe spiderEnv) $ \x -> (SomeEventSubscription subscription : x, ())
300−-- return ()
301− {-
302− -- What can we do? 1) Detect GCs at the SpiderEnv level, then go over the tree
303− 2) Have a finalizer on every SubscriberListNode that only runs if its parent is still alive, and does a normal unsubscribe if so; this would seem to double the number of weakRefs we use, but perhaps not the weakDepth, so maybe it's OK; we will probably need to move the regular call to unsubscribe into the finalizer and then use finalize instead of that call; we can have a strong reference to the SubscriberListNode, which means we just need a single weak reference to each EventSubscribed, which we can reuse in all of the finalizers that need to (potentially) unsubscribe from it
304−-}
305− -}
306 subscription@(EventSubscription _ subd) <- subscribe e =<< liftIO (newSubscriberHold h)
324 subscription@(EventSubscription _ subd) <- subscribe e =<< liftIO (newSubscriberHold h)
307 liftIO $ writeIORef subscriptionRef $! subscription
325 liftIO $ writeIORef subscriptionRef $! subscription
308 occ <- liftIO $ readEventSubscribed subd
326 occ <- liftIO $ readEventSubscribed subd
@@ -405,7 +423,7 @@ data PushSubscribed a b
405#endif
423#endif
406 }
424 }
407
425
408−newtype ComputeM a = ComputeM { unComputeM :: ReaderT (IORef [SomeHoldInit]) IO a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
426+newtype ComputeM a = ComputeM (ReaderT (IORef [SomeHoldInit]) IO a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
409
427
410instance Defer SomeHoldInit ComputeM where
428instance Defer SomeHoldInit ComputeM where
411 getDeferralQueue = ComputeM ask
429 getDeferralQueue = ComputeM ask
@@ -420,10 +438,10 @@ data Push a b
420 , pushSubscribed :: !(IORef (Maybe (PushSubscribed a b))) --TODO: Can we replace this with an unsafePerformIO thunk?
438 , pushSubscribed :: !(IORef (Maybe (PushSubscribed a b))) --TODO: Can we replace this with an unsafePerformIO thunk?
421 }
439 }
422
440
423−data MergeSubscribedParent k a
424− = MergeSubscribedParent { mergeSubscribedParentSubscription :: !(EventSubscription a)
441+data MergeSubscribedParent k a = MergeSubscribedParent !(EventSubscription a) !(Subscriber a)
425− , mergeSubscribedParentSubscriber :: !(Subscriber a)
442+
426− }
443+mergeSubscribedParentSubscription :: MergeSubscribedParent k a -> EventSubscription a
444+mergeSubscribedParentSubscription (MergeSubscribedParent es _) = es
427
445
428data HeightBag = HeightBag
446data HeightBag = HeightBag
429 { _heightBag_size :: {-# UNPACK #-} !Int
447 { _heightBag_size :: {-# UNPACK #-} !Int
@@ -561,19 +579,6 @@ data Subscriber a
561 | SubscriberCoincidenceInner (CoincidenceSubscribed a)
579 | SubscriberCoincidenceInner (CoincidenceSubscribed a)
562 | SubscriberHandle
580 | SubscriberHandle
563
581
564−showSubscriberType :: Subscriber a -> String
565−showSubscriberType = \case
566− SubscriberPush _ _ -> "SubscriberPush"
567− SubscriberMerge _ _ -> "SubscriberMerge"
568− SubscriberFan _ -> "SubscriberFan"
569− SubscriberMergeChange _ -> "SubscriberMergeChange"
570− SubscriberHold _ -> "SubscriberHold"
571− SubscriberHoldIdentity _ -> "SubscriberHoldIdentity"
572− SubscriberSwitch _ -> "SubscriberSwitch"
573− SubscriberCoincidenceOuter _ -> "SubscriberCoincidenceOuter"
574− SubscriberCoincidenceInner _ -> "SubscriberCoincidenceInner"
575− SubscriberHandle -> "SubscriberHandle"
576−
577data Event a
582data Event a
578 = forall k. GCompare k => EventRoot !(k a) !(Root k)
583 = forall k. GCompare k => EventRoot !(k a) !(Root k)
579 | EventNever
584 | EventNever
@@ -587,20 +592,6 @@ data Event a
587 | forall b. (a ~ Identity b) => EventHoldIdentity !(Hold Identity b)
592 | forall b. (a ~ Identity b) => EventHoldIdentity !(Hold Identity b)
588 | forall b. (a ~ Identity b) => EventDynIdentity !(Dyn Identity b)
593 | forall b. (a ~ Identity b) => EventDynIdentity !(Dyn Identity b)
589
594
590−showEventType :: Event a -> String
591−showEventType = \case
592− EventRoot _ _ -> "EventRoot"
593− EventNever -> "EventNever"
594− EventPush _ -> "EventPush"
595− EventMerge _ -> "EventMerge"
596− EventFan _ _ -> "EventFan"
597− EventSwitch _ -> "EventSwitch"
598− EventCoincidence _ -> "EventCoincidence"
599− EventHold _ -> "EventHold"
600− EventDyn _ -> "EventDyn"
601− EventHoldIdentity _ -> "EventHoldIdentity"
602− EventDynIdentity _ -> "EventDynIdentity"
603−
604data EventSubscription a = EventSubscription
595data EventSubscription a = EventSubscription
605 { _eventSubscription_ticket :: !(Maybe (SubscriberListTicket a))
596 { _eventSubscription_ticket :: !(Maybe (SubscriberListTicket a))
606 , _eventSubscription_subscribed :: !(EventSubscribed a)
597 , _eventSubscription_subscribed :: !(EventSubscribed a)
@@ -1999,15 +1990,18 @@ invalidate toReconnectRef wis = do
1999-- Reflex integration
1990-- Reflex integration
2000--------------------------------------------------------------------------------
1991--------------------------------------------------------------------------------
2001
1992
1993+-- | The default, global Spider environment
2002type Spider = SpiderEnv Global
1994type Spider = SpiderEnv Global
2003
1995
1996+-- | Designates the default, global Spider timeline
2004data Global
1997data Global
2005
1998
2006{-# NOINLINE globalSpiderEnv #-}
1999{-# NOINLINE globalSpiderEnv #-}
2007globalSpiderEnv :: SpiderEnv Global
2000globalSpiderEnv :: SpiderEnv Global
2008globalSpiderEnv = unsafePerformIO unsafeNewSpiderEnv
2001globalSpiderEnv = unsafePerformIO unsafeNewSpiderEnv
2009
2002
2010−type role SpiderEnv nominal
2003+-- | Stores all global data relevant to a particular Spider timeline; only one
2004+-- value should exist for each type @x@
2011data SpiderEnv x = SpiderEnv
2005data SpiderEnv x = SpiderEnv
2012 { _spiderEnv_toUnsubscribe :: !(IORef [SomeEventSubscription])
2006 { _spiderEnv_toUnsubscribe :: !(IORef [SomeEventSubscription])
2013 , _spiderEnv_lock :: !(MVar ())
2007 , _spiderEnv_lock :: !(MVar ())
@@ -2016,6 +2010,7 @@ data SpiderEnv x = SpiderEnv
2016 , _spiderEnv_depth :: !(IORef Int)
2010 , _spiderEnv_depth :: !(IORef Int)
2017#endif
2011#endif
2018 }
2012 }
2013+type role SpiderEnv nominal
2019
2014
2020instance GEq SpiderEnv where
2015instance GEq SpiderEnv where
2021 a `geq` b = if _spiderEnv_toUnsubscribe a == _spiderEnv_toUnsubscribe b
2016 a `geq` b = if _spiderEnv_toUnsubscribe a == _spiderEnv_toUnsubscribe b
@@ -2039,12 +2034,13 @@ unsafeNewSpiderEnv = do
2039#endif
2034#endif
2040 }
2035 }
2041
2036
2037+-- | Create a new SpiderEnv
2042newSpiderEnv :: IO (Some SpiderEnv)
2038newSpiderEnv :: IO (Some SpiderEnv)
2043newSpiderEnv = Some.This <$> unsafeNewSpiderEnv
2039newSpiderEnv = Some.This <$> unsafeNewSpiderEnv
2044
2040
2045−newtype SpiderPullM x a = SpiderPullM { runSpiderPullM :: BehaviorM a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
2041+newtype SpiderPullM x a = SpiderPullM (BehaviorM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
2046
2042
2047−newtype SpiderPushM x a = SpiderPushM { runSpiderPushM :: ComputeM a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
2043+newtype SpiderPushM x a = SpiderPushM (ComputeM a) deriving (Functor, Applicative, Monad, MonadIO, MonadFix)
2048
2044
2049instance R.Reflex (SpiderEnv x) where
2045instance R.Reflex (SpiderEnv x) where
2050 newtype Behavior (SpiderEnv x) a = SpiderBehavior { unSpiderBehavior :: Behavior a }
2046 newtype Behavior (SpiderEnv x) a = SpiderBehavior { unSpiderBehavior :: Behavior a }
@@ -2172,6 +2168,7 @@ instance MonadAtomicRef (EventM x) where
2172 {-# INLINABLE atomicModifyRef #-}
2168 {-# INLINABLE atomicModifyRef #-}
2173 atomicModifyRef r f = liftIO $ atomicModifyRef r f
2169 atomicModifyRef r f = liftIO $ atomicModifyRef r f
2174
2170
2171+-- | The monad for actions that manipulate a Spider timeline identified by @x@
2175newtype SpiderHost x a = SpiderHost { unSpiderHost :: ReaderT (SpiderEnv x) IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
2172newtype SpiderHost x a = SpiderHost { unSpiderHost :: ReaderT (SpiderEnv x) IO a } deriving (Functor, Applicative, MonadFix, MonadIO, MonadException, MonadAsyncException)
2176
2173
2177instance Monad (SpiderHost x) where
2174instance Monad (SpiderHost x) where
@@ -2184,6 +2181,8 @@ instance Monad (SpiderHost x) where
2184 {-# INLINABLE fail #-}
2181 {-# INLINABLE fail #-}
2185 fail s = SpiderHost $ fail s
2182 fail s = SpiderHost $ fail s
2186
2183
2184+-- | Run an action affecting the global Spider timeline; this will be guarded by
2185+-- a mutex for that timeline
2187runSpiderHost :: SpiderHost Global a -> IO a
2186runSpiderHost :: SpiderHost Global a -> IO a
2188runSpiderHost (SpiderHost a) = runReaderT a globalSpiderEnv
2187runSpiderHost (SpiderHost a) = runReaderT a globalSpiderEnv
2189
2188
@@ -2251,7 +2250,7 @@ subscribeEventSpiderHost e = do
2251 subscription <- runFrame $ subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)
2250 subscription <- runFrame $ subscribe (unSpiderEvent e) SubscriberHandle --TODO: Unsubscribe eventually (manually and/or with weak ref)
2252 return $ SpiderEventHandle subscription
2251 return $ SpiderEventHandle subscription
2253
2252
2254−newtype ReadPhase x a = ReadPhase { runReadPhase :: ResultM x a } deriving (Functor, Applicative, Monad, MonadFix)
2253+newtype ReadPhase x a = ReadPhase (ResultM x a) deriving (Functor, Applicative, Monad, MonadFix)
2255
2254
2256instance R.MonadSample (SpiderEnv x) (ReadPhase x) where
2255instance R.MonadSample (SpiderEnv x) (ReadPhase x) where
2257 {-# INLINABLE sample #-}
2256 {-# INLINABLE sample #-}
test/Reflex/Bench/Focused.hs+12−12
@@ -47,15 +47,15 @@ mergeTree n es | length es <= n = sum' es
47 subTrees = map sum' merges
47 subTrees = map sum' merges
48 sum' = fmap sum . mconcat . fmap (fmap (:[]) )
48 sum' = fmap sum . mconcat . fmap (fmap (:[]) )
49
49
50−mergeListDyn :: (Reflex t, MonadHold t m) => [Dynamic t a] -> m (Dynamic t [a])
50+mergeListDyn :: Reflex t => [Dynamic t a] -> Dynamic t [a]
51−mergeListDyn dyns = traverse (mapDyn pure) dyns >>= mconcatDyn
51+mergeListDyn = mconcat . fmap (fmap pure)
52
52
53−mergeTreeDyn :: (Num a, Reflex t, MonadHold t m, MonadFix m) => Int -> [Dynamic t a] -> m (Dynamic t a)
53+mergeTreeDyn :: (Num a, Reflex t) => Int -> [Dynamic t a] -> Dynamic t a
54mergeTreeDyn n dyns | length dyns <= n = sumDyns dyns
54mergeTreeDyn n dyns | length dyns <= n = sumDyns dyns
55− | otherwise = traverse sumDyns merges >>= mergeTreeDyn n
55+ | otherwise = mergeTreeDyn n $ fmap sumDyns merges
56 where
56 where
57− merges = chunksOf n dyns
57+ merges = chunksOf n dyns
58− sumDyns ds = mergeListDyn ds >>= mapDyn sum
58+ sumDyns = fmap sum . mergeListDyn
59
59
60
60
61
61
@@ -125,13 +125,13 @@ fmapChain :: (Functor f) => Word -> f Word -> f Word
125fmapChain = iter (fmap (+1))
125fmapChain = iter (fmap (+1))
126
126
127mapDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
127mapDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
128−mapDynChain = iterM (mapDyn (+1))
128+mapDynChain = iterM (return . fmap (+1))
129
129
130joinDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
130joinDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
131−joinDynChain = iterM (\d -> joinDyn <$> mapDyn (const d) d)
131+joinDynChain = iterM (\d -> return $ join $ fmap (const d) d)
132
132
133combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
133combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
134−combineDynChain = iterM (\d -> combineDyn (+) d d)
134+combineDynChain = iterM (\d -> return $ zipDynWith (+) d d)
135
135
136pingPong :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> Event t a -> m (Event t a)
136pingPong :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> Event t a -> m (Event t a)
137pingPong e1 e2 = do
137pingPong e1 e2 = do
@@ -309,9 +309,9 @@ dynamics n =
309 [ testE "mapDynChain" $ fmap updated $ mapDynChain n =<< d
309 [ testE "mapDynChain" $ fmap updated $ mapDynChain n =<< d
310 , testE "joinDynChain" $ fmap updated $ joinDynChain n =<< d
310 , testE "joinDynChain" $ fmap updated $ joinDynChain n =<< d
311 , testE "combineDynChain" $ fmap updated $ combineDynChain n =<< d
311 , testE "combineDynChain" $ fmap updated $ combineDynChain n =<< d
312− , testE "dense mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< dense
312+ , testE "dense mergeTree" $ fmap (updated . mergeTreeDyn 8) dense
313− , testE "sparse mergeTree" $ fmap updated $ mergeTreeDyn 8 =<< sparse
313+ , testE "sparse mergeTree" $ fmap (updated . mergeTreeDyn 8) sparse
314− , testE "mergeDyn" $ fmap updated $ mapDyn sum =<< mergeListDyn =<< sparse
314+ , testE "mergeDyn" $ fmap (updated . fmap sum . mergeListDyn) sparse
315 ] where
315 ] where
316
316
317 d :: TestPlan t m => m (Dynamic t Word)
317 d :: TestPlan t m => m (Dynamic t Word)
test/Reflex/Pure.hs+19−13
@@ -1,8 +1,7 @@
1−{- | This module provides a pure implementation of Reflex, which is intended
1+-- | This module provides a pure implementation of Reflex, which is intended to
2−to serve as a reference for the semantics of the Reflex class. All implementations
2+-- serve as a reference for the semantics of the Reflex class. All
3−of Reflex should produce the same results as this implementation, although performance
3+-- implementations of Reflex should produce the same results as this
4−and laziness/strictness may differ.
4+-- implementation, although performance and laziness/strictness may differ.
5−-}
6
5
7{-# LANGUAGE EmptyDataDecls #-}
6{-# LANGUAGE EmptyDataDecls #-}
8{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE FlexibleInstances #-}
@@ -23,7 +22,6 @@ import Control.Monad
23import Data.Dependent.Map (DMap, GCompare)
22import Data.Dependent.Map (DMap, GCompare)
24import qualified Data.Dependent.Map as DMap
23import qualified Data.Dependent.Map as DMap
25import Data.Functor.Identity
24import Data.Functor.Identity
26−import Data.Functor.Misc
27import Data.Maybe
25import Data.Maybe
28import Data.MemoTrie
26import Data.MemoTrie
29import Data.Monoid
27import Data.Monoid
@@ -32,8 +30,8 @@ import Reflex.Class
32data Pure t
30data Pure t
33
31
34-- | The Enum instance of t must be dense: for all x :: t, there must not exist
32-- | The Enum instance of t must be dense: for all x :: t, there must not exist
35−-- any y :: t such that pred x < y < x. The HasTrie instance will be used exclusively
33+-- any y :: t such that pred x < y < x. The HasTrie instance will be used
36−-- to memoize functions of t, not for any of its other capabilities.
34+-- exclusively to memoize functions of t, not for any of its other capabilities.
37instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
35instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
38
36
39 newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }
37 newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }
@@ -56,10 +54,14 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
56 pull :: PullM (Pure t) a -> Behavior (Pure t) a
54 pull :: PullM (Pure t) a -> Behavior (Pure t) a
57 pull = Behavior . memo
55 pull = Behavior . memo
58
56
59− -- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a warning because the GCompare instance is not used; however, removing the GCompare instance produces a different warning, due to that constraint being present in the original class definition
57+ -- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a
58+ -- warning because the GCompare instance is not used; however, removing the
59+ -- GCompare instance produces a different warning, due to that constraint
60+ -- being present in the original class definition
61+
60 --merge :: GCompare k => DMap k (Event (Pure t)) -> Event (Pure t) (DMap k Identity)
62 --merge :: GCompare k => DMap k (Event (Pure t)) -> Event (Pure t) (DMap k Identity)
61 merge events = Event $ memo $ \t ->
63 merge events = Event $ memo $ \t ->
62− let currentOccurrences = unwrapDMapMaybe (($ t) . unEvent) events
64+ let currentOccurrences = DMap.mapMaybeWithKey (\_ (Event a) -> Identity <$> a t) events
63 in if DMap.null currentOccurrences
65 in if DMap.null currentOccurrences
64 then Nothing
66 then Nothing
65 else Just currentOccurrences
67 else Just currentOccurrences
@@ -83,7 +85,9 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
83 unsafeBuildDynamic readV0 v' = Dynamic $ \t -> (readV0 t, unEvent v' t)
85 unsafeBuildDynamic readV0 v' = Dynamic $ \t -> (readV0 t, unEvent v' t)
84
86
85 -- See UNUSED_CONSTRAINT, above.
87 -- See UNUSED_CONSTRAINT, above.
88+
86− --unsafeBuildIncremental :: Patch p => PullM (Pure t) a -> Event (Pure t) (p a) -> Incremental (Pure t) p a
89+ --unsafeBuildIncremental :: Patch p => PullM (Pure t) a -> Event (Pure t) (p
90+ --a) -> Incremental (Pure t) p a
87 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)
91 unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)
88
92
89 mergeIncremental (Incremental f) = Event $ \t ->
93 mergeIncremental (Incremental f) = Event $ \t ->
@@ -133,7 +137,8 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
133 hold initialValue e initialTime = Behavior f
137 hold initialValue e initialTime = Behavior f
134 where f = memo $ \sampleTime ->
138 where f = memo $ \sampleTime ->
135 -- Really, the sampleTime should never be prior to the initialTime,
139 -- Really, the sampleTime should never be prior to the initialTime,
136− -- because that would mean the Behavior is being sampled before being created.
140+ -- because that would mean the Behavior is being sampled before
141+ -- being created.
137 if sampleTime <= initialTime
142 if sampleTime <= initialTime
138 then initialValue
143 then initialValue
139 else let lastTime = pred sampleTime
144 else let lastTime = pred sampleTime
@@ -148,7 +153,8 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where
148 holdIncremental initialValue e initialTime = Incremental $ \t -> (f t, unEvent e t)
153 holdIncremental initialValue e initialTime = Incremental $ \t -> (f t, unEvent e t)
149 where f = memo $ \sampleTime ->
154 where f = memo $ \sampleTime ->
150 -- Really, the sampleTime should never be prior to the initialTime,
155 -- Really, the sampleTime should never be prior to the initialTime,
151− -- because that would mean the Behavior is being sampled before being created.
156+ -- because that would mean the Behavior is being sampled before
157+ -- being created.
152 if sampleTime <= initialTime
158 if sampleTime <= initialTime
153 then initialValue
159 then initialValue
154 else let lastTime = pred sampleTime
160 else let lastTime = pred sampleTime
test/Reflex/Test/Micro.hs+15−15
@@ -67,9 +67,9 @@ testCases =
67
67
68 , testE "leftmost" $ liftA2 leftmost2 events1 events2
68 , testE "leftmost" $ liftA2 leftmost2 events1 events2
69
69
70− , testE "appendEvents-1" $ liftA2 appendEvents events1 events2
70+ , testE "appendEvents-1" $ liftA2 mappend events1 events2
71
71
72− , testE "appendEvents-2" $ liftA2 appendEvents events3 events2
72+ , testE "appendEvents-2" $ liftA2 mappend events3 events2
73
73
74 , testE "merge-1" $ do
74 , testE "merge-1" $ do
75 e <- events1
75 e <- events1
@@ -81,14 +81,14 @@ testCases =
81 let ee = flip pushAlways e $ const $ return m
81 let ee = flip pushAlways e $ const $ return m
82 return $ coincidence ee
82 return $ coincidence ee
83
83
84− , testE "onceE-1" $ do
84+ , testE "headE-1" $ do
85 e <- events1
85 e <- events1
86− onceE $ leftmost [e, e]
86+ headE $ leftmost [e, e]
87
87
88− , testE "onceE-2" $ do
88+ , testE "headE-2" $ do
89 e <- events1
89 e <- events1
90 b <- hold never (e <$ e)
90 b <- hold never (e <$ e)
91− onceE $ switch b
91+ headE $ switch b
92
92
93 , testE "switch-1" $ do
93 , testE "switch-1" $ do
94 e <- events1
94 e <- events1
@@ -143,7 +143,7 @@ testCases =
143 , testE "switchPromptly-5" $ do
143 , testE "switchPromptly-5" $ do
144 e <- events1
144 e <- events1
145 switchPromptly never $ flip push e $
145 switchPromptly never $ flip push e $
146− const (Just <$> onceE e)
146+ const (Just <$> headE e)
147
147
148 , testE "switchPromptly-6" $ do
148 , testE "switchPromptly-6" $ do
149 e <- events1
149 e <- events1
@@ -168,7 +168,7 @@ testCases =
168 , testE "coincidence-4" $ do
168 , testE "coincidence-4" $ do
169 e <- events1
169 e <- events1
170 return $ coincidence $ flip pushAlways e $
170 return $ coincidence $ flip pushAlways e $
171− const (onceE e)
171+ const (headE e)
172
172
173 , testE "coincidence-5" $ do
173 , testE "coincidence-5" $ do
174 e <- events1
174 e <- events1
@@ -188,16 +188,16 @@ testCases =
188
188
189 , testB "holdWhileFiring" $ do
189 , testB "holdWhileFiring" $ do
190 e <- events1
190 e <- events1
191− eo <- onceE e
191+ eo <- headE e
192 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
192 bb <- hold (constant "x") $ pushAlways (const $ hold "a" eo) eo
193 return $ pull $ sample =<< sample bb
193 return $ pull $ sample =<< sample bb
194
194
195 , testE "joinDyn" $ do
195 , testE "joinDyn" $ do
196 e <- events1
196 e <- events1
197 bb <- hold "b" e
197 bb <- hold "b" e
198− bd <- hold never . fmap (const e) =<< onceE e
198+ bd <- hold never . fmap (const e) =<< headE e
199
199
200− eOuter <- pushAlways sample . fmap (const bb) <$> onceE e
200+ eOuter <- pushAlways sample . fmap (const bb) <$> headE e
201 let eInner = switch bd
201 let eInner = switch bd
202 return $ leftmost [eOuter, eInner]
202 return $ leftmost [eOuter, eInner]
203
203
@@ -207,13 +207,13 @@ testCases =
207
207
208 , testB "mapDyn" $ do
208 , testB "mapDyn" $ do
209 d <- foldDyn (++) "0" =<< events1
209 d <- foldDyn (++) "0" =<< events1
210− current <$> mapDyn (map toUpper) d
210+ return $ current $ fmap (map toUpper) d
211
211
212 , testB "combineDyn" $ do
212 , testB "combineDyn" $ do
213 d1 <- foldDyn (++) "0" =<< events1
213 d1 <- foldDyn (++) "0" =<< events1
214− d2 <- mapDyn (map toUpper) =<< foldDyn (++) "0" =<< events2
214+ d2 <- fmap (fmap (map toUpper)) $ foldDyn (++) "0" =<< events2
215
215
216− current <$> combineDyn (<>) d1 d2
216+ return $ current $ zipDynWith (<>) d1 d2
217 , testE "fan-1" $ do
217 , testE "fan-1" $ do
218 e <- fmap toMap <$> events1
218 e <- fmap toMap <$> events1
219 let es = select (fanMap e) . Const2 <$> values
219 let es = select (fanMap e) . Const2 <$> values
@@ -248,7 +248,7 @@ testCases =
248 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
248 events1 = plan [(1, "a"), (2, "b"), (5, "c"), (7, "d"), (8, "e")]
249 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
249 events2 = plan [(1, "e"), (3, "d"), (4, "c"), (6, "b"), (7, "a")]
250
250
251− events3 = liftA2 appendEvents events1 events2
251+ events3 = liftA2 mappend events1 events2
252
252
253 values = "abcde"
253 values = "abcde"
254 toMap str = Map.fromList $ map (\c -> (c, c)) str
254 toMap str = Map.fromList $ map (\c -> (c, c)) str