varying 0.7.0.3 → 0.7.1.0
raw patch · 9 files changed
+429/−306 lines, 9 filesdep +contravariantdep ~base
Dependencies added: contravariant
Dependency ranges changed: base
Files
- README.md +18/−5
- app/Main.hs +45/−41
- src/Control/Varying.hs +11/−14
- src/Control/Varying/Core.hs +151/−103
- src/Control/Varying/Event.hs +83/−32
- src/Control/Varying/Spline.hs +67/−67
- src/Control/Varying/Tween.hs +29/−23
- test/Main.hs +9/−15
- varying.cabal +16/−6
README.md view
@@ -26,7 +26,7 @@ -- An exponential tween back and forth from 0 to 50 over 1 seconds that -- loops forever. This spline takes float values of delta time as input, -- outputs the current x value at every step.-tweenx :: (Applicative m, Monad m) => TweenT Float Float m Float+tweenx :: Monad m => TweenT Float Float m Float tweenx = do -- Tween from 0 to 50 over 1 second tween_ easeOutExpo 0 50 1@@ -35,20 +35,20 @@ -- Loop forever tweenx --- A quadratic tween back and forth from 0 to 50 over 1 seconds that never+-- An exponential tween back and forth from 0 to 50 over 1 seconds that never -- ends.-tweeny :: (Applicative m, Monad m) => TweenT Float Float m Float+tweeny :: Monad m => TweenT Float Float m Float tweeny = do tween_ easeOutExpo 50 0 1 tween_ easeOutExpo 0 50 1 tweeny -- Our time signal counts input delta time samples.-time :: (Applicative m, Monad m) => VarT m Delta Float+time :: Monad m => VarT m Delta Float time = var unDelta -- | Our Point value that varies over time continuously in x and y.-backAndForth :: (Applicative m, Monad m) => VarT m Delta Point+backAndForth :: Monad m => VarT m Delta Point backAndForth = -- Turn our splines into continuous output streams. We must provide -- a starting value since splines are not guaranteed to be defined at@@ -93,4 +93,17 @@ f _ _ = ' ' putStrLn str loop vNext t1+```++# Publications++The concept of `VarT` that this library is built on is isomorphic to Monadic Stream Functions as defined in "[Functional Reactive Programming, Refactored](http://dl.acm.org/citation.cfm?id=2976010)" ([mirror](http://www.cs.nott.ac.uk/~psxip1/#FRPRefactored)).++The isomorphism is+``` haskell+toMSF :: Functor m => VarT m a b -> MSF m a b+toMSF = MSF . (fmap . fmap . fmap $ toMSF) . runVarT++toVarT :: Functor m => MSF m a b -> VarT m a b+toVarT = VarT . (fmap . fmap . fmap $ toVarT) . unMSF ```
app/Main.hs view
@@ -1,39 +1,51 @@ module Main where -import Control.Varying-import Control.Applicative-import Control.Monad (void)-import Data.Functor.Identity-import Data.Function (fix)-import Data.Time.Clock+import Control.Concurrent (threadDelay)+import Control.Varying+import Data.Function (fix)+import Data.Functor.Identity (Identity (..))+import Data.Time.Clock (diffUTCTime, getCurrentTime) -- | A simple 2d point type. data Point = Point { px :: Float , py :: Float } deriving (Show, Eq) ++-- | The duration (in seconds) to tween in each direction.+dur :: Float+dur = 3+++-- | A novel, start-stop tween.+easeMiddle :: Monad m => Float -> Float -> Float -> TweenT Float Float m ()+easeMiddle start end t = do+ let change = end - start+ tween_ easeOutExpo start (start + change/2) $ t/2+ tween_ easeInExpo (start + change/2) end $ t/2+ -- An exponential tween back and forth from 0 to 50 over 1 seconds that -- loops forever. This spline takes float values of delta time as input, -- outputs the current x value at every step.-tweenx :: (Applicative m, Monad m) => TweenT Float Float m Float+tweenx :: Monad m => TweenT Float Float m () tweenx = do- -- Tween from 0 to 50 over 1 second- tween_ easeOutExpo 0 50 1+ -- Tween from 0 to 50 over 'dur' seconds+ easeMiddle 0 50 dur -- Chain another tween back to the starting position- tween_ easeOutExpo 50 0 1+ easeMiddle 50 0 dur -- Loop forever tweenx -- A quadratic tween back and forth from 0 to 50 over 1 seconds that never -- ends.-tweeny :: (Applicative m, Monad m) => TweenT Float Float m Float+tweeny :: Monad m => TweenT Float Float m () tweeny = do- tween_ easeOutExpo 50 0 1- tween_ easeOutExpo 0 50 1+ easeMiddle 50 0 dur+ easeMiddle 0 50 dur tweeny -- | Our Point value that varies over time continuously in x and y.-backAndForth :: (Applicative m, Monad m) => VarT m Float Point+backAndForth :: Monad m => VarT m Float Point backAndForth = -- Turn our splines into continuous output streams. We must provide -- a starting value since splines are not guaranteed to be defined at@@ -44,31 +56,23 @@ -- Construct a varying Point that takes time as an input. (Point <$> x <*> y) --- | An example of using 'fix' and combining splines to get a better programming--- experience while writing tweens.-betterBackAndForth :: (Applicative m, Monad m) => VarT m Float Point-betterBackAndForth = flip tweenStream (Point 0 0) $ fix $ \nxt -> do- void $ race Point (tween_ easeOutExpo 0 50 1) (tween_ easeOutExpo 50 0 1)- void $ race Point (tween_ easeOutExpo 50 0 1) (tween_ easeOutExpo 0 50 1)- nxt- main :: IO ()-main = getCurrentTime >>= loop betterBackAndForth--loop :: Var Float Point -> UTCTime -> IO ()-loop v t = do- t1 <- getCurrentTime- -- Here we'll run in the Identity monad using a time delta provided by- -- getCurrentTime and diffUTCTime.- let dt = realToFrac $ diffUTCTime t1 t- Identity (Point x y, vNext) = runVarT v dt- xStr = replicate (round x) ' ' ++ "x" ++ replicate (50 - round x) ' '- yStr = replicate (round y) ' ' ++ "y" ++ replicate (50 - round y) ' '- str = zipWith f xStr yStr- f 'x' 'y' = '|'- f 'y' 'x' = '|'- f a ' ' = a- f ' ' b = b- f _ _ = ' '- putStrLn str- loop vNext t1+main = do+ t <- getCurrentTime+ ($ t) . ($ backAndForth) $ fix $ \loop v lastT -> do+ thisT <- getCurrentTime+ -- Here we'll run in the Identity monad using a time delta provided by+ -- getCurrentTime and diffUTCTime.+ let dt = realToFrac $ diffUTCTime thisT lastT+ Identity (Point x y, vNext) = runVarT v dt+ xStr = replicate (round x) ' ' ++ "x" ++ replicate (50 - round x) ' '+ yStr = replicate (round y) ' ' ++ "y" ++ replicate (50 - round y) ' '+ str = zipWith f xStr yStr+ f 'x' 'y' = '|'+ f 'y' 'x' = '|'+ f a ' ' = a+ f ' ' b = b+ f _ _ = ' '+ putStrLn str+ threadDelay $ floor $ 1000000 / (20 :: Double)+ loop vNext thisT
src/Control/Varying.hs view
@@ -2,13 +2,13 @@ -- Module: Control.Varying -- Copyright: (c) 2016 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <efsubenovex@gmail.com>+-- Maintainer: Schell Scivally <schell@takt.com> -- -- [@Core@]--- Automaton based value streams. +-- Automaton based value streams. -- -- [@Event@]--- Discontinuous value streams that occur only sometimes. +-- Discontinuous value streams that occur only sometimes. -- -- [@Spline@] -- Sequencing of value and event streams using do-notation to form complex@@ -18,15 +18,12 @@ -- Tween numerical values over time using common easing functions. Great for -- animation. ---module Control.Varying- ( -- * Reexports- module Control.Varying.Core- , module Control.Varying.Event- , module Control.Varying.Spline- , module Control.Varying.Tween- ) where+module Control.Varying (+ -- * Reexports+ module V+) where -import Control.Varying.Core-import Control.Varying.Event-import Control.Varying.Tween-import Control.Varying.Spline +import Control.Varying.Core as V+import Control.Varying.Event as V+import Control.Varying.Spline as V+import Control.Varying.Tween as V
src/Control/Varying/Core.hs view
@@ -1,46 +1,44 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ > 710 -{-# OPTIONS_GHC -Wno-redundant-constraints #-}-#endif -- | -- Module: Control.Varying.Core -- Copyright: (c) 2015 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <efsubenovex@gmail.com>+-- Maintainer: Schell Scivally <schell@takt.com> -- -- Varying values represent values that change over a given domain. ----- A stream/signal takes some input know as the domain (e.g. time, place, etc)--- and when sampled using 'runVarT' - produces a value and a new stream. This--- pattern is known as an automaton. `varying` uses this pattern as its base--- type with the additon of a monadic computation to create locally stateful--- signals that change over some domain.+-- A varying value takes some input as its domain (e.g. time, place, etc)+-- and when run using 'runVarT' it produces a value and a new varying value.+-- This pattern is known as an automaton and `varying` uses this pattern at its+-- core. With the additon of monadic event sequencing, 'varying' makes it easy+-- to construct complicated signals that control program and data flow. module Control.Varying.Core ( -- * Types and Typeclasses Var , VarT(..)- -- * Creating streams+ -- * Creating vars -- $creation , done , var , arr , varM , mkState- -- * Composing streams+ -- * Composing vars -- $composition , (<<<) , (>>>) -- * Adjusting and accumulating , delay , accumulate- -- * Sampling streams (running and other entry points)+ -- * Sampling vars (running and other entry points) -- $running , scanVar , stepMany- -- * Debugging and tracing streams in flight+ -- * Debugging and tracing vars in flight , vtrace , vstrace , vftrace@@ -49,52 +47,54 @@ -- $proofs ) where -import Prelude hiding (id, (.))-import Control.Arrow-import Control.Category-import Control.Monad-import Control.Monad.IO.Class-import Data.Functor.Identity-import Debug.Trace-import Control.Applicative -#if __GLASGOW_HASKELL__ < 710-import Data.Monoid-#endif+import Control.Applicative+import Control.Arrow+import Control.Category+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Data.Functor.Contravariant+import Data.Functor.Identity+import Debug.Trace+import Prelude hiding (id, (.))+ -------------------------------------------------------------------------------- -- Core datatypes ----------------------------------------------------------------------------------- | A stream parameterized with Identity that takes input of type @a@+-- | A continuously varying value, with effects.+-- It's a kind of <https://en.wikipedia.org/wiki/Mealy_machine Mealy machine>+-- (an automaton).+newtype VarT m a b = VarT { runVarT :: a -> m (b, VarT m a b) }+ -- ^ Run a @VarT@ computation with an input value of+ -- type 'a', yielding a step - a value of type 'b'+ -- and a new computation for yielding the next step.+++-- | A var parameterized with Identity that takes input of type @a@ -- and gives output of type @b@. This is the pure, effect-free version of -- 'VarT'. type Var a b = VarT Identity a b --- | A stream is a structure that contains a value that changes over some--- input. It's a kind of--- <https://en.wikipedia.org/wiki/Mealy_machine Mealy machine> (an automaton)--- with effects. Using 'runVarT' with an input value of type 'a' yields a--- "step", which is a value of type 'b' and a new stream for yielding the next--- value.-newtype VarT m a b = VarT { runVarT :: a -> m (b, VarT m a b) }- -- ^ Given an input value, return a computation that- -- effectfully produces an output value and a new stream. -------------------------------------------------------------------------------- -- Typeclass instances ----------------------------------------------------------------------------------- | You can transform the output value of any stream:+-- | You can transform the output value of any var: -- -- >>> let v = 1 >>> fmap (*3) (accumulate (+) 0) -- >>> testVarOver v [(),(),()] -- 3 -- 6 -- 9-instance (Applicative m, Monad m) => Functor (VarT m b) where- fmap f v = (var f) . v--- | A very simple category instance. ---+instance Applicative m => Functor (VarT m b) where+ fmap f v = VarT $ (g <$>) . runVarT v+ where g (b, vb) = (f b, f <$> vb)++-- | A var is a category. -- @ -- id = var id -- f . g = g >>> f -- @+-- -- or -- -- > f . g = f <<< g@@ -104,28 +104,27 @@ -- 1 -- 2 -- 3-instance (Applicative m, Monad m) => Category (VarT m) where+instance Monad m => Category (VarT m) where id = var id- f0 . g0 = VarT $ \(!a) -> do+ f0 . g0 = VarT $ \a -> do (b, g) <- runVarT g0 a (c, f) <- runVarT f0 b return (c, f . g) --- | Streams are applicative.+-- | Vars are applicative. -- -- >>> let v = (,) <$> pure True <*> pure "Applicative" -- >>> testVarOver v [()] -- (True,"Applicative") -- -- Note - checkout the <$proofs proofs>-instance (Applicative m, Monad m) => Applicative (VarT m a) where+instance Applicative m => Applicative (VarT m a) where pure = done- vf <*> vx = VarT $ \(!a) -> do- (f, vf') <- runVarT vf a- (x, vx') <- runVarT vx a- return (f x, vf' <*> vx')+ vf <*> vx = VarT $ \a ->+ g <$> runVarT vf a <*> runVarT vx a+ where g (f, vf1) (x, vx1) = (f x, vf1 <*> vx1) --- | Streams are arrows, which means you can use proc notation, among other+-- | Vars are arrows, which means you can use proc notation, among other -- meanings. -- -- >>> :set -XArrows@@ -147,28 +146,76 @@ -- 3 -- 5 -- 7-instance (Applicative m, Monad m) => Arrow (VarT m) where+instance Monad m => Arrow (VarT m) where arr = var- first v = VarT $ \(b,d) -> do (c, v') <- runVarT v b- return ((c,d), first v')+ first v = VarT $ \(b, d) -> g d <$> runVarT v b+ where g d (c, v') = ((c, d), first v') --- | Streams can be monoids+instance MonadPlus m => ArrowZero (VarT m) where+ zeroArrow = varM $ const mzero++instance MonadPlus m => ArrowPlus (VarT m) where+ VarT f <+> VarT g = VarT $ \a -> f a `mplus` g a++-- |+instance Monad m => ArrowChoice (VarT m) where+ left f = f +++ arr id+ right f = arr id +++ f+ f +++ g = (f >>> arr Left) ||| (g >>> arr Right)+ f ||| g = VarT $ \case+ Left b -> do+ (d, f1) <- runVarT f b+ return (d, f1 ||| g)+ Right c -> do+ (d, g1) <- runVarT g c+ return (d, f ||| g1)++instance Monad m => ArrowApply (VarT m) where+ app = VarT $ \(v, b) -> do+ (c, _) <- runVarT v b+ return (c, app)++instance MonadFix m => ArrowLoop (VarT m) where+ loop vmbdcd = VarT $ \b -> fmap fst $ mfix $ \(_, d) -> do+ ((c1, d1), vmbdcd1) <- runVarT vmbdcd (b, d)+ return ((c1, loop vmbdcd1), d1)++-- | VarT with its input and output parameters flipped.+newtype FlipVarT m b a = FlipVarT { unFlipVarT :: VarT m a b }++-- | A VarT is contravariant when the type arguments are flipped.+instance Monad m => Contravariant (FlipVarT m b) where+ contramap f (FlipVarT vmab) = FlipVarT $ VarT $ \c -> do+ (b, vmab1) <- runVarT vmab $ f c+ return (b, unFlipVarT $ contramap f $ FlipVarT vmab1)++#if __GLASGOW_HASKELL__ >= 804+-- | Vars can be semigroups --+-- >>> let v = var (const "Hello ") <> var (const "World!")+-- >>> testVarOver v [()]+-- "Hello World!"+instance (Applicative m, Semigroup b) => Semigroup (VarT m a b) where+ (<>) = liftA2 (<>)+#endif++-- | Vars can be monoids+-- -- >>> let v = var (const "Hello ") `mappend` var (const "World!") -- >>> testVarOver v [()] -- "Hello World!"-instance (Applicative m, Monad m, Monoid b) => Monoid (VarT m a b) where+instance (Applicative m, Monoid b) => Monoid (VarT m a b) where mempty = pure mempty mappend = liftA2 mappend --- | Streams can be written as numbers.+-- | Vars can be written as numbers. -- -- >>> let v = 1 >>> accumulate (+) 0 -- >>> testVarOver v [(),(),()] -- 1 -- 2 -- 3-instance (Applicative m, Monad m, Num b) => Num (VarT m a b) where+instance (Monad m, Num b) => Num (VarT m a b) where (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*)@@ -176,14 +223,14 @@ signum = fmap signum fromInteger = pure . fromInteger --- | Streams can be written as floats.+-- | Vars can be written as floats. -- -- >>> let v = pi >>> accumulate (*) 1 >>> arr round -- >>> testVarOver v [(),(),()] -- 3 -- 10 -- 31-instance (Applicative m, Monad m, Floating b) => Floating (VarT m a b) where+instance (Monad m, Floating b) => Floating (VarT m a b) where pi = pure pi exp = fmap exp log = fmap log@@ -191,26 +238,26 @@ cos = fmap cos; cosh = fmap cosh; acos = fmap acos; acosh = fmap acosh atan = fmap atan; atanh = fmap atanh --- | Streams can be written as fractionals.+-- | Vars can be written as fractionals. -- -- >>> let v = 2.5 >>> accumulate (/) 10 -- >>> testVarOver v [(),(),()] -- 4.0 -- 1.6 -- 0.64-instance (Applicative m, Monad m, Fractional b) => Fractional (VarT m a b) where+instance (Monad m, Fractional b) => Fractional (VarT m a b) where (/) = liftA2 (/) fromRational = pure . fromRational -------------------------------------------------------------------------------- -- $creation--- You can create a pure stream by lifting a function @(a -> b)@+-- You can create a pure var by lifting a function @(a -> b)@ -- with 'var': -- -- > arr (+1) == var (+1) :: VarT m Int Int -- -- 'var' is a parameterized version of 'arr'. ----- You can create a monadic stream by lifting a monadic computation+-- You can create a monadic var by lifting a monadic computation -- @(a -> m b)@ using 'varM': -- -- @@@ -220,7 +267,7 @@ -- -- You can create either with the raw constructor. You can also create your -- own combinators using the raw constructor, as it allows you full control--- over how streams are stepped and sampled:+-- over how vars are stepped and sampled: -- -- > delay :: Monad m => b -> VarT m a b -> VarT m a b -- > delay b v = VarT $ \a -> return (b, go a v)@@ -228,37 +275,37 @@ -- > return (b', go a' v'') -- > ----------------------------------------------------------------------------------- | Lift a pure computation to a stream. This is 'arr' parameterized over the+-- | Lift a pure computation to a var. This is 'arr' parameterized over the -- @a `VarT m` b@ arrow. var :: Applicative m => (a -> b) -> VarT m a b-var f = VarT $ \(!a) -> pure (f a, var f)+var f = VarT $ \a -> pure (f a, var f) --- | Lift a monadic computation to a stream. This is+-- | Lift a monadic computation to a var. This is -- <http://hackage.haskell.org/package/arrow-list-0.7/docs/Control-Arrow-Kleisli-Class.html#v:arrM arrM> -- parameterized over the @a `VarT m` b@ arrow. varM :: Monad m => (a -> m b) -> VarT m a b-varM f = VarT $ \(!a) -> do+varM f = VarT $ \a -> do b <- f a return (b, varM f) --- | Lift a constant value to a stream.-done :: (Applicative m, Monad m) => b -> VarT m a b-done b = VarT $ \(!_) -> return (b, done b)+-- | Lift a constant value to a var.+done :: Applicative m => b -> VarT m a b+done = var . const --- | Create a stream from a state transformer.+-- | Create a var from a state transformer. mkState :: Monad m => (a -> s -> (b, s)) -- ^ state transformer -> s -- ^ intial state -> VarT m a b-mkState f s = VarT $ \(!a) -> do+mkState f s = VarT $ \a -> do let (b', s') = f a s return (b', mkState f s') -------------------------------------------------------------------------------- -- $composition--- You can compose streams together using Category's '>>>' and '<<<'. The "right--- plug" ('>>>') takes the output from a stream on the left and "plugs" it into--- the input of the stream on the right. The "left plug" does the same thing in--- the opposite direction. This allows you to write streams that read+-- You can compose vars together using Category's '>>>' and '<<<'. The "right+-- plug" ('>>>') takes the output from a var on the left and "plugs" it into+-- the input of the var on the right. The "left plug" does the same thing in+-- the opposite direction. This allows you to write vars that read -- naturally. -------------------------------------------------------------------------------- --------------------------------------------------------------------------------@@ -274,12 +321,12 @@ -- -- >>> print $ foldl (++) [] $ words "hey there man" -- "heythereman"-accumulate :: (Monad m, Applicative m) => (c -> b -> c) -> c -> VarT m b c-accumulate f b = VarT $ \(!a) -> do+accumulate :: Monad m => (c -> b -> c) -> c -> VarT m b c+accumulate f b = VarT $ \a -> do let b' = f b a return (b', accumulate f b') --- | Delays the given stream by one sample using the argument as the first+-- | Delays the given var by one sample using the argument as the first -- sample. -- -- >>> testVarOver (delay 0 id) [1,2,3]@@ -287,21 +334,21 @@ -- 1 -- 2 ----- This enables the programmer to create streams that depend on+-- This enables the programmer to create vars that depend on -- themselves for values. For example: -- -- >>> let v = delay 0 v + 1 in testVarOver v [1,1,1] -- 1 -- 2 -- 3-delay :: (Monad m, Applicative m) => b -> VarT m a b -> VarT m a b-delay b v = VarT $ \(!a) -> return (b, go a v)- where go a v' = VarT $ \(!a') -> do (b', v'') <- runVarT v' a- return (b', go a' v'')+delay :: Monad m => b -> VarT m a b -> VarT m a b+delay b v = VarT $ \a -> return (b, go a v)+ where go a v' = VarT $ \a' -> do (b', v'') <- runVarT v' a+ return (b', go a' v'') -------------------------------------------------------------------------------- -- $running--- To sample a stream simply run it in the desired monad with--- 'runVarT'. This will produce a sample value and a new stream.+-- To sample a var simply run it in the desired monad with+-- 'runVarT'. This will produce a sample value and a new var. -- -- >>> :{ -- do let v0 = accumulate (+) 0@@ -316,33 +363,33 @@ -- 2 -- 4 ----------------------------------------------------------------------------------- | Iterate a stream over a list of input until all input is consumed,--- then iterate the stream using one single input. Returns the resulting--- output value and the new stream.+-- | Iterate a var over a list of input until all input is consumed,+-- then iterate the var using one single input. Returns the resulting+-- output value and the new var. -- -- >>> let Identity (outputs, _) = stepMany (accumulate (+) 0) [1,1,1] 1 -- >>> print outputs -- 4-stepMany :: (Monad m, Functor m) => VarT m a b -> [a] -> a -> m (b, VarT m a b)-stepMany v [] e = runVarT v e+stepMany :: (Monad m) => VarT m a b -> [a] -> a -> m (b, VarT m a b)+stepMany v [] e = runVarT v e stepMany v (e:es) x = snd <$> runVarT v e >>= \v1 -> stepMany v1 es x --- | Run the stream over the input values, gathering the output values in a+-- | Run the var over the input values, gathering the output values in a -- list. -- -- >>> let Identity (outputs, _) = scanVar (accumulate (+) 0) [1,1,1,1] -- >>> print outputs -- [1,2,3,4]-scanVar :: (Applicative m, Monad m) => VarT m a b -> [a] -> m ([b], VarT m a b)+scanVar :: Monad m => VarT m a b -> [a] -> m ([b], VarT m a b) scanVar v = foldM f ([], v) where f (outs, v') a = do (b, v'') <- runVarT v' a return (outs ++ [b], v'') -------------------------------------------------------------------------------- -- Testing and debugging ----------------------------------------------------------------------------------- | Trace the sample value of a stream and pass it along as output. This is--- very useful for debugging graphs of streams. The (v|vs|vf)trace family of--- streams use 'Debug.Trace.trace' under the hood, so the value is only traced+-- | Trace the sample value of a var and pass it along as output. This is+-- very useful for debugging graphs of vars. The (v|vs|vf)trace family of+-- vars use 'Debug.Trace.trace' under the hood, so the value is only traced -- when evaluated. -- -- >>> let v = id >>> vtrace@@ -356,8 +403,9 @@ vtrace :: (Applicative a, Show b) => VarT a b b vtrace = vstrace "" --- | Trace the sample value of a stream with a prefix and pass the sample along--- as output. This is very useful for debugging graphs of streams.++-- | Trace the sample value of a var with a prefix and pass the sample along+-- as output. This is very useful for debugging graphs of vars. -- -- >>> let v = id >>> vstrace "test: " -- >>> testVarOver v [1,2,3]@@ -371,7 +419,7 @@ vstrace s = vftrace ((s ++) . show) -- | Trace the sample value using a custom show-like function. This is useful--- when you would like to debug a stream that uses values that don't have show+-- when you would like to debug a var that uses values that don't have show -- instances. -- -- >>> newtype NotShowableInt = NotShowableInt { unNotShowableInt :: Int }@@ -387,9 +435,9 @@ vftrace :: Applicative a => (b -> String) -> VarT a b b vftrace f = var $ \b -> trace (f b) b --- | Run a stream in IO over some input, printing the output each step. This is+-- | Run a var in IO over some input, printing the output each step. This is -- the function we've been using throughout this documentation.-testVarOver :: (Applicative m, Monad m, MonadIO m, Show b)+testVarOver :: (Monad m, MonadIO m, Show b) => VarT m a b -> [a] -> m () testVarOver v xs = fst <$> scanVar v xs >>= mapM_ (liftIO . print) --------------------------------------------------------------------------------
src/Control/Varying/Event.hs view
@@ -1,8 +1,9 @@+{-# LANGUAGE LambdaCase #-} -- | -- Module: Control.Varying.Event -- Copyright: (c) 2015 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <schell.scivally@synapsegroup.com>+-- Maintainer: Schell Scivally <schell@takt.com> -- -- An event stream is simply a stream of @Maybe a@. This kind of stream is -- considered to be only defined at those occurances of @Just a@. Events@@ -18,10 +19,7 @@ -- is running. For more info on switching and sequencing streams with events -- please check out 'Control.Varying.Spline', which lets you chain together -- sequences of values and events using a familiar do-notation.-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 800 -{-# OPTIONS_GHC -Wno-redundant-constraints #-}-#endif+ module Control.Varying.Event ( -- * Event constructors (synonyms of Maybe) Event@@ -48,21 +46,18 @@ , never , before , after+ -- * Switching+ , switch -- * Bubbling , onlyWhen , onlyWhenE ) where -import Prelude hiding (until)-import Control.Varying.Core-import Control.Monad-import Data.Foldable (foldl')---- stuff for FAMP-#if __GLASGOW_HASKELL__ < 709-import Control.Applicative-import Data.Function-#endif+import Control.Applicative+import Control.Monad+import Control.Varying.Core+import Data.Foldable (foldl')+import Prelude hiding (until) type Event = Maybe @@ -95,7 +90,7 @@ -- @ -- 'use' b 'onTrue' :: 'Monad' m => 'VarT' m 'Bool' ('Event' b) -- @-onTrue :: (Applicative m, Monad m) => VarT m Bool (Event ())+onTrue :: Monad m => VarT m Bool (Event ()) onTrue = var $ \b -> if b then Just () else Nothing -- | Triggers an @'Event' a@ when the input is distinct from the previous@@ -104,7 +99,7 @@ -- @ -- 'use' b 'onUnique' :: ('Eq' x, 'Monad' m) => 'VarT' m x ('Event' b) -- @-onUnique :: (Applicative m, Monad m, Eq a) => VarT m a (Event a)+onUnique :: (Monad m, Eq a) => VarT m a (Event a) onUnique = VarT $ \a -> return (Just a, trigger a) where trigger a' = VarT $ \a'' -> let e = if a' == a'' then Nothing@@ -125,6 +120,7 @@ in return (acc', foldStream f acc') Nothing -> return (acc, foldStream f acc) + -- | Produces the given value until the input events produce a value, then -- produce that value until a new input event produces. This always holds -- the last produced value, starting with the given value.@@ -132,13 +128,26 @@ -- @ -- time '>>>' 'Control.Varying.Time.after' 3 '>>>' 'startingWith' 0 -- @-startWith, startingWith :: (Applicative m, Monad m) => a -> VarT m (Event a) a-startWith = foldStream (\_ a -> a)+--+-- >>> :{+-- let v = onWhen (== 3) >>> startingWith 0+-- in testVarOver v [0, 1, 2, 3, 4]+-- >>> :}+-- 0+-- 0+-- 0+-- 3+-- 3+startWith, startingWith+ :: Monad m+ => a+ -> VarT m (Event a) a+startWith = foldStream (\_ a -> a) startingWith = startWith -- | Stream through some number of successful 'Event's and then inhibit -- forever.-takeE :: (Applicative m, Monad m)+takeE :: Monad m => Int -> VarT m a (Event b) -> VarT m a (Event b) takeE 0 _ = never takeE n ve = VarT $ \a -> do@@ -148,7 +157,7 @@ Just b -> return (Just b, takeE (n-1) ve') -- | Inhibit the first n occurences of an 'Event'.-dropE :: (Applicative m, Monad m)+dropE :: Monad m => Int -> VarT m a (Event b) -> VarT m a (Event b) dropE 0 ve = ve dropE n ve = VarT $ \a -> do@@ -158,7 +167,7 @@ Just _ -> return (Nothing, dropE (n-1) ve') -- | Inhibit all 'Event's that don't pass the predicate.-filterE :: (Applicative m, Monad m)+filterE :: Monad m => (b -> Bool) -> VarT m a (Event b) -> VarT m a (Event b) filterE p v = (join . (check <$>)) <$> v where check b = if p b then Just b else Nothing@@ -167,7 +176,7 @@ -------------------------------------------------------------------------------- -- | Combine two 'Event' streams. Produces an event only when both streams proc -- at the same time.-bothE :: (Applicative m, Monad m)+bothE :: Monad m => (a -> b -> c) -> VarT m a (Event a) -> VarT m a (Event b) -> VarT m a (Event c) bothE f va vb = (\ea eb -> f <$> ea <*> eb) <$> va <*> vb@@ -175,7 +184,7 @@ -- | Combine two 'Event' streams and produce an 'Event' any time either stream -- produces. In the case that both streams produce, this produces the 'Event' -- of the leftmost stream.-anyE :: (Applicative m, Monad m) => [VarT m a (Event b)] -> VarT m a (Event b)+anyE :: Monad m => [VarT m a (Event b)] -> VarT m a (Event b) anyE [] = never anyE vs = VarT $ \a -> do outs <- mapM (`runVarT` a) vs@@ -185,7 +194,7 @@ -- Primitive event streams -------------------------------------------------------------------------------- -- | Produce the given event value once and then inhibit forever.-once :: (Applicative m, Monad m) => b -> VarT m a (Event b)+once :: Monad m => b -> VarT m a (Event b) once b = VarT $ \_ -> return (Just b, never) -- | Never produces any 'Event' values.@@ -193,7 +202,7 @@ -- @ -- 'never' = 'pure' 'Nothing' -- @-never :: (Applicative m, Monad m) => VarT m b (Event c)+never :: Monad m => VarT m b (Event c) never = pure Nothing -- | Produces 'Event's with the initial value forever.@@ -201,27 +210,69 @@ -- @ -- 'always' e = 'pure' ('Event' e) -- @-always :: (Applicative m, Monad m) => b -> VarT m a (Event b)+always :: Monad m => b -> VarT m a (Event b) always = pure . Just -- | Emits events before accumulating t of input dt. -- Note that as soon as we have accumulated >= t we stop emitting events -- and therefore an event will never be emitted exactly at time == t.-before :: (Applicative m, Monad m, Num t, Ord t) => t -> VarT m t (Event t)+before :: (Monad m, Num t, Ord t) => t -> VarT m t (Event t) before t = accumulate (+) 0 >>> onWhen (< t) -- | Emits events after t input has been accumulated. -- Note that event emission is not guaranteed to begin exactly at t, -- since it depends on the input.-after :: (Applicative m, Monad m, Num t, Ord t) => t -> VarT m t (Event t)-after t = accumulate (+) 0 >>> onWhen (>= t) +after :: (Monad m, Num t, Ord t) => t -> VarT m t (Event t)+after t = accumulate (+) 0 >>> onWhen (>= t)+ --------------------------------------------------------------------------------+-- Switching+--------------------------------------------------------------------------------+-- | Higher-order switching.+-- Use an event stream of value streams and produces event values of the latest+-- produced value stream. Switches to a new value stream each time one is+-- produced. The currently used value stream maintains local state until the+-- outer event stream produces a new value stream.+--+-- In this example we're sequencing the value streams we'd like to use and then+-- switching them when the outer event stream fires.+--+-- >>> import Control.Varying.Spline+-- >>> :{+-- let v :: VarT IO () (Event Int)+-- v = switch $ flip outputStream Nothing $ do+-- step $ Just $ 1 >>> accumulate (+) 0+-- step Nothing+-- step Nothing+-- step $ Just 5+-- step Nothing+-- in testVarOver v [(), (), (), (), ()] -- testing over five frames+-- >>> :}+-- Just 1+-- Just 2+-- Just 3+-- Just 5+-- Just 5+switch+ :: Monad m+ => VarT m a (Event (VarT m a b))+ -> VarT m a (Event b)+switch = switchGo $ pure Nothing+ where switchGo vInner v = VarT $ \a -> runVarT v a >>= \case+ (Nothing, vOuter) -> do+ (mayB, vInner1) <- runVarT vInner a+ return (mayB, switchGo vInner1 vOuter)+ (Just vInner2, vOuter) -> do+ (mayB, vInner3) <- runVarT (Just <$> vInner2) a+ return (mayB, switchGo vInner3 vOuter)++-------------------------------------------------------------------------------- -- Bubbling -------------------------------------------------------------------------------- -- | Produce events of a stream @v@ only when an event stream @h@ produces an -- event. -- @v@ and @h@ maintain state while cold.-onlyWhenE :: (Applicative m, Monad m)+onlyWhenE :: Monad m => VarT m a b -- ^ @v@ - The value stream -> VarT m a (Event c) -- ^ @h@ - The event stream -> VarT m a (Event b)@@ -235,7 +286,7 @@ -- | Produce 'Event's of a value stream @v@ only when its input value passes a -- predicate @f@. -- @v@ maintains state while cold.-onlyWhen :: (Applicative m, Monad m)+onlyWhen :: Monad m => VarT m a b -- ^ @v@ - The value stream -> (a -> Bool) -- ^ @f@ - The predicate to run on @v@'s input values. -> VarT m a (Event b)
src/Control/Varying/Spline.hs view
@@ -2,24 +2,20 @@ -- Module: Control.Varying.Spline -- Copyright: (c) 2015 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <efsubenovex@gmail.com>+-- Maintainer: Schell Scivally <schell@takt.com> -- -- Using splines we can easily create continuous streams from discontinuous--- streams. A spline is a monadic layer on top of streams. The idea is that we--- use a monad to splice together sequences of streams that eventually end. This--- means taking two streams - an output stream and an event stream - combining--- them into a temporarily producing stream. Once that "stream pair" inhibits--- (stops producing), the computation completes and returns a result value. That--- result value is then used to determine the next spline in the sequence.-{-# LANGUAGE GADTs #-}+-- streams. A spline is a monadic layer on top of event streams which are only+-- continuous over a certain domain. The idea is that we use a monad to+-- "run a stream switched by events". This means taking two streams - an output+-- stream and an event stream, and combining them into a temporarily producing+-- stream. Once that "stream pair" inhibits, the computation completes and+-- returns a result value. That result value is then used to determine the next+-- spline in the sequence. {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TupleSections #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 800-{-# OPTIONS_GHC -Wno-redundant-constraints #-}-#endif+{-# LANGUAGE TupleSections #-} module Control.Varying.Spline ( -- * Spline Spline@@ -28,6 +24,7 @@ -- * Creating streams from splines , outputStream -- * Creating splines from streams+ , fromEvent , untilProc , whileProc , untilEvent@@ -48,19 +45,13 @@ -- $proofs ) where -import Control.Varying.Core-import Control.Varying.Event-import Control.Monad-import Control.Monad.Trans.Class-import Control.Monad.IO.Class-import Data.Functor.Identity-import Data.Monoid---- stuff for FAMP-#if __GLASGOW_HASKELL__ < 709-import Control.Applicative-import Data.Function-#endif+import Control.Monad+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Control.Varying.Core+import Control.Varying.Event+import Data.Functor.Identity+import Data.Monoid -- $setup -- >>> import Control.Varying.Time@@ -76,7 +67,7 @@ -- can be used to determine the next spline to run. Using 'outputStream' we can -- then fuse these piecewise continuous (but otherwise discontinuous) streams -- into one continuous stream of type @VarT m a b@. Alternatively you can simply--- poll the network until it ends using 'runSplineT'. +-- poll the network until it ends using 'runSplineT'. newtype SplineT a b m c = SplineT { runSplineT :: a -> m (Either c (b, SplineT a b m c)) } @@ -87,13 +78,13 @@ -- >>> :{ -- let s0 = pure "first" `untilEvent` (1 >>> after 2) -- s = do str <- fmap show s0--- step str --- v = outputStream s "" +-- step str+-- v = outputStream s "" -- in testVarOver v [(),()] -- >>> :} -- "first" -- "(\"first\",2)"-instance (Applicative m, Monad m) => Functor (SplineT a b m) where+instance Monad m => Functor (SplineT a b m) where fmap f (SplineT s) = SplineT $ s >=> \case Left c -> return $ Left $ f c Right (b, s1) -> return $ Right (b, fmap f s1)@@ -102,7 +93,7 @@ -- then uses that value to run the next spline. -- -- Note - checkout the <$proofs proofs>-instance (Applicative m, Monad m) => Monad (SplineT a b m) where+instance Monad m => Monad (SplineT a b m) where return = SplineT . const . return . Left (SplineT s0) >>= f = SplineT $ g s0 where g s a = do e <- s a@@ -110,7 +101,7 @@ Left c -> runSplineT (f c) a Right (b, SplineT s1) -> return $ Right (b, SplineT $ g s1) --- A spline responds to 'pure' by returning a spline that never produces an+-- | A spline responds to 'pure' by returning a spline that never produces an -- output value and immediately returns the argument. It responds to '<*>' by -- applying the left arguments result value (the function) to the right -- arguments result value (the argument), sequencing them both in serial.@@ -122,7 +113,7 @@ -- x <- sx -- return $ f x -- @-instance (Applicative m, Monad m) => Applicative (SplineT a b m) where+instance Monad m => Applicative (SplineT a b m) where pure = return sf <*> sx = do f <- sf@@ -130,10 +121,10 @@ return $ f x -- | A spline is a transformer by running the effect and immediately concluding,--- using the effect's result as the result value. --- +-- using the effect's result as the result value.+-- -- >>> :{--- let s = do () <- lift $ print "Hello" +-- let s = do () <- lift $ print "Hello" -- step 2 -- v = outputStream s 0 -- in testVarOver v [()]@@ -141,11 +132,11 @@ -- "Hello" -- 2 instance MonadTrans (SplineT a b) where- lift f = SplineT $ const $ f >>= return . Left+ lift f = SplineT $ const $ Left <$> f -- | A spline can do IO if its underlying monad has a MonadIO instance. It -- takes the result of the IO action as its immediate return value.-instance (Applicative m, Monad m, MonadIO m) => MonadIO (SplineT a b m) where+instance (Monad m, MonadIO m) => MonadIO (SplineT a b m) where liftIO = lift . liftIO -- | A SplineT monad parameterized with Identity that takes input of type @a@,@@ -157,7 +148,7 @@ -- function takes a default value to use as the "last known value". -- -- >>> :{--- let s :: SplineT () String IO () +-- let s :: SplineT () String IO () -- s = do first <- pure "accumulating until 3" `_untilEvent` (1 >>> after 3) -- secnd <- pure "accumulating until 4" `_untilEvent` (1 >>> after 4) -- if first + secnd == 7@@ -172,7 +163,7 @@ -- "accumulating until 4" -- "accumulating until 4" -- "done"-outputStream :: (Applicative m, Monad m)+outputStream :: Monad m => SplineT a b m c -> b -> VarT m a b outputStream (SplineT s0) b0 = VarT $ f s0 b0 where f s b a = do e <- s a@@ -182,21 +173,29 @@ -- | Run the spline over the input values, gathering the output values in a -- list.-scanSpline :: (Applicative m, Monad m)+scanSpline :: Monad m => SplineT a b m c -> b -> [a] -> m [b] scanSpline s b = fmap fst <$> scanVar (outputStream s b) +-- | Create a spline from an event stream.+fromEvent :: Monad m => VarT m a (Event b) -> SplineT a (Event b) m b+fromEvent ve = SplineT $ \a -> do+ (e, ve1) <- runVarT ve a+ return $ case e of+ Just b -> Left b+ Nothing -> Right (Nothing, fromEvent ve1)+ -- | Create a spline from an event stream. Outputs 'noevent' until the event -- stream procs, at which point the spline concludes with the event value.-untilProc :: (Applicative m, Monad m) => VarT m a (Event b) -> SplineT a (Event b) m b-untilProc ve = SplineT $ runVarT ve >=> return . \case +untilProc :: Monad m => VarT m a (Event b) -> SplineT a (Event b) m b+untilProc ve = SplineT $ runVarT ve >=> return . \case (Just b, _) -> Left b (Nothing, ve1) -> Right (Nothing, untilProc ve1) -- | Create a spline from an event stream. Outputs @b@ until the event stream -- inhibits, at which point the spline concludes with @()@.-whileProc :: (Applicative m, Monad m) => VarT m a (Event b) -> SplineT a b m () -whileProc ve = SplineT $ runVarT ve >=> return . \case +whileProc :: Monad m => VarT m a (Event b) -> SplineT a b m ()+whileProc ve = SplineT $ runVarT ve >=> return . \case (Just b, ve1) -> Right (b, whileProc ve1) (Nothing, _) -> Left () @@ -204,25 +203,26 @@ -- uses the stream's values as its own output values. The spline will run until -- the event stream produces an event, at that point the last known output -- value and the event value are tupled and returned as the spline's result.-untilEvent :: (Applicative m, Monad m)+untilEvent :: Monad m => VarT m a b -> VarT m a (Event c) -> SplineT a b m (b,c) untilEvent v ve = SplineT $ f ((,) <$> v <*> ve)- where f vve = runVarT vve >=> return . \case - ((b, Nothing), vve1) -> Right (b, SplineT $ f vve1)- ((b, Just c), _) -> Left (b, c)+ where f vve a = do t <-runVarT vve a+ return $ case t of+ ((b, Nothing), vve1) -> Right (b, SplineT $ f vve1)+ ((b, Just c), _) -> Left (b, c) -- | A variant of 'untilEvent' that results in the last known output value.-untilEvent_ :: (Applicative m, Monad m)+untilEvent_ :: Monad m => VarT m a b -> VarT m a (Event c) -> SplineT a b m b untilEvent_ v ve = fst <$> untilEvent v ve -- | A variant of 'untilEvent' that results in the event steam's event value.-_untilEvent :: (Applicative m, Monad m)+_untilEvent :: Monad m => VarT m a b -> VarT m a (Event c) -> SplineT a b m c _untilEvent v ve = snd <$> untilEvent v ve -- | A variant of 'untilEvent' that discards both the output and event values.-_untilEvent_ :: (Applicative m, Monad m)+_untilEvent_ :: Monad m => VarT m a b -> VarT m a (Event c) -> SplineT a b m () _untilEvent_ v ve = void $ _untilEvent v ve @@ -241,7 +241,7 @@ -- "route 666" -- "Left 2" -- "Left 2"-race :: (Applicative m, Monad m)+race :: Monad m => (a -> b -> c) -> SplineT i a m d -> SplineT i b m e -> SplineT i c m (Either d e) race f sa0 sb0 = SplineT (g sa0 sb0)@@ -258,7 +258,7 @@ -- >>> :{ -- let ss = [ pure "hey " `_untilEvent` (1 >>> after 5) -- , pure "there" `_untilEvent` (1 >>> after 3)--- , pure "!" `_untilEvent` (1 >>> after 2) +-- , pure "!" `_untilEvent` (1 >>> after 2) -- ] -- s = do winner <- raceAny ss -- step $ show winner@@ -267,7 +267,7 @@ -- >>> :} -- "hey there!" -- "2"-raceAny :: (Applicative m, Monad m, Monoid b)+raceAny :: (Monad m, Monoid b) => [SplineT a b m c] -> SplineT a b m c raceAny [] = pure mempty `_untilEvent` never raceAny ss = SplineT $ f [] (map runSplineT ss) mempty@@ -289,8 +289,8 @@ -- >>> :} -- "hey there!" -- "hey "--- "(3,2)" -merge :: (Applicative m, Monad m)+-- "(3,2)"+merge :: Monad m => (b -> b -> b) -> SplineT a b m c -> SplineT a b m d -> SplineT a b m (c, d) merge apnd s1 s2 = SplineT $ f s1 s2@@ -324,11 +324,11 @@ -- step $ x + 1 -- in testVarOver (outputStream s 666) [(),(),(),()] -- >>> :}--- 0 +-- 0 -- 1 -- 2 -- 3-capture :: (Applicative m, Monad m)+capture :: Monad m => SplineT a b m c -> SplineT a b m (Event b, c) capture = SplineT . f Nothing where f mb s = runSplineT s >=> return . \case@@ -347,19 +347,19 @@ -- "there" -- "friend" -- "friend"-step :: (Applicative m, Monad m) => b -> SplineT a b m ()+step :: Monad m => b -> SplineT a b m () step b = SplineT $ const $ return $ Right (b, return ()) -- | Map the output value of a spline. -- -- >>> :{--- let s = mapOutput (pure show) $ step 1 >> step 2 >> step 3 --- in testVarOver (outputStream s "") [(),(),()] +-- let s = mapOutput (pure show) $ step 1 >> step 2 >> step 3+-- in testVarOver (outputStream s "") [(),(),()] -- >>> :} -- "1" -- "2" -- "3"-mapOutput :: (Applicative m, Monad m)+mapOutput :: Monad m => VarT m a (b -> t) -> SplineT a b m c -> SplineT a t m c mapOutput vf0 s0 = SplineT $ g vf0 s0 where g vf s a = do@@ -369,7 +369,7 @@ Right (b, s1) -> Right (f b, SplineT $ g vf1 s1) -- | Map the input value of a spline.-adjustInput :: (Applicative m, Monad m)+adjustInput :: Monad m => VarT m a (a -> r) -> SplineT r b m c -> SplineT a b m c adjustInput vf0 s = SplineT $ g vf0 s where g vf sx a = do@@ -379,7 +379,7 @@ Right (b, sx1) -> Right (b, SplineT $ g vf1 sx1) ----------------------------------------------------------------------------------- $proofs +-- $proofs -- ==Left Identity -- > k =<< return c = k c --@@ -501,4 +501,4 @@ -- ==Application -- > (m >>= f) >>= g = m >>= (\x -> f x >>= g) --- TODO+-- TODO: Finish the rest of the hand proofs
src/Control/Varying/Tween.hs view
@@ -2,7 +2,7 @@ -- Module: Control.Varying.Tween -- Copyright: (c) 2016 Schell Scivally -- License: MIT--- Maintainer: Schell Scivally <efsubenovex@gmail.com>+-- Maintainer: Schell Scivally <schell@takt.com> -- -- Tweening is a technique of generating intermediate samples of a type -- __between__ a start and end value. By sampling a running tween@@ -51,18 +51,20 @@ -- $writing ) where -import Control.Varying.Core-import Control.Varying.Event-import Control.Varying.Spline-import Control.Monad.Trans.State-import Control.Applicative-import Data.Functor.Identity+import Control.Monad (void)+import Control.Monad.Trans.State (StateT, evalStateT, get, put,+ runStateT)+import Control.Varying.Core (VarT (..), done)+import Control.Varying.Spline (SplineT (..), mapOutput, scanSpline,+ untilEvent_)+import Control.Varying.Event (after)+import Data.Functor.Identity (Identity) -------------------------------------------------------------------------------- -- $lerping -- These pure functions take a `c` (total change in value, ie end - start), -- `t` (percent of duration completion) and `b` (start value) and result in--- and interpolation of a value. To see what these look like please check+-- an interpolation of a value. To see what these look like please check -- out http://www.gizma.com/easing/. -------------------------------------------------------------------------------- -- | Ease in quadratic.@@ -127,28 +129,32 @@ -- | Ease linear. linear :: (Floating t, Real f) => Easing t f-linear c t b = c * (realToFrac t) + b+linear c t b = c * realToFrac t + b +-- TODO: Don't use StateT for leftover time in Tweens.+-- This creates a funky state where running two tween splines together+-- causes leftover time interplay. Think about continuations or something.+ type TweenT f t m = SplineT f t (StateT f m) type Tween f t = TweenT f t Identity -runTweenT :: (Monad m, Num f)- => TweenT f t m x -> f -> f -> m (Either x (t, TweenT f t m x), f)+runTweenT :: TweenT f t m x -> f -> f -> m (Either x (t, TweenT f t m x), f) runTweenT s dt = runStateT (runSplineT s dt) -scanTween :: (Functor m, Applicative m, Monad m, Num f)+scanTween :: (Monad m, Num f) => TweenT f t m a -> t -> [f] -> m [t] scanTween s t dts = evalStateT (scanSpline s t dts) 0 -- | Converts a tween into a continuous value stream. This is the tween version -- of `outputStream`.-tweenStream :: (Applicative m, Monad m, Num f)+tweenStream :: (Monad m, Num f) => TweenT f t m x -> t -> VarT m f t tweenStream s0 t0 = VarT $ f s0 t0 0 where f s t l i = do (e, l1) <- runTweenT s i l case e of- Left _ -> return (t, done t)+ Left _ -> return (t, done t) Right (b, s1) -> return (b, VarT $ f s1 b l1)+ -------------------------------------------------------------------------------- -- $creation -- The most direct route toward tweening values is to use 'tween'@@ -161,12 +167,12 @@ -- | Creates a spline that produces a value interpolated between a start and -- end value using an easing equation ('Easing') over a duration. The -- resulting spline will take a time delta as input.--- Keep in mind `tween` must be fed time deltas, not absolute time or+-- Keep in mind that `tween` must be fed time deltas, not absolute time or -- duration. This is mentioned because the author has made that mistake -- more than once ;) -- -- `tween` concludes returning the latest output value.-tween :: (Applicative m, Monad m, Real f, Fractional f, Real t, Fractional t)+tween :: (Monad m, Real t, Real f, Fractional f) => Easing t f -> t -> t -> f -> TweenT f t m t tween f start end dur = SplineT g where c = end - start@@ -190,26 +196,26 @@ -- tween f a b c >> return () -- @ ---tween_ :: (Applicative m, Monad m, Real t, Fractional t, Real f, Fractional f)+tween_ :: (Monad m, Real t, Real f, Fractional f) => Easing t f -> t -> t -> f -> TweenT f t m ()-tween_ f a b c = tween f a b c >> return ()+tween_ f a b c = Control.Monad.void (tween f a b c) -- | A version of 'tween' that maps its output using the given constant -- function. -- @ -- withTween ease from to dur f = mapOutput (pure f) $ tween ease from to dur -- @-withTween :: (Applicative m, Monad m, Real t, Fractional t, Real a, Fractional a)+withTween :: (Monad m, Real t, Real a, Fractional a) => Easing t a -> t -> t -> a -> (t -> x) -> TweenT a x m t withTween ease from to dur f = mapOutput (pure f) $ tween ease from to dur -- | A version of 'withTween' that discards its output.-withTween_ :: (Applicative m, Monad m, Real t, Fractional t, Real a, Fractional a)+withTween_ :: (Monad m, Real t, Real a, Fractional a) => Easing t a -> t -> t -> a -> (t -> x) -> TweenT a x m ()-withTween_ ease from to dur f = withTween ease from to dur f >> return ()+withTween_ ease from to dur f = Control.Monad.void (withTween ease from to dur f) -- | Creates a tween that performs no interpolation over the duration.-constant :: (Applicative m, Monad m, Num t, Ord t)+constant :: (Monad m, Num t, Ord t) => a -> t -> TweenT t a m a constant value duration = pure value `untilEvent_` after duration --------------------------------------------------------------------------------@@ -229,6 +235,6 @@ -- duration that has elapsed and `b` is the start value. -- -- To make things simple only numerical values can be tweened and the type--- of time deltas much match the tween's value type. This may change in the+-- of time deltas must match the tween's value type. This may change in the -- future :) type Easing t f = t -> f -> t -> t
test/Main.hs view
@@ -1,8 +1,4 @@-{-# LANGUAGE CPP #-}--#if __GLASGOW_HASKELL__ > 710 -{-# OPTIONS_GHC -Wno-redundant-constraints #-}-#endif+{-# LANGUAGE ScopedTypeVariables #-} module Main where @@ -13,26 +9,23 @@ import Data.Functor.Identity import Data.Time.Clock -#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif- main :: IO () main = hspec $ do- describe "before" $ + describe "before" $ it "should produce events before a given step" $ do let varEv :: Var () (Maybe Int) varEv = 1 >>> before 3 scans = fst $ runIdentity $ scanVar varEv $ replicate 4 () scans `shouldBe` [Just 1, Just 2, Nothing, Nothing] - describe "after" $ + describe "after" $ it "should produce events after a given step" $ do let varEv :: Var () (Maybe Int) varEv = 1 >>> after 3 scans = fst $ runIdentity $ scanVar varEv $ replicate 4 () scans `shouldBe` [Nothing, Nothing, Just 3, Just 4]- describe "anyE" $ ++ describe "anyE" $ it "should produce on any event" $ do let v1,v2,v3 :: Var () (Maybe Int) v1 = use 1 ((1 :: Var () Int) >>> before 2)@@ -125,8 +118,9 @@ return 1 s3 = do step "e" step "t"- return 2 + return (2 :: Int) s = do x <- raceAny [s1,s2,s3]+ step $ show x Identity scans = scanSpline s "" $ replicate 3 () it "should output in parallel (mappend) and return the first or leftmost result" $ unwords scans `shouldBe` "the cat 0"@@ -206,8 +200,8 @@ pyu = pure ($ 1) <*> u it "(interchange) u <*> pure y = pure ($ y) <*> u" $ equal upy pyu let v :: Spline a Int (Int -> Int)- v = pure 66 `_untilEvent` (use (1-) $ 1 >>> after (4 :: Float))- w = pure 72 `_untilEvent` (use 3 $ 1 >>> after (1 :: Float))+ v = pure 66 `_untilEvent` use (1-) (1 >>> after (4 :: Float))+ w = pure 72 `_untilEvent` use 3 (1 >>> after (1 :: Float)) pduvw = pure (.) <*> u <*> v <*> w uvw = u <*> (v <*> w) it "(compisition) pure (.) <*> u <*> v <*> w = u <*> (v <*> w)" $
varying.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.7.0.3+version: 0.7.1.0 -- A short (one-line) description of the package. synopsis: FRP through value streams and monadic splines.@@ -35,7 +35,7 @@ -- An email address to which users can send suggestions, bug reports, and -- patches.-maintainer: efsubenovex@gmail.com +maintainer: schell@takt.com -- A copyright notice. -- copyright:@@ -59,6 +59,9 @@ library ghc-options: -Wall+ if impl(ghc >= 8)+ ghc-options: -Wno-type-defaults+ -- Modules exported by the library. exposed-modules: Control.Varying, Control.Varying.Core,@@ -73,8 +76,9 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base >=4.6 && <5.0+ build-depends: base >=4.8 && <5.0 , transformers >=0.3+ , contravariant >= 1.4 -- Directories containing source files. hs-source-dirs: src@@ -84,9 +88,11 @@ executable varying-example ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ if impl(ghc >= 8)+ ghc-options: -Wno-type-defaults -- Other library packages from which modules are imported.- build-depends: base >=4.6 && <5.0+ build-depends: base >=4.8 && <5.0 , transformers >=0.3 , time >=1.4 , varying@@ -103,9 +109,11 @@ test-suite varying-test type: exitcode-stdio-1.0 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ if impl(ghc >= 8)+ ghc-options: -Wno-type-defaults -- Other library packages from which modules are imported.- build-depends: base >=4.6 && <5.0+ build-depends: base >=4.8 && <5.0 , time >=1.4 , transformers , varying@@ -123,9 +131,11 @@ benchmark varying-bench type: exitcode-stdio-1.0 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+ if impl(ghc >= 8)+ ghc-options: -Wno-type-defaults -- Other library packages from which modules are imported.- build-depends: base >=4.6+ build-depends: base >=4.8 , time >=1.4 , transformers , varying