git.iko.soy/reflex
on develop help sign in
reflex/src/Reflex/Dynamic/Uniq.hs
105 lines 4.5 kB history raw
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE MagicHash #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5#ifdef USE_REFLEX_OPTIMIZER
6{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
7#endif
8-- | This module provides a variation of 'Dynamic' values that uses cheap
9-- pointer equality checks to reduce the amount of signal propagation needed.
10module Reflex.Dynamic.Uniq
11 ( UniqDynamic
12 , uniqDynamic
13 , fromUniqDynamic
14 , alreadyUniqDynamic
15 ) where
17import Control.Applicative (Applicative (..))
18import GHC.Exts
19import Reflex.Class
21-- | A 'Dynamic' whose 'updated' 'Event' will never fire with the same value as
22-- the 'current' 'Behavior''s contents. In order to maintain this constraint,
23-- the value inside a 'UniqDynamic' is always evaluated to
24-- <https://wiki.haskell.org/Weak_head_normal_form weak head normal form>.
25--
26-- Internally, 'UniqDynamic' uses pointer equality as a heuristic to avoid
27-- unnecessary update propagation; this is much more efficient than performing
28-- full comparisons. However, when the 'UniqDynamic' is converted back into a
29-- regular 'Dynamic', a full comparison is performed.
30newtype UniqDynamic t a = UniqDynamic { unUniqDynamic :: Dynamic t a }
32-- | Construct a 'UniqDynamic' by eliminating redundant updates from a 'Dynamic'.
33uniqDynamic :: Reflex t => Dynamic t a -> UniqDynamic t a
34uniqDynamic d = UniqDynamic $ unsafeBuildDynamic (sample $ current d) $ flip pushCheap (updated d) $ \new -> do
35 old <- sample $ current d --TODO: Is it better to sample ourselves here?
36 return $ unsafeJustChanged old new
38-- | Retrieve a normal 'Dynamic' from a 'UniqDynamic'. This will perform a
39-- final check using the output type's 'Eq' instance to ensure deterministic
40-- behavior.
41--
42-- WARNING: If used with a type whose 'Eq' instance is not law-abiding -
43-- specifically, if there are cases where @x /= x@, 'fromUniqDynamic' may
44-- eliminate more 'updated' occurrences than it should. For example, NaN values
45-- of 'Double' and 'Float' are considered unequal to themselves by the 'Eq'
46-- instance, but can be equal by pointer equality. This may cause 'UniqDynamic'
47-- to lose changes from NaN to NaN.
48fromUniqDynamic :: (Reflex t, Eq a) => UniqDynamic t a -> Dynamic t a
49fromUniqDynamic (UniqDynamic d) = unsafeDynamic (current d) e'
50 where
51 -- Only consider values different if they fail both pointer equality /and/
52 -- 'Eq' equality. This is to make things a bit more deterministic in the
53 -- case of unlawful 'Eq' instances. However, it is still possible to
54 -- achieve nondeterminism by constructing elements that are identical in
55 -- value, unequal according to 'Eq', and nondeterministically equal or
56 -- nonequal by pointer quality. I suspect that it is impossible to make the
57 -- behavior deterministic in this case.
58 superEq a b = a `unsafePtrEq` b || a == b
59 e' = attachWithMaybe (\x x' -> if x' `superEq` x then Nothing else Just x') (current d) (updated d)
61-- | Create a UniqDynamic without uniqing it on creation. This will be slightly
62-- faster than uniqDynamic when used with a Dynamic whose values are always (or
63-- nearly always) different from its previous values; if used with a Dynamic
64-- whose values do not change frequently, it may be much slower than uniqDynamic
65alreadyUniqDynamic :: Dynamic t a -> UniqDynamic t a
66alreadyUniqDynamic = UniqDynamic
68unsafePtrEq :: a -> a -> Bool
69unsafePtrEq a b = case a `seq` b `seq` reallyUnsafePtrEquality# a b of
70 0# -> False
71 _ -> True
73unsafeJustChanged :: a -> a -> Maybe a
74unsafeJustChanged old new =
75 if old `unsafePtrEq` new
76 then Nothing
77 else Just new
79instance Reflex t => Accumulator t (UniqDynamic t) where
80 accumMaybeM f z e = do
81 let f' old change = do
82 mNew <- f old change
83 return $ unsafeJustChanged old =<< mNew
84 d <- accumMaybeMDyn f' z e
85 return $ UniqDynamic d
86 mapAccumMaybeM f z e = do
87 let f' old change = do
88 (mNew, output) <- f old change
89 return (unsafeJustChanged old =<< mNew, output)
90 (d, out) <- mapAccumMaybeMDyn f' z e
91 return (UniqDynamic d, out)
93instance Reflex t => Functor (UniqDynamic t) where
94 fmap f (UniqDynamic d) = uniqDynamic $ fmap f d
96instance Reflex t => Applicative (UniqDynamic t) where
97 pure = UniqDynamic . constDyn
98 UniqDynamic a <*> UniqDynamic b = uniqDynamic $ a <*> b
99 _ *> b = b
100 a <* _ = a
102instance Reflex t => Monad (UniqDynamic t) where
103 UniqDynamic x >>= f = uniqDynamic $ x >>= unUniqDynamic . f
104 _ >> b = b
105 return = pure