module Control.Wire.Varying
(
Varying,
changes,
value,
holdV,
holdV',
scanV,
animateV
)
where
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Wire.Internal
import Data.String
#if MIN_VERSION_base(4,9,0)
import Numeric
#endif
data Varying a = Varying !Bool !a
deriving (Foldable, Functor)
instance Applicative Varying where
pure = Varying False
(<*>) = ap
instance (Bounded a) => Bounded (Varying a) where
minBound = pure minBound
maxBound = pure maxBound
instance (NFData a) => NFData (Varying a) where
rnf (Varying _ x) = rnf x
instance (Floating a) => Floating (Varying a) where
(**) = liftA2 (**)
pi = pure pi
exp = fmap exp
log = fmap log
sqrt = fmap sqrt
logBase = liftA2 logBase
sin = fmap sin; asin = fmap asin; sinh = fmap sinh; asinh = fmap asinh
cos = fmap cos; acos = fmap acos; cosh = fmap cosh; acosh = fmap acosh
tan = fmap tan; atan = fmap atan; tanh = fmap tanh; atanh = fmap atanh
#if MIN_VERSION_base(4,9,0)
log1p = fmap log1p
expm1 = fmap expm1
log1pexp = fmap log1pexp
log1mexp = fmap log1mexp
#endif
instance (Fractional a) => Fractional (Varying a) where
(/) = liftA2 (/)
fromRational = pure . fromRational
recip = fmap recip
instance (IsString a) => IsString (Varying a) where
fromString = pure . fromString
instance Monad Varying where
~(Varying cx x) >>= f =
let Varying cy y = f x
in Varying (cx || cy) y
instance (Num a) => Num (Varying a) where
(+) = liftA2 (+)
() = liftA2 ()
(*) = liftA2 (*)
abs = fmap abs
fromInteger = pure . fromInteger
negate = fmap negate
signum = fmap signum
animateV :: (Applicative m) => (a -> m b) -> Wire m (Varying a) (Varying b)
animateV f =
Wire $ \ ~(Varying cx x) -> do
(\y -> (Varying cx y, go y))
<$> f x
where
go y' =
Wire $ \(Varying cx x) ->
if cx
then (\y -> (Varying True y, go y)) <$> f x
else pure (Varying False y', go y')
changes :: Varying a -> Event a
changes (Varying cx x) = if cx then Now x else NotNow
holdV :: (Applicative m) => a -> Wire m (Event a) (Varying a)
holdV = go . Varying False
where
go x' =
Wire $ \mx ->
pure (x', go (event (Varying False (value x')) (Varying True) mx))
holdV' :: (Applicative m) => a -> Wire m (Event a) (Varying a)
holdV' x' =
Wire $ \mx ->
pure $
case mx of
NotNow -> (Varying False x', holdV' x')
Now x -> (Varying True x, holdV' x)
scanV :: (Applicative m) => (a -> b -> b) -> b -> Wire m (Event a) (Varying b)
scanV f = go . Varying False
where
go x' =
Wire $ \mdx ->
pure (x', go (event (Varying False) (\dx -> Varying True . f dx) mdx (value x')))
value :: Varying a -> a
value (Varying _ x) = x