{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif
-- | This module provides a variation of 'Dynamic' values that uses cheap
-- pointer equality checks to reduce the amount of signal propagation needed.
module Reflex.Dynamic.Uniq
( UniqDynamic
, uniqDynamic
, fromUniqDynamic
, alreadyUniqDynamic
) where
import Control.Applicative (Applicative (..))
import GHC.Exts
import Reflex.Class
-- | A 'Dynamic' whose 'updated' 'Event' will never fire with the same value as
-- the 'current' 'Behavior''s contents. In order to maintain this constraint,
-- the value inside a 'UniqDynamic' is always evaluated to
-- .
--
-- Internally, 'UniqDynamic' uses pointer equality as a heuristic to avoid
-- unnecessary update propagation; this is much more efficient than performing
-- full comparisons. However, when the 'UniqDynamic' is converted back into a
-- regular 'Dynamic', a full comparison is performed.
newtype UniqDynamic t a = UniqDynamic { unUniqDynamic :: Dynamic t a }
-- | Construct a 'UniqDynamic' by eliminating redundant updates from a 'Dynamic'.
uniqDynamic :: Reflex t => Dynamic t a -> UniqDynamic t a
uniqDynamic d = UniqDynamic $ unsafeBuildDynamic (sample $ current d) $ flip pushCheap (updated d) $ \new -> do
old <- sample $ current d --TODO: Is it better to sample ourselves here?
return $ unsafeJustChanged old new
-- | Retrieve a normal 'Dynamic' from a 'UniqDynamic'. This will perform a
-- final check using the output type's 'Eq' instance to ensure deterministic
-- behavior.
--
-- WARNING: If used with a type whose 'Eq' instance is not law-abiding -
-- specifically, if there are cases where @x /= x@, 'fromUniqDynamic' may
-- eliminate more 'updated' occurrences than it should. For example, NaN values
-- of 'Double' and 'Float' are considered unequal to themselves by the 'Eq'
-- instance, but can be equal by pointer equality. This may cause 'UniqDynamic'
-- to lose changes from NaN to NaN.
fromUniqDynamic :: (Reflex t, Eq a) => UniqDynamic t a -> Dynamic t a
fromUniqDynamic (UniqDynamic d) = unsafeDynamic (current d) e'
where
-- Only consider values different if they fail both pointer equality /and/
-- 'Eq' equality. This is to make things a bit more deterministic in the
-- case of unlawful 'Eq' instances. However, it is still possible to
-- achieve nondeterminism by constructing elements that are identical in
-- value, unequal according to 'Eq', and nondeterministically equal or
-- nonequal by pointer quality. I suspect that it is impossible to make the
-- behavior deterministic in this case.
superEq a b = a `unsafePtrEq` b || a == b
e' = attachWithMaybe (\x x' -> if x' `superEq` x then Nothing else Just x') (current d) (updated d)
-- | Create a UniqDynamic without uniqing it on creation. This will be slightly
-- faster than uniqDynamic 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 uniqDynamic
alreadyUniqDynamic :: Dynamic t a -> UniqDynamic t a
alreadyUniqDynamic = UniqDynamic
unsafePtrEq :: a -> a -> Bool
unsafePtrEq a b = case a `seq` b `seq` reallyUnsafePtrEquality# a b of
0# -> False
_ -> True
unsafeJustChanged :: a -> a -> Maybe a
unsafeJustChanged old new =
if old `unsafePtrEq` new
then Nothing
else Just new
instance Reflex t => Accumulator t (UniqDynamic t) where
accumMaybeM f z e = do
let f' old change = do
mNew <- f old change
return $ unsafeJustChanged old =<< mNew
d <- accumMaybeMDyn f' z e
return $ UniqDynamic d
mapAccumMaybeM f z e = do
let f' old change = do
(mNew, output) <- f old change
return (unsafeJustChanged old =<< mNew, output)
(d, out) <- mapAccumMaybeMDyn f' z e
return (UniqDynamic d, out)
instance Reflex t => Functor (UniqDynamic t) where
fmap f (UniqDynamic d) = uniqDynamic $ fmap f d
instance Reflex t => Applicative (UniqDynamic t) where
pure = UniqDynamic . constDyn
UniqDynamic a <*> UniqDynamic b = uniqDynamic $ a <*> b
_ *> b = b
a <* _ = a
instance Reflex t => Monad (UniqDynamic t) where
UniqDynamic x >>= f = uniqDynamic $ x >>= unUniqDynamic . f
_ >> b = b
return = pure